ol-mhe.el (7962B)
1 ;;; ol-mhe.el --- Links to MH-E Messages -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2004-2023 Free Software Foundation, Inc. 4 5 ;; Author: Thomas Baumann <thomas dot baumann at ch dot tum dot de> 6 ;; Keywords: outlines, hypermedia, calendar, wp 7 ;; URL: 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 MH-E messages from within Org. 28 ;; Org mode loads this module by default - if this is not what you want, 29 ;; configure the variable `org-modules'. 30 31 ;;; Code: 32 33 (require 'org-macs) 34 (org-assert-version) 35 36 (require 'org-macs) 37 (require 'ol) 38 39 ;; Customization variables 40 41 (defcustom org-mhe-search-all-folders nil 42 "Non-nil means the search for the mh-message may extend to all folders. 43 When non-nil, the search for a message will extend to all other 44 folders if it cannot be found in the folder given in the link. 45 Searching all folders may be slow with the default pick based 46 search but is very efficient with one of the other search engines 47 supported by MH-E." 48 :group 'org-link-follow 49 :type 'boolean) 50 51 ;; Declare external functions and variables 52 (declare-function mh-display-msg "mh-show" (msg-num folder-name)) 53 (declare-function mh-find-path "mh-utils" ()) 54 (declare-function mh-get-header-field "mh-utils" (field)) 55 (declare-function mh-get-msg-num "mh-utils" (error-if-no-message)) 56 (declare-function mh-header-display "mh-show" ()) 57 (declare-function mh-index-previous-folder "mh-search" ()) 58 (declare-function mh-normalize-folder-name "mh-utils" 59 (folder &optional empty-string-okay dont-remove-trailing-slash 60 return-nil-if-folder-empty)) 61 (declare-function mh-search "mh-search" 62 (folder search-regexp &optional redo-search-flag 63 window-config)) 64 (declare-function mh-search-choose "mh-search" (&optional searcher)) 65 (declare-function mh-show "mh-show" (&optional message redisplay-flag)) 66 (declare-function mh-show-buffer-message-number "mh-comp" (&optional buffer)) 67 (declare-function mh-show-header-display "mh-show" t t) 68 (declare-function mh-show-msg "mh-show" (msg)) 69 (declare-function mh-show-show "mh-show" t t) 70 (declare-function mh-visit-folder "mh-folder" (folder &optional 71 range index-data)) 72 (defvar mh-progs) 73 (defvar mh-current-folder) 74 (defvar mh-show-folder-buffer) 75 (defvar mh-index-folder) 76 (defvar mh-searcher) 77 (defvar mh-search-regexp-builder) 78 79 ;; Install the link type 80 (org-link-set-parameters "mhe" :follow #'org-mhe-open :store #'org-mhe-store-link) 81 82 ;; Implementation 83 (defun org-mhe-store-link () 84 "Store a link to an MH-E folder or message." 85 (when (or (eq major-mode 'mh-folder-mode) 86 (eq major-mode 'mh-show-mode)) 87 (save-window-excursion 88 (let* ((from (org-mhe-get-header "From:")) 89 (to (org-mhe-get-header "To:")) 90 (message-id (org-mhe-get-header "Message-Id:")) 91 (subject (org-mhe-get-header "Subject:")) 92 (date (org-mhe-get-header "Date:")) 93 link desc) 94 (org-link-store-props :type "mh" :from from :to to :date date 95 :subject subject :message-id message-id) 96 (setq desc (org-link-email-description)) 97 (setq link (concat "mhe:" (org-mhe-get-message-real-folder) "#" 98 (org-unbracket-string "<" ">" message-id))) 99 (org-link-add-props :link link :description desc) 100 link)))) 101 102 (defun org-mhe-open (path _) 103 "Follow an MH-E message link specified by PATH." 104 (let (folder article) 105 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) 106 (error "Error in MH-E link")) 107 (setq folder (match-string 1 path) 108 article (match-string 3 path)) 109 (org-mhe-follow-link folder article))) 110 111 ;;; mh-e integration based on planner-mode 112 (defun org-mhe-get-message-real-folder () 113 "Return the name of the real folder for the current message. 114 So if you use sequences, it will now work." 115 (save-excursion 116 (let* ((folder 117 (if (eq major-mode 'mh-folder-mode) 118 mh-current-folder 119 ;; Refer to the show buffer 120 mh-show-folder-buffer)) 121 (end-index 122 (if (boundp 'mh-index-folder) 123 (min (length mh-index-folder) (length folder)))) 124 ) 125 ;; a simple test on mh-index-data does not work, because 126 ;; mh-index-data is always nil in a show buffer. 127 (if (and (boundp 'mh-index-folder) 128 (string= mh-index-folder (substring folder 0 end-index))) 129 (if (eq major-mode 'mh-show-mode) 130 (save-window-excursion 131 (let (pop-up-frames) 132 (when (buffer-live-p (get-buffer folder)) 133 (progn 134 (pop-to-buffer folder) 135 (org-mhe-get-message-folder-from-index) 136 ) 137 ))) 138 (org-mhe-get-message-folder-from-index) 139 ) 140 folder 141 ) 142 ))) 143 144 (defun org-mhe-get-message-folder-from-index () 145 "Return the name of the message folder in an index folder buffer." 146 (save-excursion 147 (mh-index-previous-folder) 148 (if (re-search-forward "^\\(\\+.*\\)$" nil t) 149 (message "%s" (match-string 1))))) 150 151 (defun org-mhe-get-message-folder () 152 "Return the name of the current message folder. 153 Be careful if you use sequences." 154 (save-excursion 155 (if (eq major-mode 'mh-folder-mode) 156 mh-current-folder 157 ;; Refer to the show buffer 158 mh-show-folder-buffer))) 159 160 (defun org-mhe-get-message-num () 161 "Return the number of the current message. 162 Be careful if you use sequences." 163 (save-excursion 164 (if (eq major-mode 'mh-folder-mode) 165 (mh-get-msg-num nil) 166 ;; Refer to the show buffer 167 (mh-show-buffer-message-number)))) 168 169 (defun org-mhe-get-header (header) 170 "Return the field for HEADER of the message in folder mode. 171 This will create a show buffer for the corresponding message. If 172 you have a better idea of how to do this then please let us know." 173 (let* ((folder (org-mhe-get-message-folder)) 174 (num (org-mhe-get-message-num)) 175 (buffer (get-buffer-create (concat "show-" folder))) 176 (header-field)) 177 (with-current-buffer buffer 178 (mh-display-msg num folder) 179 (if (eq major-mode 'mh-folder-mode) 180 (mh-header-display) 181 (mh-show-header-display)) 182 (set-buffer buffer) 183 (setq header-field (mh-get-header-field header)) 184 (if (eq major-mode 'mh-folder-mode) 185 (mh-show) 186 (mh-show-show)) 187 (org-trim header-field)))) 188 189 (defun org-mhe-follow-link (folder article) 190 "Follow an MH-E link to FOLDER and ARTICLE. 191 If ARTICLE is nil FOLDER is shown. If the configuration variable 192 `org-mhe-search-all-folders' is t and `mh-searcher' is pick, 193 ARTICLE is searched in all folders. Indexed searches (swish++, 194 namazu, and others supported by MH-E) will always search in all 195 folders." 196 (require 'mh-e) 197 (require 'mh-search) 198 (require 'mh-utils) 199 (mh-find-path) 200 (if (not article) 201 (mh-visit-folder (mh-normalize-folder-name folder)) 202 (mh-search-choose) 203 (if (eq mh-searcher 'pick) 204 (progn 205 (setq article (org-link-add-angle-brackets article)) 206 (mh-search folder (list "--message-id" article)) 207 (when (and org-mhe-search-all-folders 208 (not (org-mhe-get-message-real-folder))) 209 (kill-buffer) 210 (mh-search "+" (list "--message-id" article)))) 211 (if mh-search-regexp-builder 212 (mh-search "+" (funcall mh-search-regexp-builder 213 (list (cons 'message-id article)))) 214 (mh-search "+" article))) 215 (if (org-mhe-get-message-real-folder) 216 (mh-show-msg 1) 217 (kill-buffer) 218 (error "Message not found")))) 219 220 (provide 'ol-mhe) 221 222 ;;; ol-mhe.el ends here