X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-nocem.el;h=3210170e9d9d1ebf419c83d73dd168087739f44b;hb=85be3726901ca453647897e26330fee8aa25d8c0;hp=1e6207d02a29a8df86ff9cc3ad05499f8cb64e84;hpb=a707b63af25b91cb730c12e65156ca364bf49a44;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-nocem.el b/lisp/gnus-nocem.el index 1e6207d..3210170 100644 --- a/lisp/gnus-nocem.el +++ b/lisp/gnus-nocem.el @@ -1,6 +1,7 @@ ;;; gnus-nocem.el --- NoCeM pseudo-cancellation treatment -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2002, 2003, 2004, +;; 2005 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -19,8 +20,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -35,7 +36,7 @@ (require 'gnus-range) (defgroup gnus-nocem nil - "NoCeM pseudo-cancellation treatment" + "NoCeM pseudo-cancellation treatment." :group 'gnus-score) (defcustom gnus-nocem-groups @@ -58,6 +59,7 @@ This can also be a list of `(ISSUER CONDITION ...)' elements. See for an issuer registry." :group 'gnus-nocem + :link '(url-link "http://www.xs4all.nl/~rosalind/nocemreg/nocemreg.html") :type '(repeat (choice string sexp))) (defcustom gnus-nocem-directory @@ -71,24 +73,29 @@ issuer registry." :group 'gnus-nocem :type 'integer) -(defcustom gnus-nocem-verifyer 'mc-verify +(defcustom gnus-nocem-verifyer (lambda () + (pgg-verify-region (point-min) (point-max))) "*Function called to verify that the NoCeM message is valid. -One likely value is `mc-verify'. If the function in this variable -isn't bound, the message will be used unconditionally." +One likely value is the function using `pgg-verify-region'. +If the function in this variable isn't bound, the message will be used +unconditionally." :group 'gnus-nocem - :type '(radio (function-item mc-verify) + :type '(radio (function (lambda () + (pgg-verify-region (point-min) (point-max)))) + (function-item mc-verify) (function :tag "other"))) (defcustom gnus-nocem-liberal-fetch nil "*If t try to fetch all messages which have @@NCM in the subject. Otherwise don't fetch messages which have references or whose message-id -matches an previously scanned and verified nocem message." +matches a previously scanned and verified nocem message." :group 'gnus-nocem :type 'boolean) (defcustom gnus-nocem-check-article-limit 500 "*If non-nil, the maximum number of articles to check in any NoCeM group." :group 'gnus-nocem + :version "21.1" :type '(choice (const :tag "unlimited" nil) (integer 1000))) @@ -97,6 +104,7 @@ matches an previously scanned and verified nocem message." Otherwise don't bother fetching articles unless their author matches a valid issuer, which is much faster if you are selective about the issuers." :group 'gnus-nocem + :version "21.1" :type 'boolean) ;;; Internal variables @@ -124,11 +132,12 @@ valid issuer, which is much faster if you are selective about the issuers." (defun gnus-fill-real-hashtb () "Fill up a hash table with the real-name mappings from the user's active file." - (setq gnus-nocem-real-group-hashtb (gnus-make-hashtable - (length gnus-newsrc-alist))) + (if (hash-table-p gnus-nocem-real-group-hashtb) + (clrhash gnus-nocem-real-group-hashtb) + (setq gnus-nocem-real-group-hashtb (make-hash-table :test 'equal))) (mapcar (lambda (group) (setq group (gnus-group-real-name (car group))) - (gnus-sethash group t gnus-nocem-real-group-hashtb)) + (puthash group t gnus-nocem-real-group-hashtb)) gnus-newsrc-alist)) (defun gnus-nocem-scan-groups () @@ -185,7 +194,7 @@ valid issuer, which is much faster if you are selective about the issuers." (and gnus-nocem-check-from (let ((case-fold-search t)) (catch 'ok - (mapcar + (mapc (lambda (author) (if (consp author) (setq author (car author))) @@ -241,7 +250,7 @@ valid issuer, which is much faster if you are selective about the issuers." ;; We get the name of the issuer. (narrow-to-region b e) (setq issuer (mail-fetch-field "issuer") - type (mail-fetch-field "issuer")) + type (mail-fetch-field "type")) (widen) (if (not (gnus-nocem-message-wanted-p issuer type)) (message "invalid NoCeM issuer: %s" issuer) @@ -262,18 +271,20 @@ valid issuer, which is much faster if you are selective about the issuers." (while (setq condition (pop conditions)) (cond ((stringp condition) - (setq wanted (string-match condition type))) + (when (string-match condition type) + (setq wanted t))) ((and (consp condition) (eq (car condition) 'not) (stringp (cadr condition))) - (setq wanted (not (string-match (cadr condition) type)))) + (when (string-match (cadr condition) type) + (setq wanted nil))) (t (error "Invalid NoCeM condition: %S" condition)))) wanted)))) (defun gnus-nocem-verify-issuer (person) "Verify using PGP that the canceler is who she says she is." - (if (fboundp gnus-nocem-verifyer) + (if (functionp gnus-nocem-verifyer) (ignore-errors (funcall gnus-nocem-verifyer)) ;; If we don't have Mailcrypt, then we use the message anyway. @@ -292,30 +303,26 @@ valid issuer, which is much faster if you are selective about the issuers." (while (search-forward "\t" nil t) (cond ((not (ignore-errors - (setq group (let ((obarray gnus-active-hashtb)) (read buf))))) + (setq group (gnus-group-real-name (symbol-name (read buf)))) + (gethash group gnus-nocem-real-group-hashtb))) ;; An error. ) - ((not (symbolp group)) - ;; Ignore invalid entries. - ) - ((not (boundp group)) - ;; Make sure all entries in the hashtb are bound. - (set group nil)) (t - (when (gnus-gethash (gnus-group-real-name (symbol-name group)) - gnus-nocem-real-group-hashtb) - ;; Valid group. - (beginning-of-line) - (while (eq (char-after) ?\t) - (forward-line -1)) - (setq id (buffer-substring (point) (1- (search-forward "\t")))) - (unless (gnus-gethash id gnus-nocem-hashtb) - ;; only store if not already present - (gnus-sethash id t gnus-nocem-hashtb) - (push id ncm)) - (forward-line 1) - (while (eq (char-after) ?\t) - (forward-line 1)))))) + ;; Valid group. + (beginning-of-line) + (while (eq (char-after) ?\t) + (forward-line -1)) + (setq id (buffer-substring (point) (1- (search-forward "\t")))) + (unless (if (hash-table-p gnus-nocem-hashtb) + (gethash id gnus-nocem-hashtb) + (setq gnus-nocem-hashtb (make-hash-table :test 'equal)) + nil) + ;; only store if not already present + (puthash id t gnus-nocem-hashtb) + (push id ncm)) + (forward-line 1) + (while (eq (char-after) ?\t) + (forward-line 1))))) (when ncm (setq gnus-nocem-touched-alist t) (push (cons (let ((time (current-time))) (setcdr (cdr time) nil) time) @@ -353,7 +360,9 @@ valid issuer, which is much faster if you are selective about the issuers." (prev pprev) (expiry (days-to-time gnus-nocem-expiry-wait)) entry) - (setq gnus-nocem-hashtb (gnus-make-hashtable (* (length alist) 51))) + (if (hash-table-p gnus-nocem-hashtb) + (clrhash gnus-nocem-hashtb) + (setq gnus-nocem-hashtb (make-hash-table :test 'equal))) (while (setq entry (car alist)) (if (not (time-less-p (time-since (car entry)) expiry)) ;; This entry has expired, so we remove it. @@ -362,7 +371,7 @@ valid issuer, which is much faster if you are selective about the issuers." ;; This is ok, so we enter it into the hashtable. (setq entry (cdr entry)) (while entry - (gnus-sethash (car entry) t gnus-nocem-hashtb) + (puthash (car entry) t gnus-nocem-hashtb) (setq entry (cdr entry)))) (setq alist (cdr alist))))) @@ -380,7 +389,7 @@ valid issuer, which is much faster if you are selective about the issuers." (defun gnus-nocem-unwanted-article-p (id) "Say whether article ID in the current group is wanted." (and gnus-nocem-hashtb - (gnus-gethash id gnus-nocem-hashtb))) + (gethash id gnus-nocem-hashtb))) (provide 'gnus-nocem)