1 ;;; org-rmail.el --- Support for links to Rmail messages from within Org-mode
3 ;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
5 ;; Author: Carsten Dominik <carsten at orgmode dot org>
6 ;; Keywords: outlines, hypermedia, calendar, wp
7 ;; Homepage: http://orgmode.org
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
27 ;; This file implements links to Rmail messages from within Org-mode.
28 ;; Org-mode loads this module by default - if this is not what you want,
29 ;; configure the variable `org-modules'.
35 ;; Declare external functions and variables
36 (declare-function rmail-show-message
"rmail" (&optional n no-summary
))
37 (declare-function rmail-what-message
"rmail" (&optional POS
))
38 (declare-function rmail-toggle-header
"rmail" (&optional arg
))
39 (defvar rmail-current-message
) ; From rmail.el
40 (defvar rmail-header-style
) ; From rmail.el
42 ;; Install the link type
43 (org-add-link-type "rmail" 'org-rmail-open
)
44 (add-hook 'org-store-link-functions
'org-rmail-store-link
)
47 (defun org-rmail-store-link ()
48 "Store a link to an Rmail folder or message."
49 (when (or (eq major-mode
'rmail-mode
)
50 (eq major-mode
'rmail-summary-mode
))
51 (save-window-excursion
53 (when (eq major-mode
'rmail-summary-mode
)
54 (rmail-show-message rmail-current-message
))
55 (when (fboundp 'rmail-narrow-to-non-pruned-header
)
56 (rmail-narrow-to-non-pruned-header))
57 (when (eq rmail-header-style
'normal
)
58 (rmail-toggle-header -
1))
59 (let* ((folder buffer-file-name
)
60 (message-id (mail-fetch-field "message-id"))
61 (from (mail-fetch-field "from"))
62 (to (mail-fetch-field "to"))
63 (subject (mail-fetch-field "subject"))
64 (date (mail-fetch-field "date"))
65 (date-ts (and date
(format-time-string
66 (org-time-stamp-format t
)
67 (date-to-time date
))))
68 (date-ts-ia (and date
(format-time-string
69 (org-time-stamp-format t t
)
70 (date-to-time date
))))
73 :type
"rmail" :from from
:to to
74 :subject subject
:message-id message-id
)
76 (org-add-link-props :date date
:date-timestamp date-ts
77 :date-timestamp-inactive date-ts-ia
))
78 (setq message-id
(org-remove-angle-brackets message-id
))
79 (setq desc
(org-email-link-description))
80 (setq link
(concat "rmail:" folder
"#" message-id
))
81 (org-add-link-props :link link
:description desc
)
82 (rmail-show-message rmail-current-message
)
85 (defun org-rmail-open (path)
86 "Follow an Rmail message link to the specified PATH."
88 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path
))
89 (error "Error in Rmail link"))
90 (setq folder
(match-string 1 path
)
91 article
(match-string 3 path
))
92 (org-rmail-follow-link folder article
)))
94 (defun org-rmail-follow-link (folder article
)
95 "Follow an Rmail link to FOLDER and ARTICLE."
97 (setq article
(org-add-angle-brackets article
))
100 (save-window-excursion
101 (rmail (if (string= folder
"RMAIL") rmail-file-name folder
))
105 (when (eq rmail-header-style
'normal
)
106 (rmail-toggle-header -
1))
107 (goto-char (point-max))
108 (if (re-search-backward
109 (concat "^Message-ID:\\s-+" (regexp-quote
112 (rmail-what-message))))))
115 (rmail (if (string= folder
"RMAIL") rmail-file-name folder
))
116 (rmail-show-message message-number
)
118 (error "Message not found"))))
122 ;;; org-rmail.el ends here