| 1 | ;;; org-rmail.el --- Support for links to Rmail messages from within Org-mode |
| 2 | |
| 3 | ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 |
| 4 | ;; Free Software Foundation, Inc. |
| 5 | |
| 6 | ;; Author: Carsten Dominik <carsten at orgmode dot org> |
| 7 | ;; Keywords: outlines, hypermedia, calendar, wp |
| 8 | ;; Homepage: http://orgmode.org |
| 9 | ;; Version: 6.33x |
| 10 | ;; |
| 11 | ;; This file is part of GNU Emacs. |
| 12 | ;; |
| 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. |
| 17 | |
| 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. |
| 22 | |
| 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 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 26 | ;; |
| 27 | ;;; Commentary: |
| 28 | |
| 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'. |
| 32 | |
| 33 | ;;; Code: |
| 34 | |
| 35 | (require 'org) |
| 36 | |
| 37 | ;; Declare external functions and variables |
| 38 | (declare-function rmail-show-message "rmail" (&optional n no-summary)) |
| 39 | (declare-function rmail-what-message "rmail" ()) |
| 40 | (defvar rmail-current-message) |
| 41 | |
| 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) |
| 45 | |
| 46 | ;; Implementation |
| 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 |
| 52 | (save-restriction |
| 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 | (let* ((folder buffer-file-name) |
| 58 | (message-id (mail-fetch-field "message-id")) |
| 59 | (from (mail-fetch-field "from")) |
| 60 | (to (mail-fetch-field "to")) |
| 61 | (subject (mail-fetch-field "subject")) |
| 62 | desc link) |
| 63 | (org-store-link-props |
| 64 | :type "rmail" :from from :to to |
| 65 | :subject subject :message-id message-id) |
| 66 | (setq message-id (org-remove-angle-brackets message-id)) |
| 67 | (setq desc (org-email-link-description)) |
| 68 | (setq link (org-make-link "rmail:" folder "#" message-id)) |
| 69 | (org-add-link-props :link link :description desc) |
| 70 | (rmail-show-message rmail-current-message) |
| 71 | link))))) |
| 72 | |
| 73 | (defun org-rmail-open (path) |
| 74 | "Follow an Rmail message link to the specified PATH." |
| 75 | (let (folder article) |
| 76 | (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) |
| 77 | (error "Error in Rmail link")) |
| 78 | (setq folder (match-string 1 path) |
| 79 | article (match-string 3 path)) |
| 80 | (org-rmail-follow-link folder article))) |
| 81 | |
| 82 | (defun org-rmail-follow-link (folder article) |
| 83 | "Follow an Rmail link to FOLDER and ARTICLE." |
| 84 | (require 'rmail) |
| 85 | (setq article (org-add-angle-brackets article)) |
| 86 | (let (message-number) |
| 87 | (save-excursion |
| 88 | (save-window-excursion |
| 89 | (rmail (if (string= folder "RMAIL") rmail-file-name folder)) |
| 90 | (setq message-number |
| 91 | (save-restriction |
| 92 | (widen) |
| 93 | (goto-char (point-max)) |
| 94 | (if (re-search-backward |
| 95 | (concat "^Message-ID:\\s-+" (regexp-quote |
| 96 | (or article ""))) |
| 97 | nil t) |
| 98 | (rmail-what-message)))))) |
| 99 | (if message-number |
| 100 | (progn |
| 101 | (rmail (if (string= folder "RMAIL") rmail-file-name folder)) |
| 102 | (rmail-show-message message-number) |
| 103 | message-number) |
| 104 | (error "Message not found")))) |
| 105 | |
| 106 | (provide 'org-rmail) |
| 107 | |
| 108 | ;; arch-tag: c6cf4a8b-6639-4b7f-821f-bdf10746b173 |
| 109 | |
| 110 | ;;; org-rmail.el ends here |