Mercurial > emacs
annotate lisp/gnus/gnus-nocem.el @ 96849:d049ef97c446
* print.c (print_object): Check print_depth before searching for
circularities.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Mon, 21 Jul 2008 05:02:31 +0000 |
parents | f42ef85caf91 |
children | a9dc0e7c3f2b |
rev | line source |
---|---|
17493 | 1 ;;; gnus-nocem.el --- NoCeM pseudo-cancellation treatment |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
2 |
74547 | 3 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
79708 | 4 ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. |
17493 | 5 |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
17493 | 7 ;; Keywords: news |
8 | |
9 ;; This file is part of GNU Emacs. | |
10 | |
94662
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
11 ;; GNU Emacs is free software: you can redistribute it and/or modify |
17493 | 12 ;; it under the terms of the GNU General Public License as published by |
94662
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
13 ;; the Free Software Foundation, either version 3 of the License, or |
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
14 ;; (at your option) any later version. |
17493 | 15 |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
94662
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
17493 | 23 |
24 ;;; Commentary: | |
25 | |
26 ;;; Code: | |
27 | |
19539
0f90eb270fc7
Require cl at compile time.
Richard M. Stallman <rms@gnu.org>
parents:
17493
diff
changeset
|
28 (eval-when-compile (require 'cl)) |
0f90eb270fc7
Require cl at compile time.
Richard M. Stallman <rms@gnu.org>
parents:
17493
diff
changeset
|
29 |
17493 | 30 (require 'gnus) |
31 (require 'nnmail) | |
32 (require 'gnus-art) | |
33 (require 'gnus-sum) | |
34 (require 'gnus-range) | |
35 | |
36 (defgroup gnus-nocem nil | |
63976
0629e50e00f6
(gnus-nocem): Finish `defgroup' description with period.
Juanma Barranquero <lekktu@gmail.com>
parents:
63868
diff
changeset
|
37 "NoCeM pseudo-cancellation treatment." |
17493 | 38 :group 'gnus-score) |
39 | |
40 (defcustom gnus-nocem-groups | |
41 '("news.lists.filters" "news.admin.net-abuse.bulletins" | |
42 "alt.nocem.misc" "news.admin.net-abuse.announce") | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
43 "*List of groups that will be searched for NoCeM messages." |
17493 | 44 :group 'gnus-nocem |
45 :type '(repeat (string :tag "Group"))) | |
46 | |
47 (defcustom gnus-nocem-issuers | |
32626 | 48 '("AutoMoose-1" ; CancelMoose[tm] |
49 "clewis@ferret.ocunix" ; Chris Lewis | |
50 "cosmo.roadkill" | |
51 "SpamHippo" | |
52 "hweede@snafu.de") | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
53 "*List of NoCeM issuers to pay attention to. |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
54 |
32626 | 55 This can also be a list of `(ISSUER CONDITION ...)' elements. |
56 | |
57 See <URL:http://www.xs4all.nl/~rosalind/nocemreg/nocemreg.html> for an | |
58 issuer registry." | |
17493 | 59 :group 'gnus-nocem |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
60 :link '(url-link "http://www.xs4all.nl/~rosalind/nocemreg/nocemreg.html") |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
61 :type '(repeat (choice string sexp))) |
17493 | 62 |
63 (defcustom gnus-nocem-directory | |
64 (nnheader-concat gnus-article-save-directory "NoCeM/") | |
65 "*Directory where NoCeM files will be stored." | |
66 :group 'gnus-nocem | |
67 :type 'directory) | |
68 | |
69 (defcustom gnus-nocem-expiry-wait 15 | |
70 "*Number of days to keep NoCeM headers in the cache." | |
71 :group 'gnus-nocem | |
72 :type 'integer) | |
73 | |
63868
e903f947651d
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-458
Miles Bader <miles@gnu.org>
parents:
56927
diff
changeset
|
74 (defcustom gnus-nocem-verifyer 'pgg-verify |
17493 | 75 "*Function called to verify that the NoCeM message is valid. |
63868
e903f947651d
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-458
Miles Bader <miles@gnu.org>
parents:
56927
diff
changeset
|
76 One likely value is `pgg-verify'. If the function in this variable |
17493 | 77 isn't bound, the message will be used unconditionally." |
78 :group 'gnus-nocem | |
63868
e903f947651d
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-458
Miles Bader <miles@gnu.org>
parents:
56927
diff
changeset
|
79 :type '(radio (function-item pgg-verify) |
e903f947651d
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-458
Miles Bader <miles@gnu.org>
parents:
56927
diff
changeset
|
80 (function-item mc-verify) |
17493 | 81 (function :tag "other"))) |
82 | |
83 (defcustom gnus-nocem-liberal-fetch nil | |
84 "*If t try to fetch all messages which have @@NCM in the subject. | |
85 Otherwise don't fetch messages which have references or whose message-id | |
47936
54348dbd8b9c
(gnus-nocem-liberal-fetch): Fix typo.
Juanma Barranquero <lekktu@gmail.com>
parents:
33178
diff
changeset
|
86 matches a previously scanned and verified nocem message." |
17493 | 87 :group 'gnus-nocem |
88 :type 'boolean) | |
89 | |
33178
23d4e36c09fc
(gnus-nocem-check-article-limit): Default to 500.
Dave Love <fx@gnu.org>
parents:
32626
diff
changeset
|
90 (defcustom gnus-nocem-check-article-limit 500 |
32599
0db9e380f3ec
(gnus-nocem-check-article-limit): New variable.
Miles Bader <miles@gnu.org>
parents:
31716
diff
changeset
|
91 "*If non-nil, the maximum number of articles to check in any NoCeM group." |
0db9e380f3ec
(gnus-nocem-check-article-limit): New variable.
Miles Bader <miles@gnu.org>
parents:
31716
diff
changeset
|
92 :group 'gnus-nocem |
32626 | 93 :version "21.1" |
32599
0db9e380f3ec
(gnus-nocem-check-article-limit): New variable.
Miles Bader <miles@gnu.org>
parents:
31716
diff
changeset
|
94 :type '(choice (const :tag "unlimited" nil) |
0db9e380f3ec
(gnus-nocem-check-article-limit): New variable.
Miles Bader <miles@gnu.org>
parents:
31716
diff
changeset
|
95 (integer 1000))) |
0db9e380f3ec
(gnus-nocem-check-article-limit): New variable.
Miles Bader <miles@gnu.org>
parents:
31716
diff
changeset
|
96 |
32626 | 97 (defcustom gnus-nocem-check-from t |
98 "Non-nil means check for valid issuers in message bodies. | |
99 Otherwise don't bother fetching articles unless their author matches a | |
100 valid issuer, which is much faster if you are selective about the issuers." | |
101 :group 'gnus-nocem | |
102 :version "21.1" | |
103 :type 'boolean) | |
104 | |
17493 | 105 ;;; Internal variables |
106 | |
107 (defvar gnus-nocem-active nil) | |
108 (defvar gnus-nocem-alist nil) | |
109 (defvar gnus-nocem-touched-alist nil) | |
110 (defvar gnus-nocem-hashtb nil) | |
111 (defvar gnus-nocem-seen-message-ids nil) | |
112 | |
113 ;;; Functions | |
114 | |
115 (defun gnus-nocem-active-file () | |
116 (concat (file-name-as-directory gnus-nocem-directory) "active")) | |
117 | |
118 (defun gnus-nocem-cache-file () | |
119 (concat (file-name-as-directory gnus-nocem-directory) "cache")) | |
120 | |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19539
diff
changeset
|
121 ;; |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19539
diff
changeset
|
122 ;; faster lookups for group names: |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19539
diff
changeset
|
123 ;; |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19539
diff
changeset
|
124 |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19539
diff
changeset
|
125 (defvar gnus-nocem-real-group-hashtb nil |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19539
diff
changeset
|
126 "Real-name mappings of subscribed groups.") |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19539
diff
changeset
|
127 |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19539
diff
changeset
|
128 (defun gnus-fill-real-hashtb () |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
129 "Fill up a hash table with the real-name mappings from the user's active file." |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
130 (if (hash-table-p gnus-nocem-real-group-hashtb) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
131 (clrhash gnus-nocem-real-group-hashtb) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
132 (setq gnus-nocem-real-group-hashtb (make-hash-table :test 'equal))) |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19539
diff
changeset
|
133 (mapcar (lambda (group) |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19539
diff
changeset
|
134 (setq group (gnus-group-real-name (car group))) |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
135 (puthash group t gnus-nocem-real-group-hashtb)) |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19539
diff
changeset
|
136 gnus-newsrc-alist)) |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19539
diff
changeset
|
137 |
69362
29fe34ec2296
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-147
Miles Bader <miles@gnu.org>
parents:
68633
diff
changeset
|
138 ;;;###autoload |
17493 | 139 (defun gnus-nocem-scan-groups () |
140 "Scan all NoCeM groups for new NoCeM messages." | |
141 (interactive) | |
142 (let ((groups gnus-nocem-groups) | |
143 (gnus-inhibit-demon t) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
144 group active gactive articles check-headers) |
17493 | 145 (gnus-make-directory gnus-nocem-directory) |
146 ;; Load any previous NoCeM headers. | |
147 (gnus-nocem-load-cache) | |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19539
diff
changeset
|
148 ;; Get the group name mappings: |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19539
diff
changeset
|
149 (gnus-fill-real-hashtb) |
17493 | 150 ;; Read the active file if it hasn't been read yet. |
151 (and (file-exists-p (gnus-nocem-active-file)) | |
152 (not gnus-nocem-active) | |
153 (ignore-errors | |
154 (load (gnus-nocem-active-file) t t t))) | |
155 ;; Go through all groups and see whether new articles have | |
156 ;; arrived. | |
157 (while (setq group (pop groups)) | |
158 (if (not (setq gactive (gnus-activate-group group))) | |
159 () ; This group doesn't exist. | |
160 (setq active (nth 1 (assoc group gnus-nocem-active))) | |
161 (when (and (not (< (cdr gactive) (car gactive))) ; Empty group. | |
162 (or (not active) | |
163 (< (cdr active) (cdr gactive)))) | |
164 ;; Ok, there are new articles in this group, se we fetch the | |
165 ;; headers. | |
166 (save-excursion | |
167 (let ((dependencies (make-vector 10 nil)) | |
168 headers header) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
169 (with-temp-buffer |
17493 | 170 (setq headers |
171 (if (eq 'nov | |
172 (gnus-retrieve-headers | |
173 (setq articles | |
174 (gnus-uncompress-range | |
175 (cons | |
176 (if active (1+ (cdr active)) | |
177 (car gactive)) | |
178 (cdr gactive)))) | |
179 group)) | |
180 (gnus-get-newsgroup-headers-xover | |
181 articles nil dependencies) | |
182 (gnus-get-newsgroup-headers dependencies))) | |
183 (while (setq header (pop headers)) | |
184 ;; We take a closer look on all articles that have | |
185 ;; "@@NCM" in the subject. Unless we already read | |
186 ;; this cross posted message. Nocem messages | |
187 ;; are not allowed to have references, so we can | |
188 ;; ignore scanning followups. | |
189 (and (string-match "@@NCM" (mail-header-subject header)) | |
32626 | 190 (and gnus-nocem-check-from |
191 (let ((case-fold-search t)) | |
192 (catch 'ok | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
193 (mapc |
32626 | 194 (lambda (author) |
195 (if (consp author) | |
196 (setq author (car author))) | |
197 (if (string-match | |
198 author (mail-header-from header)) | |
199 (throw 'ok t))) | |
200 gnus-nocem-issuers) | |
201 nil))) | |
17493 | 202 (or gnus-nocem-liberal-fetch |
203 (and (or (string= "" (mail-header-references | |
204 header)) | |
205 (null (mail-header-references header))) | |
206 (not (member (mail-header-message-id header) | |
207 gnus-nocem-seen-message-ids)))) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
208 (push header check-headers))) |
69362
29fe34ec2296
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-147
Miles Bader <miles@gnu.org>
parents:
68633
diff
changeset
|
209 (setq check-headers (last (nreverse check-headers) |
29fe34ec2296
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-147
Miles Bader <miles@gnu.org>
parents:
68633
diff
changeset
|
210 gnus-nocem-check-article-limit)) |
29fe34ec2296
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-147
Miles Bader <miles@gnu.org>
parents:
68633
diff
changeset
|
211 (let ((i 0) |
29fe34ec2296
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-147
Miles Bader <miles@gnu.org>
parents:
68633
diff
changeset
|
212 (len (length check-headers))) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
213 (dolist (h check-headers) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
214 (gnus-message |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
215 7 "Checking article %d in %s for NoCeM (%d of %d)..." |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
216 (mail-header-number h) group (incf i) len) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
217 (gnus-nocem-check-article group h))))))) |
17493 | 218 (setq gnus-nocem-active |
219 (cons (list group gactive) | |
220 (delq (assoc group gnus-nocem-active) | |
221 gnus-nocem-active))))) | |
222 ;; Save the results, if any. | |
223 (gnus-nocem-save-cache) | |
224 (gnus-nocem-save-active))) | |
225 | |
226 (defun gnus-nocem-check-article (group header) | |
227 "Check whether the current article is an NCM article and that we want it." | |
228 ;; Get the article. | |
229 (let ((date (mail-header-date header)) | |
32626 | 230 (gnus-newsgroup-name group) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
231 issuer b e type) |
17493 | 232 (when (or (not date) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
233 (time-less-p |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
234 (time-since (date-to-time date)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
235 (days-to-time gnus-nocem-expiry-wait))) |
17493 | 236 (gnus-request-article-this-buffer (mail-header-number header) group) |
237 (goto-char (point-min)) | |
69362
29fe34ec2296
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-147
Miles Bader <miles@gnu.org>
parents:
68633
diff
changeset
|
238 (when (re-search-forward |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
239 "-----BEGIN PGP\\(?: SIGNED\\)? MESSAGE-----" |
69362
29fe34ec2296
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-147
Miles Bader <miles@gnu.org>
parents:
68633
diff
changeset
|
240 nil t) |
17493 | 241 (delete-region (point-min) (match-beginning 0))) |
69362
29fe34ec2296
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-147
Miles Bader <miles@gnu.org>
parents:
68633
diff
changeset
|
242 (when (re-search-forward |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
243 "-----END PGP \\(?:MESSAGE\\|SIGNATURE\\)-----\n?" |
69362
29fe34ec2296
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-147
Miles Bader <miles@gnu.org>
parents:
68633
diff
changeset
|
244 nil t) |
17493 | 245 (delete-region (match-end 0) (point-max))) |
246 (goto-char (point-min)) | |
247 ;; The article has to have proper NoCeM headers. | |
248 (when (and (setq b (search-forward "\n@@BEGIN NCM HEADERS\n" nil t)) | |
249 (setq e (search-forward "\n@@BEGIN NCM BODY\n" nil t))) | |
250 ;; We get the name of the issuer. | |
251 (narrow-to-region b e) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
252 (setq issuer (mail-fetch-field "issuer") |
63868
e903f947651d
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-458
Miles Bader <miles@gnu.org>
parents:
56927
diff
changeset
|
253 type (mail-fetch-field "type")) |
17493 | 254 (widen) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
255 (if (not (gnus-nocem-message-wanted-p issuer type)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
256 (message "invalid NoCeM issuer: %s" issuer) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
257 (and (gnus-nocem-verify-issuer issuer) ; She is who she says she is. |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
258 (gnus-nocem-enter-article) ; We gobble the message. |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
259 (push (mail-header-message-id header) ; But don't come back for |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
260 gnus-nocem-seen-message-ids))))))) ; second helpings. |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
261 |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
262 (defun gnus-nocem-message-wanted-p (issuer type) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
263 (let ((issuers gnus-nocem-issuers) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
264 wanted conditions condition) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
265 (cond |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
266 ;; Do the quick check first. |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
267 ((member issuer issuers) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
268 t) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
269 ((setq conditions (cdr (assoc issuer issuers))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
270 ;; Check whether we want this type. |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
271 (while (setq condition (pop conditions)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
272 (cond |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
273 ((stringp condition) |
63868
e903f947651d
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-458
Miles Bader <miles@gnu.org>
parents:
56927
diff
changeset
|
274 (when (string-match condition type) |
e903f947651d
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-458
Miles Bader <miles@gnu.org>
parents:
56927
diff
changeset
|
275 (setq wanted t))) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
276 ((and (consp condition) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
277 (eq (car condition) 'not) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
278 (stringp (cadr condition))) |
63868
e903f947651d
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-458
Miles Bader <miles@gnu.org>
parents:
56927
diff
changeset
|
279 (when (string-match (cadr condition) type) |
e903f947651d
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-458
Miles Bader <miles@gnu.org>
parents:
56927
diff
changeset
|
280 (setq wanted nil))) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
281 (t |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
282 (error "Invalid NoCeM condition: %S" condition)))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
283 wanted)))) |
17493 | 284 |
285 (defun gnus-nocem-verify-issuer (person) | |
286 "Verify using PGP that the canceler is who she says she is." | |
63868
e903f947651d
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-458
Miles Bader <miles@gnu.org>
parents:
56927
diff
changeset
|
287 (if (functionp gnus-nocem-verifyer) |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19539
diff
changeset
|
288 (ignore-errors |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19539
diff
changeset
|
289 (funcall gnus-nocem-verifyer)) |
17493 | 290 ;; If we don't have Mailcrypt, then we use the message anyway. |
291 t)) | |
292 | |
293 (defun gnus-nocem-enter-article () | |
294 "Enter the current article into the NoCeM cache." | |
295 (goto-char (point-min)) | |
296 (let ((b (search-forward "\n@@BEGIN NCM BODY\n" nil t)) | |
297 (e (search-forward "\n@@END NCM BODY\n" nil t)) | |
298 (buf (current-buffer)) | |
299 ncm id group) | |
300 (when (and b e) | |
301 (narrow-to-region b (1+ (match-beginning 0))) | |
302 (goto-char (point-min)) | |
303 (while (search-forward "\t" nil t) | |
304 (cond | |
305 ((not (ignore-errors | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
306 (setq group (gnus-group-real-name (symbol-name (read buf)))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
307 (gethash group gnus-nocem-real-group-hashtb))) |
17493 | 308 ;; An error. |
309 ) | |
310 (t | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
311 ;; Valid group. |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
312 (beginning-of-line) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
313 (while (eq (char-after) ?\t) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
314 (forward-line -1)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
315 (setq id (buffer-substring (point) (1- (search-forward "\t")))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
316 (unless (if (hash-table-p gnus-nocem-hashtb) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
317 (gethash id gnus-nocem-hashtb) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
318 (setq gnus-nocem-hashtb (make-hash-table :test 'equal)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
319 nil) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
320 ;; only store if not already present |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
321 (puthash id t gnus-nocem-hashtb) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
322 (push id ncm)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
323 (forward-line 1) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
324 (while (eq (char-after) ?\t) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
325 (forward-line 1))))) |
17493 | 326 (when ncm |
327 (setq gnus-nocem-touched-alist t) | |
328 (push (cons (let ((time (current-time))) (setcdr (cdr time) nil) time) | |
329 ncm) | |
330 gnus-nocem-alist)) | |
331 t))) | |
332 | |
69362
29fe34ec2296
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-147
Miles Bader <miles@gnu.org>
parents:
68633
diff
changeset
|
333 ;;;###autoload |
17493 | 334 (defun gnus-nocem-load-cache () |
335 "Load the NoCeM cache." | |
336 (interactive) | |
337 (unless gnus-nocem-alist | |
338 ;; The buffer doesn't exist, so we create it and load the NoCeM | |
339 ;; cache. | |
340 (when (file-exists-p (gnus-nocem-cache-file)) | |
341 (load (gnus-nocem-cache-file) t t t) | |
342 (gnus-nocem-alist-to-hashtb)))) | |
343 | |
344 (defun gnus-nocem-save-cache () | |
345 "Save the NoCeM cache." | |
346 (when (and gnus-nocem-alist | |
347 gnus-nocem-touched-alist) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
348 (with-temp-file (gnus-nocem-cache-file) |
17493 | 349 (gnus-prin1 `(setq gnus-nocem-alist ',gnus-nocem-alist))) |
350 (setq gnus-nocem-touched-alist nil))) | |
351 | |
352 (defun gnus-nocem-save-active () | |
353 "Save the NoCeM active file." | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
354 (with-temp-file (gnus-nocem-active-file) |
17493 | 355 (gnus-prin1 `(setq gnus-nocem-active ',gnus-nocem-active)))) |
356 | |
357 (defun gnus-nocem-alist-to-hashtb () | |
358 "Create a hashtable from the Message-IDs we have." | |
359 (let* ((alist gnus-nocem-alist) | |
360 (pprev (cons nil alist)) | |
361 (prev pprev) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
362 (expiry (days-to-time gnus-nocem-expiry-wait)) |
17493 | 363 entry) |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
364 (if (hash-table-p gnus-nocem-hashtb) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
365 (clrhash gnus-nocem-hashtb) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
366 (setq gnus-nocem-hashtb (make-hash-table :test 'equal))) |
17493 | 367 (while (setq entry (car alist)) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
368 (if (not (time-less-p (time-since (car entry)) expiry)) |
17493 | 369 ;; This entry has expired, so we remove it. |
370 (setcdr prev (cdr alist)) | |
371 (setq prev alist) | |
372 ;; This is ok, so we enter it into the hashtable. | |
373 (setq entry (cdr entry)) | |
374 (while entry | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
375 (puthash (car entry) t gnus-nocem-hashtb) |
17493 | 376 (setq entry (cdr entry)))) |
377 (setq alist (cdr alist))))) | |
378 | |
379 (gnus-add-shutdown 'gnus-nocem-close 'gnus) | |
380 | |
381 (defun gnus-nocem-close () | |
382 "Clear internal NoCeM variables." | |
383 (setq gnus-nocem-alist nil | |
384 gnus-nocem-hashtb nil | |
385 gnus-nocem-active nil | |
386 gnus-nocem-touched-alist nil | |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19539
diff
changeset
|
387 gnus-nocem-seen-message-ids nil |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19539
diff
changeset
|
388 gnus-nocem-real-group-hashtb nil)) |
17493 | 389 |
390 (defun gnus-nocem-unwanted-article-p (id) | |
391 "Say whether article ID in the current group is wanted." | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
392 (and gnus-nocem-hashtb |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
393 (gethash id gnus-nocem-hashtb))) |
17493 | 394 |
395 (provide 'gnus-nocem) | |
396 | |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87649
diff
changeset
|
397 ;; arch-tag: 0e0c74ea-2f8e-4f3e-8fff-09f767c1adef |
17493 | 398 ;;; gnus-nocem.el ends here |