org-mairix.el (13608B)
1 ;;; org-mairix.el - Support for hooking mairix search into Org for different MUAs 2 ;; 3 ;; Copyright (C) 2007-2014, 2021 Georg C. F. Greve 4 ;; mutt support by Adam Spiers <orgmode at adamspiers dot org> 5 ;; 6 ;; Author: Georg C. F. Greve <greve at fsfeurope dot org> 7 ;; Keywords: outlines, hypermedia, calendar, wp, email, mairix 8 ;; Purpose: Integrate mairix email searching into Org mode 9 ;; See https://orgmode.org and http://www.rpcurnow.force9.co.uk/mairix/ 10 ;; Version: 0.5 11 ;; 12 ;; This file is not part of GNU Emacs. 13 ;; 14 ;; This file is Free Software; you can redistribute it and/or modify 15 ;; it under the terms of the GNU General Public License as published by 16 ;; the Free Software Foundation; either version 3, or (at your option) 17 ;; any later version. 18 19 ;; It is distributed in the hope that it will be useful, but WITHOUT 20 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 21 ;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public 22 ;; License for more details. 23 24 ;; You should have received a copy of the GNU General Public License 25 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 27 ;; USAGE NOTE 28 ;; 29 ;; You will need to configure mairix first, which involves setting up your 30 ;; .mairixrc in your home directory. Once it is working, you should set up 31 ;; your way to display results in your favorite way -- usually a MUA. 32 ;; Currently gnus and mutt are supported. 33 ;; 34 ;; After both steps are done, all you should need to hook mairix, org 35 ;; and your MUA together is to do (require 'org-mairix) in your 36 ;; startup file. Everything can then be configured normally through 37 ;; Emacs customisation. 38 ;; 39 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 40 41 (require 'org) 42 43 ;;; The custom variables 44 45 (defgroup org-mairix nil 46 "Mairix support/integration in org." 47 :tag "Org Mairix" 48 :group 'org) 49 50 (defcustom org-mairix-threaded-links t 51 "Should new links be created as threaded links? 52 If t, links will be stored as threaded searches. 53 If nil, links will be stored as non-threaded searches." 54 :group 'org-mairix 55 :type 'boolean) 56 57 (defcustom org-mairix-augmented-links nil 58 "Should new links be created as augmenting searches? 59 If t, links will be stored as augmenting searches. 60 If nil, links will be stored as normal searches. 61 62 Attention: When activating this option, you will need 63 to remove old articles from your mairix results group 64 in some other way, mairix will not do it for you." 65 :group 'org-mairix 66 :type 'boolean) 67 68 (defcustom org-mairix-display-hook 'org-mairix-gnus-display-results 69 "Hook to call to display the results of a successful mairix search. 70 Defaults to Gnus, feel free to add your own MUAs or methods." 71 :group 'org-mairix 72 :type 'hook) 73 74 (defcustom org-mairix-open-command "mairix %args% '%search%'" 75 "The mairix command-line to use. If your paths are set up 76 correctly, you should not need to change this. 77 78 '%search%' will get substituted with the search expression, and 79 '%args%' with any additional arguments." 80 :group 'org-mairix 81 :type 'string) 82 83 ;;; The hooks to integrate mairix into org 84 85 (org-link-set-parameters "mairix" 86 :follow #'org-mairix-open 87 :store #'org-mairix-store-gnus-link) 88 89 ;;; Generic org-mairix functions 90 91 (defun org-mairix-construct-link (message-id) 92 "Construct a mairix: hyperlink based on message-id." 93 (concat "mairix:" 94 (if org-mairix-threaded-links "t:") 95 (if org-mairix-augmented-links "a:") 96 "@@" 97 (org-unbracket-string "<" ">" message-id))) 98 99 (defun org-store-mairix-link-props (&rest plist) 100 "Take a property list describing a mail, and add mairix link 101 and description properties so that org can build a mairix link to 102 it." 103 ;; We have to call `org-store-link-props' twice: 104 ;; 105 ;; - It extracts 'fromname'/'fromaddress' from 'from' property, 106 ;; and stores the updated plist to `org-store-link-plist'. 107 ;; 108 ;; - `org-email-link-description' uses these new properties to 109 ;; build a description from the previously stored plist. I 110 ;; wrote a tiny patch to `org-email-link-description' so it 111 ;; could take a non-stored plist as an optional 2nd argument, 112 ;; but the plist provided still needs 'fromname'/'fromaddress'. 113 ;; 114 ;; - Ideally we would decouple the storing bit of 115 ;; `org-store-link-props' from the extraction bit, but lots of 116 ;; stuff in `org-store-link' which calls it would need to be 117 ;; changed. Maybe just factor out the extraction so it can be 118 ;; reused separately? 119 (let ((mid (plist-get plist :message-id))) 120 (apply 'org-store-link-props 121 (append plist 122 (list :type "mairix" 123 :link (org-mairix-construct-link mid)))) 124 (apply 'org-store-link-props 125 (append org-store-link-plist 126 (list :description (org-email-link-description)))))) 127 128 (defun org-mairix-message-send-and-exit-with-link () 129 "Function that can be assigned as an alternative sending function, 130 it sends the message and then stores a mairix link to it before burying 131 the buffer just like 'message-send-and-exit' does." 132 (interactive) 133 (message-send) 134 (let* ((message-id (message-fetch-field "Message-Id")) 135 (subject (message-fetch-field "Subject")) 136 (link (org-mairix-construct-link message-id)) 137 (desc (concat "Email: '" subject "'"))) 138 (setq org-stored-links 139 (cons (list link desc) org-stored-links))) 140 (message-bury (current-buffer))) 141 142 (defun org-mairix-open (search _) 143 "Function to open mairix link. 144 145 We first need to split it into its individual parts, and then 146 extract the message-id to be passed on to the display function 147 before call mairix, evaluate the number of matches returned, and 148 make sure to only call display of mairix succeeded in matching." 149 (let* ((args "")) 150 (if (equal (substring search 0 2) "t:" ) 151 (progn (setq search (substring search 2 nil)) 152 (setq args (concat args " --threads")))) 153 (if (equal (substring search 0 2) "a:") 154 (progn (setq search (substring search 2 nil)) 155 (setq args (concat args " --augment")))) 156 (let ((cmdline (org-mairix-command-substitution 157 org-mairix-open-command search args))) 158 (print cmdline) 159 (setq retval (shell-command-to-string cmdline)) 160 (string-match "\[0-9\]+" retval) 161 (setq matches (string-to-number (match-string 0 retval))) 162 (if (eq matches 0) (message "Link failed: no matches, sorry") 163 (message "Link returned %d matches" matches) 164 (run-hook-with-args 'org-mairix-display-hook search args))))) 165 166 (defun org-mairix-command-substitution (cmd search args) 167 "Substitute '%search%' and '%args% in mairix search command." 168 (while (string-match "%search%" cmd) 169 (setq cmd (replace-match search 'fixedcase 'literal cmd))) 170 (while (string-match "%args%" cmd) 171 (setq cmd (replace-match args 'fixedcase 'literal cmd))) 172 cmd) 173 174 ;;; Functions necessary for integration of external MUAs. 175 176 ;; Of course we cannot call `org-store-link' from within an external 177 ;; MUA, so we need some other way of storing a link for later 178 ;; retrieval by org-mode and/or remember-mode. To do this we use a 179 ;; temporary file as a kind of dedicated clipboard. 180 181 (defcustom org-mairix-link-clipboard "~/.org-mairix-link" 182 "Pseudo-clipboard file where mairix URLs get copied to by external 183 applications in order to mimic `org-store-link'. Used by 184 `org-mairix-insert-link'." 185 :group 'org-mairix 186 :type 'string) 187 188 ;; When we resolve some of the issues with `org-store-link' detailed 189 ;; at <https://orgmode.org/list/20071105181739.GB13544@atlantic.linksys.moosehall 190 ;; we might not need org-mairix-insert-link. 191 192 (defun org-mairix-insert-link () 193 "Insert link from file defined by `org-mairix-link-clipboard'." 194 (interactive) 195 (let ((bytes (cadr (insert-file-contents 196 (expand-file-name org-mairix-link-clipboard))))) 197 (forward-char bytes) 198 (save-excursion 199 (forward-char -1) 200 (if (looking-at "\n") 201 (delete-char 1))))) 202 203 ;;; Functions necessary for mutt integration 204 205 (defgroup org-mairix-mutt nil 206 "Use mutt for mairix support in org." 207 :tag "Org Mairix Mutt" 208 :group 'org-mairix) 209 210 (defcustom org-mairix-mutt-display-command 211 "xterm -title 'mairix search: %search%' -e 'unset COLUMNS; mutt -f 212 ~/mail/mairix -e \"push <display-message>\"' &" 213 "Command to execute to display mairix search results via mutt within 214 an xterm. 215 216 '%search%' will get substituted with the search expression, and 217 '%args%' with any additional arguments used in the search." 218 :group 'org-mairix-mutt 219 :type 'string) 220 221 (defun org-mairix-mutt-display-results (search args) 222 "Display results of mairix search in mutt, using the command line 223 defined in `org-mairix-mutt-display-command'." 224 ;; By default, async `shell-command' invocations display the temp 225 ;; buffer, which is annoying here. We choose a deterministic 226 ;; buffer name so we can hide it again immediately. 227 ;; Note: `call-process' is synchronous so not useful here. 228 (let ((cmd (org-mairix-command-substitution 229 org-mairix-mutt-display-command search args)) 230 (tmpbufname (generate-new-buffer-name " *mairix-view*"))) 231 (shell-command cmd tmpbufname) 232 (delete-windows-on (get-buffer tmpbufname)))) 233 234 ;;; Functions necessary for gnus integration 235 236 (defgroup org-mairix-gnus nil 237 "Use gnus for mairix support in org." 238 :tag "Org Mairix Gnus" 239 :group 'org-mairix) 240 241 (defcustom org-mairix-gnus-results-group "nnmaildir:mairix" 242 "The group that is configured to hold the mairix search results, 243 which needs to be setup independently of the org-mairix integration, 244 along with general mairix configuration." 245 :group 'org-mairix-gnus 246 :type 'string) 247 248 (defcustom org-mairix-gnus-select-display-group-function 249 'org-mairix-gnus-select-display-group-function-gg 250 "Hook to call to select the group that contains the matching articles. 251 We should not need this, it is owed to a problem of gnus that people were 252 not yet able to figure out, see 253 http://article.gmane.org/gmane.emacs.gnus.general/65248 254 http://article.gmane.org/gmane.emacs.gnus.general/65265 255 http://article.gmane.org/gmane.emacs.gnus.user/9596 256 for reference. 257 258 It seems gnus needs a 'forget/ignore everything you think you 259 know about that group' function. Volunteers?" 260 :group 'org-mairix-gnus 261 :type 'hook) 262 263 (defun org-mairix-store-gnus-link () 264 "Store a link to the current gnus message as a Mairix search for its 265 Message ID." 266 267 ;; gnus integration 268 (when (memq major-mode '(gnus-summary-mode gnus-article-mode)) 269 (and (eq major-mode 'gnus-article-mode) (gnus-article-show-summary)) 270 (let* ((article (gnus-summary-article-number)) 271 (header (gnus-summary-article-header article)) 272 (from (mail-header-from header)) 273 (message-id (mail-header-id header)) 274 (subject (gnus-summary-subject-string))) 275 (org-store-mairix-link-props :from from 276 :subject subject 277 :message-id message-id)))) 278 279 (defun org-mairix-gnus-display-results (search args) 280 "Display results of mairix search in Gnus. 281 282 Note: This does not work as cleanly as I would like it to. The 283 problem being that Gnus should simply reread the group cleanly, 284 without remembering anything. At the moment it seems to be unable 285 to do that -- so you're likely to see zombies floating around. 286 287 If you can improve this, please do!" 288 (if (not (equal (substring search 0 2) "m:" )) 289 (error "org-mairix-gnus-display-results: display of search other than 290 message-id not implemented yet")) 291 (setq message-id (substring search 2 nil)) 292 (require 'gnus) 293 (require 'gnus-sum) 294 ;; FIXME: (bzg/gg) We might need to make sure gnus is running here, 295 ;; and to start it in case it isn't running already. Does 296 ;; anyone know a function to do that? It seems main org mode 297 ;; does not do this, either. 298 (funcall (cdr (assq 'gnus org-link-frame-setup))) 299 (if gnus-other-frame-object (select-frame gnus-other-frame-object)) 300 301 ;; FIXME: This is horribly broken. Please see 302 ;; http://article.gmane.org/gmane.emacs.gnus.general/65248 303 ;; http://article.gmane.org/gmane.emacs.gnus.general/65265 304 ;; http://article.gmane.org/gmane.emacs.gnus.user/9596 305 ;; for reference. 306 ;; 307 ;; It seems gnus needs a "forget/ignore everything you think you 308 ;; know about that group" function. Volunteers? 309 ;; 310 ;; For now different methods seem to work differently well for 311 ;; different people. So we're playing hook-selection here to make 312 ;; it easy to play around until we found a proper solution. 313 (run-hook-with-args 'org-mairix-gnus-select-display-group-function) 314 (gnus-summary-select-article 315 nil t t (car (gnus-find-matching-articles "message-id" message-id)))) 316 317 (defun org-mairix-gnus-select-display-group-function-gg () 318 "Georg's hack to select a group that gnus (falsely) believes to be 319 empty to then call rebuilding of the summary. It leaves zombies of 320 old searches around, though." 321 (gnus-group-quick-select-group 0 org-mairix-gnus-results-group) 322 (gnus-group-clear-data) 323 (gnus-summary-reselect-current-group t t)) 324 325 (defun org-mairix-gnus-select-display-group-function-bzg () 326 "This is the classic way the org mode is using, and it seems to be 327 using better for Bastien, so it may work for you." 328 (gnus-group-clear-data org-mairix-gnus-results-group) 329 (gnus-group-read-group t nil org-mairix-gnus-results-group)) 330 331 (provide 'org-mairix) 332 333 ;;; org-mairix.el ends here