1 ;;; org-rmail.el --- Support for links to Rmail messages from within Org-mode
3 ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009
4 ;; Free Software Foundation, Inc.
6 ;; Author: Carsten Dominik <carsten at orgmode dot org>
7 ;; Keywords: outlines, hypermedia, calendar, wp
8 ;; Homepage: http://orgmode.org
11 ;; This file is part of GNU Emacs.
13 ;; GNU Emacs is free software: you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation, either version 3 of the License, or
16 ;; (at your option) any later version.
18 ;; GNU Emacs is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
29 ;; This file implements links to Rmail messages from within Org-mode.
30 ;; Org-mode loads this module by default - if this is not what you want,
31 ;; configure the variable `org-modules'.
37 ;; Declare external functions and variables
38 (declare-function rmail-show-message
"rmail" (&optional n no-summary
))
39 (declare-function rmail-get-header
"rmail" (name &optional msgnum
))
40 (declare-function rmail-what-message
"rmail" ())
41 (defvar rmail-current-message
)
43 (defvar rmail-view-buffer
)
45 ;; Install the link type
46 (org-add-link-type "rmail" 'org-rmail-open
)
47 (add-hook 'org-store-link-functions
'org-rmail-store-link
)
50 (defun org-rmail-store-link ()
51 "Store a link to an Rmail folder or message."
52 (when (memq major-mode
'(rmail-mode rmail-summary-mode
))
53 (let (message-id from to subject desc link
)
54 (if (fboundp 'rmail-get-header
) ; Emacs 23
55 (setq message-id
(rmail-get-header "message-id")
56 from
(rmail-get-header "from")
57 to
(rmail-get-header "to")
58 subject
(rmail-get-header "subject"))
59 (save-window-excursion ; Emacs 22
61 (when (eq major-mode
'rmail-summary-mode
)
62 (rmail-show-message rmail-current-message
))
63 (with-no-warnings ; don't warn when compiling Emacs 23
64 (rmail-narrow-to-non-pruned-header))
65 (setq message-id
(mail-fetch-field "message-id")
66 from
(mail-fetch-field "from")
67 to
(mail-fetch-field "to")
68 subject
(mail-fetch-field "subject"))
69 (rmail-show-message rmail-current-message
))))
71 :type
"rmail" :from from
:to to
72 :subject subject
:message-id message-id
)
73 (setq message-id
(org-remove-angle-brackets message-id
))
74 (setq desc
(org-email-link-description))
75 (setq link
(org-make-link "rmail:"
76 (with-current-buffer rmail-buffer
79 (org-add-link-props :link link
:description desc
)
82 (defun org-rmail-open (path)
83 "Follow an Rmail message link to the specified PATH."
85 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path
))
86 (error "Error in Rmail link"))
87 (setq folder
(match-string 1 path
)
88 article
(match-string 3 path
))
89 (org-rmail-follow-link folder article
)))
91 (defun org-rmail-follow-link (folder article
)
92 "Follow an Rmail link to FOLDER and ARTICLE."
94 (setq article
(org-add-angle-brackets article
))
95 (let (message-number buff
)
97 (save-window-excursion
98 (rmail (if (string= folder
"RMAIL") rmail-file-name folder
))
99 (setq buff
(current-buffer)
102 (if (and (fboundp 'rmail-buffers-swapped-p
)
103 (rmail-buffers-swapped-p))
108 (goto-char (point-max))
109 (if (re-search-backward
110 (concat "^Message-ID:\\s-+" (regexp-quote
113 ;; This is an rmail "debugging" function. :(
114 (with-current-buffer buff
115 (rmail-what-message))))))))
118 (rmail (if (string= folder
"RMAIL") rmail-file-name folder
))
119 (rmail-show-message message-number
)
121 (error "Message not found"))))
125 ;; arch-tag: c6cf4a8b-6639-4b7f-821f-bdf10746b173
127 ;;; org-rmail.el ends here