1 ;;; planner-gnus.el --- Gnus integration for the Emacs Planner
3 ;; Copyright (C) 2001, 2003, 2004, 2005 Free Software Founation, Inc.
4 ;; Parts copyright (C) 2004 Mario Domgörgen (kanaldrache AT gmx.de)
6 ;; Author: John Wiegley <johnw@gnu.org>
7 ;; Keywords: planner, gnus
8 ;; URL: http://www.plannerlove.com/
10 ;; This file is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; This file is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to
22 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02110-1301, USA.
27 ;; This file adds annotations for Gnus messages. ;You will then be
28 ;; able to use M-x planner-create-task-from-buffer to create tasks
29 ;; from Gnus summary or message buffers with the correct annotation.
32 ;; (planner-gnus-insinuate)
34 ;; to your .emacs, you can also use 'C-c C-t' to create a task from a buffer.
38 ;; Daniel Neri (dne AT mayonnaise DOT net) fixed a few typos and
39 ;; updated the commentary.
41 ;; Mario Domgörgen (kanaldrache AT gmx DOT de) got this to work nicely
42 ;; with multiple marked messages in Gnus summary buffers.
44 ;; Sven Kloppenburg (kloppenburg AT informatik.tu-darmstadt.de)
45 ;; provided a patch to use gnus-registry if loaded.
47 ;; Magnus Henoch (mange AT freemail.hu) provided a patch to add space
48 ;; after the author's name on newgroups.
50 ;; Stefan Reichör fixed a problem with getting group names from Gnus.
52 ;; Yann Hodique fixed a couple of typos.
54 ;; Dale Smith helped determine the necessary changes for Emacs21
64 (defun planner-gnus-insinuate ()
65 "Hook Planner into Gnus.
67 Adds special planner keybindings to the variable
68 `gnus-summary-article-map'. From a summary or article buffer, you
69 can type C-c C-t to call planner-create-task-from-buffer."
70 (eval-after-load 'gnus-sum
71 `(define-key gnus-summary-article-map
,(kbd "C-c C-t")
72 'planner-create-task-from-buffer
))
73 (eval-after-load 'gnus
74 `(define-key gnus-article-mode-map
,(kbd "C-c C-t")
75 'planner-create-task-from-buffer
)))
79 (defun planner-gnus-get-message-id (&optional article-number
)
80 "Return the message-id of the current message."
82 (if (equal major-mode
'gnus-summary-mode
)
83 (mail-header-message-id (gnus-data-header
84 (assq (or article-number
85 (gnus-summary-article-number))
86 gnus-newsgroup-data
)))
87 ;; Refer to the article buffer
89 (goto-char (point-min))
90 (let ((case-fold-search t
))
91 (when (re-search-forward "^Message-ID:\\s-*\\(.+\\)"
93 (match-string 1)))))))
95 (defun planner-gnus-get-address (&optional header
)
96 "Return the address of the sender of the current message.
97 If HEADER is \"To\", return the recipient instead."
99 (goto-char (point-min))
100 (let ((case-fold-search t
))
101 (when (re-search-forward
102 (concat "^" (or header
"From") ":\\s-*\\(.+\\)")
104 (planner-match-string-no-properties 1)))))
106 (defun planner-gnus-annotation-from-summary ()
107 "If called from a Gnus summary buffer, return an annotation.
108 Suitable for use in `planner-annotation-functions'."
109 (when (equal major-mode
'gnus-summary-mode
)
110 (let ((articles (gnus-summary-work-articles nil
)))
112 (concat "gnus://" gnus-newsgroup-name
"/"
113 (mapconcat (lambda (article-number)
114 (planner-gnus-get-message-id article-number
))
115 (gnus-summary-work-articles nil
) "\\|"))
116 (if (= 1 (length articles
))
117 (let ((headers (gnus-data-header (assq (car articles
)
118 gnus-newsgroup-data
))))
119 (if (gnus-news-group-p gnus-newsgroup-name
)
121 (if (and planner-ignored-from-addresses
123 planner-ignored-from-addresses
124 (mail-header-from headers
)))
127 (planner-get-name-from-address
128 (mail-header-from headers
))
133 (if (and planner-ignored-from-addresses
134 (mail-header-from headers
)
135 (string-match planner-ignored-from-addresses
136 (mail-header-from headers
))
138 (mail-header-extra headers
)))
139 ;; Mail from me, so use the To: instead
140 (concat "to " (planner-get-name-from-address
144 ;; Mail to me, so use the From:
145 (concat "from " (planner-get-name-from-address
146 (mail-header-from headers
)))))))
147 (concat (number-to-string (length articles
))
148 " E-Mails from folder " gnus-newsgroup-name
))
151 (defun planner-gnus-annotation-from-message ()
152 "If called from a Gnus article, return an annotation.
153 Suitable for use in `planner-annotation-functions'."
154 (when (or (equal major-mode
'gnus-article-mode
)
155 (equal major-mode
'gnus-original-article-mode
))
156 (gnus-copy-article-buffer)
157 (with-current-buffer gnus-article-copy
158 (let ((from (planner-gnus-get-address "From"))
159 (newsgroups (planner-gnus-get-address "Newsgroups")))
161 (concat "gnus://" gnus-newsgroup-name
"/"
162 (planner-gnus-get-message-id))
165 (if (and planner-ignored-from-addresses
167 planner-ignored-from-addresses from
))
170 (planner-get-name-from-address from
)
176 (planner-gnus-get-address "To")))
177 (if (and planner-ignored-from-addresses
181 planner-ignored-from-addresses from
))
182 (concat "to " (planner-get-name-from-address
184 (concat "from " (planner-get-name-from-address
189 (defun planner-gnus-annotation ()
190 "Return an annotation from a Gnus summary or message buffer.
191 Suitable for use in `planner-annotation-functions'. If you
192 include this, you can omit `planner-gnus-annotation-from-summary'
193 and `planner-gnus-annotation-from-message'."
194 (or (planner-gnus-annotation-from-summary)
195 (planner-gnus-annotation-from-message)))
197 (defvar planner-gnus-group-threshold
10
198 "Number of messages to retrieve from groups.
199 Raise this if you have problems browsing gnus URLs.")
202 (defun planner-gnus-browse-url (url)
203 "If this is a Gnus URL, jump to it."
204 (when (string-match "\\`gnus://\\(.+\\)/\\(.+\\)" url
)
205 (let ((group (match-string 1 url
))
206 (articles (match-string 2 url
)))
207 (when (featurep 'gnus-registry
)
208 (let ((reg-group (gnus-registry-fetch-group articles
)))
210 (if gnus-registry-use-long-group-names
211 (setq group reg-group
)
212 (when (cadr (split-string group
":")) ;; group contains a :
213 (setq group
(concat (car (split-string group
":")) ":"
216 (gnus-fetch-group group planner-gnus-group-threshold
)
217 (error (gnus-fetch-group group
)))
220 (gnus-summary-goto-article article-id nil t
))
221 (split-string articles
"\\\\|"))
222 (let ((articles (if (fboundp 'gnus-find-matching-articles
)
223 (gnus-find-matching-articles "message-id" articles
)
224 (gnus-summary-find-matching "message-id" articles
226 (gnus-summary-limit articles
)
227 (gnus-summary-select-article))
230 (fset 'planner-get-from
'planner-gnus-get-address
)
231 (fset 'planner-get-message-id
'planner-gnus-get-message-id
)
232 (custom-add-option 'planner-annotation-functions
233 'planner-gnus-annotation
)
234 (add-hook 'planner-annotation-functions
'planner-gnus-annotation
)
235 (planner-add-protocol "gnus://" 'planner-gnus-browse-url nil
)
237 (provide 'planner-gnus
)
239 ;;; planner-gnus.el ends here