contrib/lisp/org-mairix.el

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