ol-mew.el (13984B)
1 ;;; ol-mew.el --- Links to Mew messages 2 3 ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. 4 5 ;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp> 6 ;; Keywords: outlines, hypermedia, calendar, wp 7 ;; Homepage: https://git.sr.ht/~bzg/org-contrib 8 9 ;; This file is not part of GNU Emacs. 10 11 ;; This program 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 ;; This program 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 Mew 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'. 30 ;; 31 ;; Here is an example of workflow: 32 33 ;; In your ~/.mew.el configuration file: 34 ;; 35 ;; (define-key mew-summary-mode-map "'" 'org-mew-search) 36 ;; (eval-after-load "mew-summary" 37 ;; '(define-key mew-summary-mode-map "\C-o" 'org-mew-capture)) 38 39 ;; 1. In the Mew's inbox folder, take a glance at new messages to find 40 ;; a message that requires any action. 41 42 ;; 2. If the message is a reply from somebody and associated with the 43 ;; existing orgmode entry, type M-x `org-mew-search' RET (or press 44 ;; the ' key simply) to find the entry. If you can find the entry 45 ;; successfully and think you should start the task right now, 46 ;; start the task by M-x `org-agenda-clock-in' RET. 47 48 ;; 3. If the message is a new message, type M-x `org-mew-capture' RET, 49 ;; enter the refile folder, and the buffer to capture the message 50 ;; is shown up (without selecting the template by hand). Then you 51 ;; can fill the template and type C-c C-c to complete the capture. 52 ;; Note that you can configure `org-capture-templates' so that the 53 ;; captured entry has a link to the message. 54 55 ;;; Code: 56 57 (require 'org) 58 (require 'ol) 59 60 (defgroup org-mew nil 61 "Options concerning the Mew link." 62 :tag "Org Startup" 63 :group 'org-link) 64 65 (defcustom org-mew-link-to-refile-destination t 66 "Create a link to the refile destination if the message is marked as refile." 67 :group 'org-mew 68 :type 'boolean) 69 70 (defcustom org-mew-inbox-folder nil 71 "The folder where new messages are incorporated. 72 If `org-mew-inbox-folder' is non-nil, `org-mew-open' locates the message 73 in this inbox folder as well as the folder specified by the link." 74 :group 'org-mew 75 :type 'string) 76 77 (defcustom org-mew-use-id-db t 78 "Use ID database to locate the message if id.db is created." 79 :group 'org-mew 80 :type 'boolean) 81 82 (defcustom org-mew-subject-alist 83 (list (cons (concat "^\\(?:\\(?:re\\|fwd?\\): *\\)*" 84 "\\(?:[[(][a-z0-9._-]+[:,]? [0-9]+[])]\\)? *" 85 "\\(?:\\(?:re\\|fwd?\\): *\\)*" 86 "\\(.*\\)[ \t]*") 87 1)) 88 "Alist of subject regular expression and matched group number for search." 89 :group 'org-mew 90 :type '(repeat (cons (regexp) (integer)))) 91 92 (defcustom org-mew-capture-inbox-folders nil 93 "List of inbox folders whose messages need refile marked before capture. 94 `org-mew-capture' will ask you to put the refile mark on the 95 message if the message's folder is any of these folders and the 96 message is not marked. Nil means `org-mew-capture' never ask you 97 destination folders before capture." 98 :group 'org-mew 99 :type '(repeat string)) 100 101 (defcustom org-mew-capture-guess-alist nil 102 "Alist of the regular expression of the folder name and the capture 103 template selection keys. 104 105 For example, 106 '((\"^%emacs-orgmode$\" . \"o\") 107 (\"\" . \"t\")) 108 the messages in \"%emacs-orgmode\" folder will be captured with 109 the capture template associated with \"o\" key, and any other 110 messages will be captured with the capture template associated 111 with \"t\" key." 112 :group 'org-mew 113 :type '(repeat (cons regexp string))) 114 115 ;; Declare external functions and variables 116 (declare-function mew-cache-hit "ext:mew-cache" (fld msg &optional must-hit)) 117 (declare-function mew-case-folder "ext:mew-func" (case folder)) 118 (declare-function mew-folder-path-to-folder 119 "ext:mew-func" (path &optional has-proto)) 120 (declare-function mew-idstr-to-id-list "ext:mew-header" (idstr &optional rev)) 121 (declare-function mew-folder-remotep "ext:mew-func" (folder)) 122 (declare-function mew-folder-virtualp "ext:mew-func" (folder)) 123 (declare-function mew-header-get-value "ext:mew-header" 124 (field &optional as-list)) 125 (declare-function mew-init "ext:mew" ()) 126 (declare-function mew-refile-get "ext:mew-refile" (msg)) 127 (declare-function mew-sinfo-get-case "ext:mew-summary" ()) 128 (declare-function mew-summary-diag-global "ext:mew-thread" (id opt who)) 129 (declare-function mew-summary-display "ext:mew-summary2" (&optional redisplay)) 130 (declare-function mew-summary-folder-name "ext:mew-syntax" (&optional ext)) 131 (declare-function mew-summary-get-mark "ext:mew-mark" ()) 132 (declare-function mew-summary-message-number2 "ext:mew-syntax" ()) 133 (declare-function mew-summary-pick-with-mewl "ext:mew-pick" 134 (pattern folder src-msgs)) 135 (declare-function mew-summary-refile "ext:mew-refile" (&optional report)) 136 (declare-function mew-summary-search-msg "ext:mew-const" (msg)) 137 (declare-function mew-summary-set-message-buffer "ext:mew-summary3" (fld msg)) 138 (declare-function mew-summary-visit-folder "ext:mew-summary4" 139 (folder &optional goend no-ls)) 140 (declare-function mew-window-push "ext:mew" ()) 141 (declare-function mew-expand-folder "ext:mew-func" (folder)) 142 (declare-function mew-case:folder-folder "ext:mew-func" (case:folder)) 143 (declare-function mew "ext:mew" (&optional arg)) 144 (declare-function mew-message-goto-summary "ext:mew-message" ()) 145 (declare-function mew-summary-mode "ext:mew-summary" ()) 146 147 (defvar mew-init-p) 148 (defvar mew-mark-afterstep-spec) 149 (defvar mew-summary-goto-line-then-display) 150 151 ;; Install the link type 152 (org-link-set-parameters "mew" :follow #'org-mew-open :store #'org-mew-store-link) 153 154 ;; Implementation 155 (defun org-mew-store-link () 156 "Store a link to a Mew folder or message." 157 (save-window-excursion 158 (if (eq major-mode 'mew-message-mode) 159 (mew-message-goto-summary)) 160 (when (memq major-mode '(mew-summary-mode mew-virtual-mode)) 161 (let ((msgnum (mew-summary-message-number2)) 162 (folder-name (org-mew-folder-name))) 163 (if (fboundp 'mew-summary-set-message-buffer) 164 (mew-summary-set-message-buffer folder-name msgnum) 165 (set-buffer (mew-cache-hit folder-name msgnum t))) 166 (let* ((message-id (mew-header-get-value "Message-Id:")) 167 (from (mew-header-get-value "From:")) 168 (to (mew-header-get-value "To:")) 169 (date (mew-header-get-value "Date:")) 170 (subject (mew-header-get-value "Subject:")) 171 desc link) 172 (org-store-link-props :type "mew" :from from :to to :date date 173 :subject subject :message-id message-id) 174 (setq message-id (org-unbracket-string "<" ">" message-id)) 175 (setq desc (org-email-link-description)) 176 (setq link (concat "mew:" folder-name "#" message-id)) 177 (org-add-link-props :link link :description desc) 178 link))))) 179 180 (defun org-mew-folder-name () 181 "Return the folder name of the current message." 182 (save-window-excursion 183 (if (eq major-mode 'mew-message-mode) 184 (mew-message-goto-summary)) 185 (let* ((msgnum (mew-summary-message-number2)) 186 (mark-info (mew-summary-get-mark))) 187 (if (and org-mew-link-to-refile-destination 188 (eq mark-info ?o)) ; marked as refile 189 (mew-case-folder (mew-sinfo-get-case) 190 (nth 1 (mew-refile-get msgnum))) 191 (let ((folder-or-path (mew-summary-folder-name))) 192 (mew-folder-path-to-folder folder-or-path t)))))) 193 194 (defun org-mew-open (path _) 195 "Follow the Mew message link specified by PATH." 196 (let (folder message-id) 197 (cond ((string-match "\\`\\(+.*\\)+\\+\\([0-9]+\\)\\'" path) ; for Bastien's 198 (setq folder (match-string 1 path)) 199 (setq message-id (match-string 2 path))) 200 ((string-match "\\`\\(\\(%#\\)?[^#]+\\)\\(#\\(.*\\)\\)?" path) 201 (setq folder (match-string 1 path)) 202 (setq message-id (match-string 4 path))) 203 ((and org-mew-use-id-db (string-match "\\`#\\(.+\\)" path)) 204 (setq folder nil) 205 (setq message-id (match-string 1 path))) 206 (t (error "Error in Mew link"))) 207 (require 'mew) 208 (mew-window-push) 209 (unless mew-init-p (mew-init)) 210 (if (null folder) 211 (progn 212 (mew t) 213 (org-mew-open-by-message-id message-id)) 214 (or (org-mew-follow-link folder message-id) 215 (and org-mew-inbox-folder (not (string= org-mew-inbox-folder folder)) 216 (org-mew-follow-link org-mew-inbox-folder message-id)) 217 (and org-mew-use-id-db 218 (org-mew-open-by-message-id message-id)) 219 (error "Message not found"))))) 220 221 (defun org-mew-follow-link (folder message-id) 222 (unless (org-mew-folder-exists-p folder) 223 (error "No such folder or wrong folder %s" folder)) 224 (mew-summary-visit-folder folder) 225 (when message-id 226 (let ((msgnum (org-mew-get-msgnum folder message-id))) 227 (when (mew-summary-search-msg msgnum) 228 (if mew-summary-goto-line-then-display 229 (mew-summary-display)) 230 t)))) 231 232 (defun org-mew-folder-exists-p (folder) 233 (let ((dir (mew-expand-folder folder))) 234 (cond 235 ((mew-folder-virtualp folder) (get-buffer folder)) 236 ((null dir) nil) 237 ((mew-folder-remotep (mew-case:folder-folder folder)) t) 238 (t (file-directory-p dir))))) 239 240 (defun org-mew-get-msgnum (folder message-id) 241 (if (string-match "\\`[0-9]+\\'" message-id) 242 message-id 243 (let* ((pattern (concat "message-id=" message-id)) 244 (msgs (mew-summary-pick-with-mewl pattern folder nil))) 245 (car msgs)))) 246 247 (defun org-mew-open-by-message-id (message-id) 248 "Open message using ID database." 249 (let ((result (mew-summary-diag-global (format "<%s>" message-id) 250 "-p" "Message"))) 251 (unless (eq result t) 252 (error "Message not found")))) 253 254 ;; In ~/.mew.el, add the following line: 255 ;; (define-key mew-summary-mode-map "'" 'org-mew-search) 256 (defun org-mew-search (&optional arg) 257 "Show all entries related to the message using `org-search-view'. 258 259 It shows entries which contains the message ID, the reference 260 IDs, or the subject of the message. 261 262 With C-u prefix, search for the entries that contains the message 263 ID or any of the reference IDs. With C-u C-u prefix, search for 264 the message ID or the last reference ID. 265 266 The search phase for the subject is extracted with 267 `org-mew-subject-alist', which defines the regular expression of 268 the subject and the group number to extract. You can get rid of 269 \"Re:\" and some other prefix from the subject text." 270 (interactive "P") 271 (when (memq major-mode '(mew-summary-mode mew-virtual-mode)) 272 (let ((last-reference-only (equal arg '(16))) 273 (by-subject (null arg)) 274 (msgnum (mew-summary-message-number2)) 275 (folder-name (mew-summary-folder-name)) 276 subject message-id references id-list) 277 (save-window-excursion 278 (if (fboundp 'mew-summary-set-message-buffer) 279 (mew-summary-set-message-buffer folder-name msgnum) 280 (set-buffer (mew-cache-hit folder-name msgnum t))) 281 (setq subject (mew-header-get-value "Subject:")) 282 (setq message-id (mew-header-get-value "Message-Id:")) 283 (setq references (mew-header-get-value "References:"))) 284 (setq id-list (mapcar (lambda (id) (org-unbracket-string "<" ">" id)) 285 (mew-idstr-to-id-list references))) 286 (if last-reference-only 287 (setq id-list (last id-list)) 288 (if message-id 289 (setq id-list (cons (org-unbracket-string "<" ">" message-id) 290 id-list)))) 291 (when (and by-subject (stringp subject)) 292 (catch 'matched 293 (mapc (lambda (elem) 294 (let ((regexp (car elem)) 295 (num (cdr elem))) 296 (when (string-match regexp subject) 297 (setq subject (match-string num subject)) 298 (throw 'matched t)))) 299 org-mew-subject-alist)) 300 (setq id-list (cons subject id-list))) 301 (cond ((null id-list) 302 (error "No message ID to search")) 303 ((equal (length id-list) 1) 304 (org-search-view nil (car id-list))) 305 (t 306 (org-search-view nil (format "{\\(%s\\)}" 307 (mapconcat 'regexp-quote 308 id-list "\\|")))))) 309 (delete-other-windows))) 310 311 (defun org-mew-capture (arg) 312 "Guess the capture template from the folder name and invoke `org-capture'. 313 314 This selects a capture template in `org-capture-templates' by 315 searching for capture template selection keys defined in 316 `org-mew-capture-guess-alist' which are associated with the 317 regular expression that matches the message's folder name, and 318 then invokes `org-capture'. 319 320 If the message's folder is a inbox folder, you are prompted to 321 put the refile mark on the message and the capture template is 322 guessed from the refile destination folder. You can customize 323 the inbox folders by `org-mew-capture-inbox-folders'. 324 325 If ARG is non-nil, this does not guess the capture template but 326 asks you to select the capture template." 327 (interactive "P") 328 (or (not (member (org-mew-folder-name) 329 org-mew-capture-inbox-folders)) 330 (eq (mew-summary-get-mark) ?o) 331 (save-window-excursion 332 (if (eq major-mode 'mew-message-mode) 333 (mew-message-goto-summary)) 334 (let ((mew-mark-afterstep-spec '((?o 0 0 0 0 0 0 0)))) 335 (mew-summary-refile))) 336 (error "No refile folder selected")) 337 (let* ((org-mew-link-to-refile-destination t) 338 (folder-name (org-mew-folder-name)) 339 (keys (if arg 340 nil 341 (org-mew-capture-guess-selection-keys folder-name)))) 342 (org-capture nil keys))) 343 344 (defun org-mew-capture-guess-selection-keys (folder-name) 345 (catch 'found 346 (let ((alist org-mew-capture-guess-alist)) 347 (while alist 348 (let ((elem (car alist))) 349 (if (string-match (car elem) folder-name) 350 (throw 'found (cdr elem)))) 351 (setq alist (cdr alist)))))) 352 353 (provide 'ol-mew) 354 355 ;;; ol-mew.el ends here