planner-vm.el

   1 ;;; planner-vm.el --- VM support for Planner, an organizer for Emacs
   2
   3 ;; Copyright (C) 2004, 2005, 2008 Free Software Foundation, Inc.
   4
   5 ;;; Commentary:
   6 ;;
   7 ;;;_* Commentary
   8
   9 ;;;_ + Package description
  10
  11 ;; Emacs Lisp Archive Entry
  12 ;; Filename: planner.el
  13 ;; Keywords: hypermedia
  14 ;; Author: John Wiegley <johnw@gnu.org>
  15 ;; Description: Use Emacs for life planning
  16 ;; URL: http://www.wjsullivan.net/PlannerMode.html
  17 ;; Compatibility: Emacs20, Emacs21, Emacs22, XEmacs21
  18
  19 ;; This file is part of Planner.  It is not part of GNU Emacs.
  20
  21 ;; Planner is free software; you can redistribute it and/or modify it
  22 ;; under the terms of the GNU General Public License as published by
  23 ;; the Free Software Foundation; either version 3, or (at your option)
  24 ;; any later version.
  25
  26 ;; Planner is distributed in the hope that it will be useful, but
  27 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  28 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  29 ;; General Public License for more details.
  30
  31 ;; You should have received a copy of the GNU General Public License
  32 ;; along with Planner; see the file COPYING.  If not, write to the
  33 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  34 ;; Boston, MA 02110-1301, USA.
  35
  36 ;;;_ + Usage
  37 ;;
  38 ;; Place planner-vm.el in your load path and add this to your .emacs:
  39 ;;
  40 ;;    (require 'planner-vm)
  41 ;;
  42 ;; VM URLs are of the form
  43 ;;
  44 ;; vm://path/to/inbox/message-id
  45 ;;
  46 ;; Annotations will be of the form
  47 ;; [[vm://home/test/INBOX/<E1AyTpt-0000JR-LU@sacha.ateneo.edu>][E-mail from Sacha Chua]]
  48
  49 ;;;_ + Contributors
  50
  51 ;; Jürgen Doser (email address unknown) contributed a patch to
  52 ;; properly open a vm message.
  53
  54 ;; Greg Novak provided a message-id bugfix.
  55
  56 ;; Fran Burstall provided a patch that turned on annotations in
  57 ;; vm-presentation-mode.
  58
  59 (require 'planner)
  60 (require 'vm)
  61
  62 ;;; Code:
  63
  64 ;;;###autoload
  65 (defun planner-vm-annotation-from-mail ()
  66   "Return an annotation for the current message.
  67 This function can be added to `planner-annotation-functions'."
  68   (save-excursion
  69     (save-restriction
  70       (when (eq major-mode 'vm-summary-mode)
  71         (vm-follow-summary-cursor)
  72         (set-buffer vm-mail-buffer))
  73       (when (memq major-mode '(vm-mode vm-presentation-mode))
  74         (let ((message (car vm-message-pointer)))
  75           (planner-make-link
  76            (concat "vm://"
  77                    (buffer-file-name
  78                     (marker-buffer
  79                      (elt (vm-location-data-of
  80                            (vm-real-message-of message)) 0)))
  81                    "/"
  82                    (vm-get-header-contents message "Message-ID"))
  83            (if (and planner-ignored-from-addresses
  84                     (string-match planner-ignored-from-addresses
  85                                   (vm-get-header-contents message "From")))
  86                (concat "E-mail to " (planner-get-name-from-address
  87                                      (vm-get-header-contents message "To")))
  88              (concat "E-mail from "
  89                      (planner-get-name-from-address
  90                       (vm-get-header-contents message "From"))))
  91            t))))))
  92
  93 ;;;###autoload
  94 (defun planner-vm-browse-url (url)
  95   "If this is an VM URL, jump to it."
  96   (when (string-match "\\`vm://\\(.+\\)/\\([^/\n]+\\)$" url)
  97     (let ((message-id (match-string 2 url))
  98           (inbox (match-string 1 url)))
  99       ; open the inbox read-only
 100       (vm inbox t)
 101       (let ((mp vm-message-list)
 102             (done nil))
 103         ; search for matching message-id
 104         (while (and mp (not done))
 105           (if (string= message-id (vm-get-header-contents (car mp) "Message-ID"))
 106               ; jump to the message and done
 107               (progn
 108                 (vm-record-and-change-message-pointer
 109                  vm-message-pointer mp)
 110                 (vm-preview-current-message)
 111                 (setq done t))
 112             (setq mp (cdr mp))))
 113         t))))
 114
 115 (planner-add-protocol "vm://" 'planner-vm-browse-url nil)
 116 (add-hook 'planner-annotation-functions 'planner-vm-annotation-from-mail)
 117 (custom-add-option 'planner-annotation-functions
 118                    'planner-vm-annotation-from-mail)
 119 (planner-update-wiki-project)
 120 (provide 'planner-vm)
 121
 122 ;;;_* Local emacs vars.
 123
 124 ;; Local variables:
 125 ;; allout-layout: (* 0 : )
 126 ;; End:
 127
 128 ;;; planner-vm.el ends here