Fix problem introduced by recent commit that broke using SPC as separator.
[planner-el.git] / planner-unix-mail.el
blob4fe59d42b9ad5de19c1d33857d4530e99378a3de
1 ;;; planner-unix-mail.el --- Unix mailbox support for Planner
3 ;; Copyright (C) 2004, 2008 Frederik Fouvry <fouvry@coli.uni-saarland.de>
5 ;; Author: Frederik Fouvry <fouvry@coli.uni-saarland.de>
6 ;; Keywords:
8 ;; This file is part of Planner. It is not part of GNU Emacs.
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 3, or (at your option)
13 ;; any later version.
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.
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.
25 ;;; Commentary:
27 ;;;_ + Usage
29 ;; Place planner-unix-mail.el in your load path and add this to your .emacs:
31 ;; (require 'planner-unix-mail)
33 ;; Unix mailbox URLs are of the form
35 ;; mail://PATH/TO/INBOX/message-id
37 ;; Annotations will be of the form
38 ;; [[mail://PATH/TO/INBOX/E1AyTpt-0000JR-LU%40sacha.ateneo.edu][E-mail from Sacha Chua]]
40 ;;; Contributors:
42 ;; Yann Hodique fixed a typo and helped port this to Muse.
44 ;;; Code:
46 (require 'planner)
48 ;;; Code:
50 ;; This is (kind of) a combination of the "mid" and "file" (RFC 1738)
51 ;; protocol.
52 (defconst planner-unix-mail-protocol-name "mail")
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))))
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))))))
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)))))))
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))))))
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"))))))
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)
181 (provide 'planner-unix-mail)
183 ;; Local Variables:
184 ;; indent-tabs-mode: t
185 ;; tab-width: 8
186 ;; End: