Fix problem introduced by recent commit that broke using SPC as separator.
[planner-el.git] / planner-gnus.el
blobb9ea7cd7cbff212b25ce5009ad3614b27b9d2663
1 ;;; planner-gnus.el --- Gnus integration for the Emacs Planner
3 ;; Copyright (C) 2001, 2003, 2004, 2005,
4 ;; 2006, 2007, 2008 Free Software Foundation, Inc.
5 ;; Parts copyright (C) 2004, 2008 Mario Domgörgen (kanaldrache AT gmx.de)
7 ;; Author: John Wiegley <johnw@gnu.org>
8 ;; Keywords: planner, gnus
9 ;; URL: http://www.emacswiki.org/cgi-bin/wiki/PlannerMode
11 ;; This file is part of Planner. It is not part of GNU Emacs.
13 ;; Planner is free software; you can redistribute it and/or modify it
14 ;; under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation; either version 3, or (at your option)
16 ;; any later version.
18 ;; Planner is distributed in the hope that it will be useful, but
19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
21 ;; General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with Planner; see the file COPYING. If not, write to the
25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
26 ;; Boston, MA 02110-1301, USA.
28 ;;; Commentary:
30 ;; This file adds annotations for Gnus messages. ;You will then be
31 ;; able to use M-x planner-create-task-from-buffer to create tasks
32 ;; from Gnus summary or message buffers with the correct annotation.
33 ;; If you add
35 ;; (planner-gnus-insinuate)
37 ;; to your .emacs, you can also use 'C-c C-t' to create a task from a buffer.
39 ;;; Contributors:
41 ;; Daniel Neri (dne AT mayonnaise DOT net) fixed a few typos and
42 ;; updated the commentary.
44 ;; Mario Domgörgen (kanaldrache AT gmx DOT de) got this to work nicely
45 ;; with multiple marked messages in Gnus summary buffers.
47 ;; Sven Kloppenburg (kloppenburg AT informatik.tu-darmstadt.de)
48 ;; provided a patch to use gnus-registry if loaded.
50 ;; Magnus Henoch (mange AT freemail.hu) provided a patch to add space
51 ;; after the author's name on newgroups.
53 ;; Stefan Reichör fixed a problem with getting group names from Gnus.
55 ;; Yann Hodique fixed a couple of typos.
57 ;; Dale Smith helped determine the necessary changes for Emacs21
58 ;; support.
60 ;;; Code:
62 (require 'planner)
63 (require 'gnus)
64 (require 'gnus-msg)
66 ;;;###autoload
67 (defun planner-gnus-insinuate ()
68 "Hook Planner into Gnus.
70 Adds special planner keybindings to the variable
71 `gnus-summary-article-map'. From a summary or article buffer, you
72 can type C-c C-t to call planner-create-task-from-buffer."
73 (eval-after-load 'gnus-sum
74 `(define-key gnus-summary-mode-map ,(kbd "C-c C-t")
75 'planner-create-task-from-buffer))
76 (eval-after-load 'gnus
77 `(define-key gnus-article-mode-map ,(kbd "C-c C-t")
78 'planner-create-task-from-buffer)))
80 (require 'gnus-sum)
82 (defun planner-gnus-get-message-id (&optional article-number)
83 "Return the message-id of the current message."
84 (save-excursion
85 (if (equal major-mode 'gnus-summary-mode)
86 (let
87 ((mhmi
88 (mail-header-message-id (gnus-data-header
89 (assq (or article-number
90 (gnus-summary-article-number))
91 gnus-newsgroup-data)))))
92 (if (nnheader-fake-message-id-p mhmi)
93 (number-to-string article-number)
94 mhmi))
95 ;; Refer to the article buffer
96 (save-excursion
97 (goto-char (point-min))
98 (let ((case-fold-search t))
99 (when (re-search-forward "^Message-ID:\\s-*\\(.+\\)"
100 (point-max) t)
101 (match-string 1)))))))
103 (defun planner-gnus-get-address (&optional header)
104 "Return the address of the sender of the current message.
105 If HEADER is \"To\", return the recipient instead."
106 (save-excursion
107 (goto-char (point-min))
108 (let ((case-fold-search t))
109 (when (re-search-forward
110 (concat "^" (or header "From") ":\\s-*\\(.+\\)")
111 (point-max) t)
112 (planner-match-string-no-properties 1)))))
114 (defun planner-gnus-annotation-from-summary ()
115 "If called from a Gnus summary buffer, return an annotation.
116 Suitable for use in `planner-annotation-functions'."
117 (when (equal major-mode 'gnus-summary-mode)
118 (let ((articles (gnus-summary-work-articles nil)))
119 (planner-make-link
120 (concat "gnus://" gnus-newsgroup-name "/"
121 (mapconcat (lambda (article-number)
122 (planner-gnus-get-message-id article-number))
123 (gnus-summary-work-articles nil) "\\|"))
124 (if (= 1 (length articles))
125 (let ((headers (gnus-data-header (assq (car articles)
126 gnus-newsgroup-data))))
127 (if (gnus-news-group-p gnus-newsgroup-name)
128 (concat "Post "
129 (if (and planner-ignored-from-addresses
130 (string-match
131 planner-ignored-from-addresses
132 (mail-header-from headers)))
134 (concat "from "
135 (planner-get-name-from-address
136 (mail-header-from headers))
137 " "))
138 "on "
139 gnus-newsgroup-name)
140 (concat "E-Mail "
141 (if (and planner-ignored-from-addresses
142 (mail-header-from headers)
143 (string-match planner-ignored-from-addresses
144 (mail-header-from headers))
145 (assq 'To
146 (mail-header-extra headers)))
147 ;; Mail from me, so use the To: instead
148 (concat "to " (planner-get-name-from-address
149 (cdr (assq 'To
150 (mail-header-extra
151 headers)))))
152 ;; Mail to me, so use the From:
153 (concat "from " (planner-get-name-from-address
154 (mail-header-from headers)))))))
155 (concat (number-to-string (length articles))
156 " E-Mails from folder " gnus-newsgroup-name))
157 t))))
159 (defun planner-gnus-annotation-from-message ()
160 "If called from a Gnus article, return an annotation.
161 Suitable for use in `planner-annotation-functions'."
162 (when (or (equal major-mode 'gnus-article-mode)
163 (equal major-mode 'gnus-original-article-mode))
164 (gnus-copy-article-buffer)
165 (with-current-buffer gnus-article-copy
166 (let ((from (planner-gnus-get-address "From"))
167 (newsgroups (planner-gnus-get-address "Newsgroups")))
168 (planner-make-link
169 (concat "gnus://" gnus-newsgroup-name "/"
170 (planner-gnus-get-message-id))
171 (if newsgroups
172 (concat "Post "
173 (if (and planner-ignored-from-addresses
174 (string-match
175 planner-ignored-from-addresses from))
177 (concat "from "
178 (planner-get-name-from-address from)
179 " "))
180 "on "
181 newsgroups)
182 (concat "E-Mail "
183 (let ((to-addr
184 (planner-gnus-get-address "To")))
185 (if (and planner-ignored-from-addresses
186 from
187 to-addr
188 (string-match
189 planner-ignored-from-addresses from))
190 (concat "to " (planner-get-name-from-address
191 to-addr))
192 (concat "from " (planner-get-name-from-address
193 from))))))
194 t)))))
196 ;;;###autoload
197 (defun planner-gnus-annotation ()
198 "Return an annotation from a Gnus summary or message buffer.
199 Suitable for use in `planner-annotation-functions'. If you
200 include this, you can omit `planner-gnus-annotation-from-summary'
201 and `planner-gnus-annotation-from-message'."
202 (or (planner-gnus-annotation-from-summary)
203 (planner-gnus-annotation-from-message)))
205 (defvar planner-gnus-group-threshold 10
206 "Number of messages to retrieve from groups.
207 Raise this if you have problems browsing gnus URLs.")
209 ;;;###autoload
210 (defun planner-gnus-browse-url (url)
211 "If this is a Gnus URL, jump to it."
212 (when (string-match "\\`gnus://\\(.+\\)/\\(.+\\)" url)
213 (let ((group (match-string 1 url))
214 (articles (match-string 2 url)))
215 (when (featurep 'gnus-registry)
216 (let ((reg-group (gnus-registry-fetch-group articles)))
217 (when reg-group
218 (if gnus-registry-use-long-group-names
219 (setq group reg-group)
220 (when (cadr (split-string group ":")) ;; group contains a :
221 (setq group (concat (car (split-string group ":")) ":"
222 reg-group)))))))
223 ;; Don't automatically select an article, as that might mark
224 ;; unread articles as read.
225 (let ((gnus-auto-select-first nil))
226 (condition-case err
227 (gnus-fetch-group group planner-gnus-group-threshold t group)
228 (error (gnus-fetch-group group))))
229 (mapcar
230 (lambda (article-id)
231 (gnus-summary-goto-article article-id nil t))
232 (split-string articles "\\\\|"))
233 (let ((articles (if (fboundp 'gnus-find-matching-articles)
234 (gnus-find-matching-articles "message-id" articles)
235 (gnus-summary-find-matching "message-id" articles
236 nil nil t))))
237 (gnus-summary-limit articles)
238 (gnus-summary-select-article))
239 t)))
241 (fset 'planner-get-from 'planner-gnus-get-address)
242 (fset 'planner-get-message-id 'planner-gnus-get-message-id)
243 (custom-add-option 'planner-annotation-functions
244 'planner-gnus-annotation)
245 (add-hook 'planner-annotation-functions 'planner-gnus-annotation)
246 (planner-add-protocol "gnus://" 'planner-gnus-browse-url nil)
248 (provide 'planner-gnus)
250 ;;; planner-gnus.el ends here