| commit | author | age | ||
| 76bbd0 | 1 | ;;; org-rmail.el --- Support for Links to Rmail Messages -*- lexical-binding: t; -*- |
| C | 2 | |
| 3 | ;; Copyright (C) 2004-2018 Free Software Foundation, Inc. | |
| 4 | ||
| 5 | ;; Author: Carsten Dominik <carsten at orgmode dot org> | |
| 6 | ;; Keywords: outlines, hypermedia, calendar, wp | |
| 7 | ;; Homepage: https://orgmode.org | |
| 8 | ;; | |
| 9 | ;; This file is part of GNU Emacs. | |
| 10 | ;; | |
| 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. | |
| 15 | ||
| 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. | |
| 20 | ||
| 21 | ;; You should have received a copy of the GNU General Public License | |
| 22 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | |
| 23 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 24 | ;; | |
| 25 | ;;; Commentary: | |
| 26 | ||
| 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 | |
| 29 | ;; want, configure the variable `org-modules'. | |
| 30 | ||
| 31 | ;;; Code: | |
| 32 | ||
| 33 | (require 'org) | |
| 34 | ||
| 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 | (declare-function rmail "rmail" (&optional file-name-arg)) | |
| 40 | (declare-function rmail-widen "rmail" ()) | |
| 41 | (defvar rmail-current-message) ; From rmail.el | |
| 42 | (defvar rmail-header-style) ; From rmail.el | |
| 43 | (defvar rmail-file-name) ; From rmail.el | |
| 44 | ||
| 45 | ;; Install the link type | |
| 46 | (org-link-set-parameters "rmail" :follow #'org-rmail-open :store #'org-rmail-store-link) | |
| 47 | ||
| 48 | ;; Implementation | |
| 49 | (defun org-rmail-store-link () | |
| 50 | "Store a link to an Rmail folder or message." | |
| 51 | (when (or (eq major-mode 'rmail-mode) | |
| 52 | (eq major-mode 'rmail-summary-mode)) | |
| 53 | (save-window-excursion | |
| 54 | (save-restriction | |
| 55 | (when (eq major-mode 'rmail-summary-mode) | |
| 56 | (rmail-show-message rmail-current-message)) | |
| 57 | (when (fboundp 'rmail-narrow-to-non-pruned-header) | |
| 58 | (rmail-narrow-to-non-pruned-header)) | |
| 59 | (when (eq rmail-header-style 'normal) | |
| 60 | (rmail-toggle-header -1)) | |
| 61 | (let* ((folder buffer-file-name) | |
| 62 | (message-id (mail-fetch-field "message-id")) | |
| 63 | (from (mail-fetch-field "from")) | |
| 64 | (to (mail-fetch-field "to")) | |
| 65 | (subject (mail-fetch-field "subject")) | |
| 66 | (date (mail-fetch-field "date")) | |
| 67 | desc link) | |
| 68 | (org-store-link-props | |
| 69 | :type "rmail" :from from :to to :date date | |
| 70 | :subject subject :message-id message-id) | |
| 71 | (setq message-id (org-unbracket-string "<" ">" message-id)) | |
| 72 | (setq desc (org-email-link-description)) | |
| 73 | (setq link (concat "rmail:" folder "#" message-id)) | |
| 74 | (org-add-link-props :link link :description desc) | |
| 75 | (rmail-show-message rmail-current-message) | |
| 76 | link))))) | |
| 77 | ||
| 78 | (defun org-rmail-open (path) | |
| 79 | "Follow an Rmail message link to the specified PATH." | |
| 80 | (let (folder article) | |
| 81 | (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) | |
| 82 | (error "Error in Rmail link")) | |
| 83 | (setq folder (match-string 1 path) | |
| 84 | article (match-string 3 path)) | |
| 85 | (org-rmail-follow-link folder article))) | |
| 86 | ||
| 87 | (defun org-rmail-follow-link (folder article) | |
| 88 | "Follow an Rmail link to FOLDER and ARTICLE." | |
| 89 | (require 'rmail) | |
| 90 | (cond ((null article) (setq article "")) | |
| 91 | ((stringp article) | |
| 92 | (setq article (org-add-angle-brackets article))) | |
| 93 | (t (user-error "Wrong RMAIL link format"))) | |
| 94 | (let (message-number) | |
| 95 | (save-excursion | |
| 96 | (save-window-excursion | |
| 97 | (rmail (if (string= folder "RMAIL") rmail-file-name folder)) | |
| 98 | (setq message-number | |
| 99 | (save-restriction | |
| 100 | (rmail-widen) | |
| 101 | (goto-char (point-max)) | |
| 102 | (if (re-search-backward | |
| 103 | (concat "^Message-ID:\\s-+" (regexp-quote article)) | |
| 104 | nil t) | |
| 105 | (rmail-what-message)))))) | |
| 106 | (if message-number | |
| 107 | (progn | |
| 108 | (rmail (if (string= folder "RMAIL") rmail-file-name folder)) | |
| 109 | (rmail-show-message message-number) | |
| 110 | message-number) | |
| 111 | (error "Message not found")))) | |
| 112 | ||
| 113 | (provide 'org-rmail) | |
| 114 | ||
| 115 | ;;; org-rmail.el ends here | |
