planner-rmail.el

   1 ;;; planner-rmail.el --- RMAIL support for Planner, an organizer for Emacs
   2
   3 ;; Copyright (C) 2004, 2006, 2008 Free Software Foundation, Inc.
   4 ;; Parts copyright (C) 2004, 2008 Frederik Fouvry
   5
   6 ;;; Commentary:
   7 ;;
   8 ;;;_* Commentary
   9
  10 ;;;_ + Package description
  11
  12 ;; Emacs Lisp Archive Entry
  13 ;; Filename: planner-rmail.el
  14 ;; Keywords: hypermedia
  15 ;; Author: John Wiegley <johnw@gnu.org>
  16 ;; Description: Use Emacs for life planning
  17 ;; URL: http://www.wjsullivan.net/PlannerMode.html
  18 ;; Compatibility: Emacs20, Emacs21, Emacs22, XEmacs21
  19
  20 ;; This file is part of Planner.  It is not part of GNU Emacs.
  21
  22 ;; Planner is free software; you can redistribute it and/or modify it
  23 ;; under the terms of the GNU General Public License as published by
  24 ;; the Free Software Foundation; either version 3, or (at your option)
  25 ;; any later version.
  26
  27 ;; Planner is distributed in the hope that it will be useful, but
  28 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  29 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  30 ;; General Public License for more details.
  31
  32 ;; You should have received a copy of the GNU General Public License
  33 ;; along with Planner; see the file COPYING.  If not, write to the
  34 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  35 ;; Boston, MA 02110-1301, USA.
  36
  37 ;;;_ + Usage
  38
  39 ;; Place planner-rmail.el in your load path and add this to your .emacs:
  40 ;;
  41 ;;    (require 'planner-rmail)
  42 ;;
  43 ;; RMAIL URLs are of the form
  44 ;;
  45 ;; rmail://PATH/TO/INBOX/message-id
  46 ;;
  47 ;; Annotations will be of the form
  48 ;; [[rmail://PATH/TO/INBOX/<E1AyTpt-0000JR-LU@sacha.ateneo.edu>][E-mail from Sacha Chua]]
  49
  50 ;;;_ + Contributors
  51
  52 ;; Frederik Fouvry (fouvry AT coli DOT uni-sb DOT de) made an
  53 ;; improvement to gracefully deal with missing messages.
  54
  55 (require 'planner)
  56 (require 'rmail)
  57
  58 ;;; Code:
  59
  60 ;; This isn't provided in XEmacs
  61 (defun planner-rmail-narrow-to-non-pruned-header ()
  62   "Narrow to the whole (original) header of the current message."
  63   (if (fboundp 'rmail-narrow-to-non-pruned-header)
  64       (rmail-narrow-to-non-pruned-header)
  65     (let (start end)
  66       (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max))
  67       (goto-char (point-min))
  68       (forward-line 1)
  69       (if (= (following-char) ?1)
  70           (progn
  71             (forward-line 1)
  72             (setq start (point))
  73             (search-forward "*** EOOH ***\n")
  74             (setq end (match-beginning 0)))
  75         (forward-line 2)
  76         (setq start (point))
  77         (search-forward "\n\n")
  78         (setq end (1- (point))))
  79       (narrow-to-region start end)
  80       (goto-char start))))
  81
  82
  83 ;;;###autoload
  84 (defun planner-rmail-annotation-from-mail ()
  85   "Return an annotation for the current message.
  86 This function can be added to `planner-annotation-functions'."
  87   (when (eq major-mode 'rmail-mode)
  88     (save-excursion
  89       (save-restriction
  90         (planner-rmail-narrow-to-non-pruned-header)
  91         (planner-make-link
  92          (concat "rmail://" (buffer-file-name) "/" (mail-fetch-field "message-id"))
  93          (if (and planner-ignored-from-addresses
  94                   (string-match planner-ignored-from-addresses
  95                                 (mail-fetch-field "from")))
  96              (concat "E-mail to " (planner-get-name-from-address
  97                                    (mail-fetch-field "to")))
  98            (concat "E-mail from " (planner-get-name-from-address
  99                                    (mail-fetch-field "from"))))
 100          t)))))
 101
 102 ;;;###autoload
 103 (defun planner-rmail-browse-url (url)
 104   "If this is an RMAIL URL, jump to it."
 105   (when (string-match "\\`rmail://\\(.+\\)/\\(.+?\\)$" url)
 106     (let ((message-id (match-string 2 url))
 107           (file (match-string 1 url))
 108           message-number)
 109       ;; Backward compatibility
 110       (save-excursion
 111         (save-window-excursion
 112           (rmail (if (string= file "RMAIL") rmail-file-name file))
 113           (setq message-number
 114                 (save-restriction
 115                   (widen)
 116                   (goto-char (point-max))
 117                   (if (re-search-backward
 118                        (concat "^Message-ID:\\s-+" (regexp-quote message-id))
 119                        nil t)
 120                       (rmail-what-message))))))
 121       (if message-number
 122           (progn
 123             (rmail (if (string= file "RMAIL") rmail-file-name file))
 124             (rmail-show-message message-number)
 125             message-number)
 126         (error "Message not found")))))
 127
 128 (planner-add-protocol "rmail://" 'planner-rmail-browse-url nil)
 129 (add-hook 'planner-annotation-functions 'planner-rmail-annotation-from-mail)
 130 (custom-add-option 'planner-annotation-functions
 131                    'planner-rmail-annotation-from-rmail)
 132 (planner-update-wiki-project)
 133 (provide 'planner-rmail)
 134
 135 ;;;_* Local emacs vars.
 136
 137 ;; Local variables:
 138 ;; allout-layout: (* 0 : )
 139 ;; End:
 140
 141 ;;; planner-rmail.el ends here