1 files changed, 72 insertions, 0 deletions
diff --git a/lib/org/jao-org-gnus.el b/lib/org/jao-org-gnus.el
new file mode 100644
index 0000000..cdeec65
--- /dev/null
+++ b/lib/org/jao-org-gnus.el
@@ -0,0 +1,72 @@
+;; Support for saving Gnus messages by Message-ID
+(defun mde-org-gnus-save-by-mid ()
+  (when (memq major-mode '(gnus-summary-mode gnus-article-mode))
+    (when (eq major-mode 'gnus-article-mode)
+      (gnus-article-show-summary))
+    (let* ((group gnus-newsgroup-name)
+           (method (gnus-find-method-for-group group)))
+      (when (memq (car method) '(nnml nntp))
+        (let* ((article (gnus-summary-article-number))
+               (header (gnus-summary-article-header article))
+               (from (mail-header-from header))
+               (message-id
+                (save-match-data
+                  (let ((mid (mail-header-id header)))
+                    (if (string-match "<\\(.*\\)>" mid)
+                        (match-string 1 mid)
+                      (error "Malformed message ID header %s" mid)))))
+               (date (mail-header-date header))
+               (subject (gnus-summary-subject-string)))
+          (org-store-link-props :type "mid" :from from :subject subject
+                                :message-id message-id :group group
+                                :link (org-make-link "mid:" message-id))
+          (apply 'org-store-link-props
+                 :description (org-email-link-description)
+                 org-store-link-plist)
+          t)))))
+
+(defvar mde-mid-resolve-methods '()
+  "List of methods to try when resolving message ID's.  For Gnus,
+it is a cons of 'gnus and the select (type and name).")
+(setq mde-mid-resolve-methods
+      '((gnus nnml "")))
+
+(defvar mde-org-gnus-open-level 1
+  "Level at which Gnus is started when opening a link")
+(defun mde-org-gnus-open-message-link (msgid)
+  "Open a message link with Gnus"
+  (require 'gnus)
+  (require 'org-table)
+  (catch 'method-found
+    (message "[MID linker] Resolving %s" msgid)
+    (dolist (method mde-mid-resolve-methods)
+      (cond
+       ((and (eq (car method) 'gnus)
+             (eq (cadr method) 'nnml))
+        (funcall (cdr (assq 'gnus org-link-frame-setup))
+                 mde-org-gnus-open-level)
+        (when gnus-other-frame-object
+          (select-frame gnus-other-frame-object))
+        (let* ((msg-info (nnml-find-group-number
+                          (concat "<" msgid ">")
+                          (cdr method)))
+               (group (and msg-info (car msg-info)))
+               (message (and msg-info (cdr msg-info)))
+               (qname (and group
+                           (if (gnus-methods-equal-p
+                                (cdr method)
+                                gnus-select-method)
+                               group
+                             (gnus-group-full-name group (cdr method))))))
+          (when msg-info
+            (gnus-summary-read-group qname nil t)
+            (gnus-summary-goto-article message nil t))
+          (throw 'method-found t)))
+       (t (error "Unknown link type"))))))
+
+(eval-after-load 'org-gnus
+  '(progn
+     (add-to-list 'org-store-link-functions 'mde-org-gnus-save-by-mid)
+     (org-add-link-type "mid" 'mde-org-gnus-open-message-link)))
+
+(provide 'jao-org-gnus)