blob: cdeec652caeda2d109acd1efc624ac3f1a1aea58 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
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)
|
