planner-unix-mail.el

   1 ;;; planner-unix-mail.el --- Unix mailbox support for Planner
   2
   3 ;; Copyright (C) 2004  Frederik Fouvry <fouvry@coli.uni-saarland.de>
   4
   5 ;; Author: Frederik Fouvry <fouvry@coli.uni-saarland.de>
   6 ;; Keywords:
   7
   8 ;; This file is part of Planner.  It is not part of GNU Emacs.
   9
  10 ;; Planner is free software; you can redistribute it and/or modify it
  11 ;; under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; Planner is distributed in the hope that it will be useful, but
  16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18 ;; General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with Planner; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24
  25 ;;; Commentary:
  26
  27 ;;;_ + Usage
  28 ;;
  29 ;; Place planner-unix-mail.el in your load path and add this to your .emacs:
  30 ;;
  31 ;;    (require 'planner-unix-mail)
  32 ;;
  33 ;; Unix mailbox URLs are of the form
  34 ;;
  35 ;; mail://PATH/TO/INBOX/message-id
  36 ;;
  37 ;; Annotations will be of the form
  38 ;; [[mail://PATH/TO/INBOX/E1AyTpt-0000JR-LU%40sacha.ateneo.edu][E-mail from Sacha Chua]]
  39
  40 ;;; Contributors:
  41
  42 ;; Yann Hodique fixed a typo and helped port this to Muse.
  43
  44 ;;; Code:
  45
  46 (require 'planner)
  47
  48 ;;; Code:
  49
  50 ;; This is (kind of) a combination of the "mid" and "file" (RFC 1738)
  51 ;; protocol.
  52 (defconst planner-unix-mail-protocol-name "mail")
  53
  54 (defun planner-unix-mail-narrow-to-message ()
  55   (save-match-data
  56     (let ((b (or (and (looking-at "^From ") (point))
  57                  (re-search-backward "^From ")))
  58           (e (progn
  59                (re-search-forward "\n\n\\(?:From \\|\\'\\)" nil 'point)
  60                (forward-line 0)
  61                (point))))
  62     (narrow-to-region b e))))
  63
  64
  65 ;; Encoding according to RFC 1738.
  66 (defun planner-url-encode (string &optional reserved)
  67   (save-match-data
  68     (let ((chars (split-string string ""))
  69           (newchars)
  70           (not-to-encode (concat "\\(?:[0-9A-Za-z]\\|[$_.+!*'(),-]"
  71                                  (if (and (stringp reserved)
  72                                           (not (string= reserved "")))
  73                                      (concat "\\|" reserved)
  74                                    "")
  75                                  "\\)")))
  76       (while chars
  77         (setq newchars
  78               (cons (if (string-match not-to-encode (car chars))
  79                         (car chars)
  80                       (format "%%%x" (string-to-char (car chars))))
  81                     newchars)
  82               chars (cdr chars)))
  83       (eval (cons 'concat (nreverse newchars))))))
  84
  85 ;; Decoding according to RFC 1738
  86 (defun planner-url-decode (string)
  87   (save-match-data
  88     (let* ((parts (split-string string "%"))
  89            (newparts)
  90            (ignore))
  91       (unless (string-match "^%" string)
  92         (setq ignore (car parts)
  93               parts (cdr parts)))
  94       (while parts
  95         (when (string-match "^\\(..\\)" (car parts))
  96           (setq newparts (cons (replace-match
  97                                 (char-to-string
  98                                  (string-to-number (match-string 1 (car parts))
  99                                                    16))
 100                                 nil t (car parts) 1)
 101                                newparts)))
 102         (setq parts (cdr parts)))
 103       (eval (cons 'concat (append (when ignore (list ignore))
 104                                   (nreverse newparts)))))))
 105
 106
 107 ;;;###autoload
 108 (defun planner-unix-mail-annotation-from-mail ()
 109   "Return an annotation for the current message.
 110 This function can be added to `planner-annotation-functions'."
 111   (save-match-data
 112     ;; This test replaces the major-mode test.
 113     (when (save-excursion
 114             (save-restriction
 115               (widen)
 116               (and (goto-char (point-min))
 117                    (re-search-forward "\\`From " nil t)
 118                    (goto-char (- (point-max) 3))
 119                    (re-search-forward "\n\n\\'" nil t))))
 120       (save-excursion
 121         (save-restriction
 122           (planner-unix-mail-narrow-to-message)
 123           (planner-make-link
 124            (concat planner-unix-mail-protocol-name "://"
 125                    (buffer-file-name) "/"
 126                    ;; Format is defined on RFC 2111 ("/" is reserved,
 127                    ;; but should not be used because of the presence
 128                    ;; of the file path)
 129                    (let* ((mid (mail-fetch-field "message-id")))
 130                      (if (stringp mid)
 131                          (if (string-match "^<\\(.+\\)>$" mid)
 132                              (planner-url-encode (match-string 1 mid) "[/]")
 133                            (error "Mal-formed Message-Id header field encountered"))
 134                        ;; From_ header could be used as a backup
 135                        (error "No Message-Id header field found in this message"))))
 136            (if (and planner-ignored-from-addresses
 137                     (string-match planner-ignored-from-addresses
 138                                   (mail-fetch-field "from"))
 139                     (mail-fetch-field "to")) ; May be missing
 140                (concat "E-mail to " (planner-get-name-from-address
 141                                      (mail-fetch-field "to")))
 142              (concat "E-mail from " (planner-get-name-from-address
 143                                      (mail-fetch-field "from"))))
 144            t))))))
 145
 146
 147 ;;;###autoload
 148 (defun planner-unix-mail-browse-url (url)
 149   "If this is an UNIX-MAIL URL, jump to it."
 150   (save-match-data
 151     (when (string-match (concat "\\`" planner-unix-mail-protocol-name
 152                                 "://\\(.+\\)/\\(.+?\\)$") url)
 153       (let* ((message-id (planner-url-decode (match-string 2 url)))
 154              (file (match-string 1 url))
 155              (point (save-excursion
 156                       (save-window-excursion
 157                         (find-file file)
 158                         (save-restriction
 159                           (widen)
 160                           (goto-char (point-max))
 161                           (re-search-backward
 162                            (concat "^Message-Id:[[:space:]]+<"
 163                                    (regexp-quote message-id) ">")
 164                            nil t))))))
 165         (if point
 166             (progn
 167               (find-file file)
 168               (goto-char point)
 169               (re-search-backward "^From ")
 170               (recenter 0))
 171           (error "Message not found"))))))
 172
 173 (planner-add-protocol (concat planner-unix-mail-protocol-name "://")
 174                       'planner-unix-mail-browse-url nil)
 175 (add-hook 'planner-annotation-functions
 176           'planner-unix-mail-annotation-from-mail)
 177 (custom-add-option 'planner-annotation-functions
 178                    'planner-unix-mail-annotation-from-rmail)
 179 (planner-update-wiki-project)
 180
 181 (provide 'planner-unix-mail)
 182 ;;
 183 ;; Local Variables:
 184 ;; indent-tabs-mode: t
 185 ;; tab-width: 8
 186 ;; End: