From 211c17973daf86e39701acb07a770606265835ce Mon Sep 17 00:00:00 2001 From: yamaoka Date: Wed, 8 Jan 2003 23:07:05 +0000 Subject: [PATCH] Synch with Oort Gnus. --- lisp/ChangeLog | 50 +++++++++++--------- lisp/gnus-spec.el | 4 +- lisp/gnus.el | 43 ++++++++++++++--- lisp/lpath.el | 3 +- lisp/message.el | 2 +- lisp/nnmaildir.el | 2 +- lisp/spam.el | 136 +++++++++++++++++++++++++++++++++++++---------------- 7 files changed, 165 insertions(+), 75 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c1b9c6c..6218e07 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2003-01-08 Paul Jarc + + * nnmaildir.el (nnmaildir--grp-add-art): Fix wrong-type-argument + bug when the (n+1)th article to be added to a group has a smaller + number than the n articles already added. + 2003-01-08 Jesper Harder * message.el (message-mode-field-menu): Use backquote. @@ -30,7 +36,7 @@ * gnus-spec.el (gnus-parse-complex-format): %~ => ~*. * gnus-agent.el (gnus-agent-fetch-selected-article): Use - gnus-summary-update-article-line. + gnus-summary-update-article-line. 2003-01-08 Simon Josefsson @@ -95,11 +101,11 @@ * gnus-msg.el (gnus-debug): Use ignore-errors. * gnus-agent.el (gnus-agent-fetch-selected-article): Use - `gnus-summary-update-line'. + `gnus-summary-update-line'. 2003-01-08 Simon Josefsson - * gnus-art.el (gnus-unbuttonized-mime-types) + * gnus-art.el (gnus-unbuttonized-mime-types) (gnus-buttonized-mime-types): Doc fix. 2003-01-08 Jesper Harder @@ -137,16 +143,16 @@ * nntp.el (nntp-with-open-group): The quit signal handler must propagate the quit signal to the next outer handler so that the caller knows that the request aborted abnormally. - + 2003-01-07 Teodor Zlatanov - * spam.el (spam-check-ifile, spam-ifile-register-with-ifile) - (spam-ifile-register-spam-routine) + * spam.el (spam-check-ifile, spam-ifile-register-with-ifile) + (spam-ifile-register-spam-routine) (spam-ifile-register-ham-routine): added ifile functionality that does not use ifile-gnus.el to classify and register articles (spam-get-article-as-string): convenience function (spam-summary-prepare-exit): added ifile spam and ham registration - (spam-ifile-all-categories, spam-ifile-spam-category) + (spam-ifile-all-categories, spam-ifile-spam-category) (spam-ifile-path, spam-ifile): added customization options * gnus.el (gnus-group-ham-exit-processor-ifile): added ifile ham @@ -157,7 +163,7 @@ 2003-01-07 Lars Magne Ingebrigtsen * gnus-score.el (gnus-score-followup): Also score immediate - followups. + followups. 2003-01-06 Lars Magne Ingebrigtsen @@ -190,7 +196,7 @@ 2002-01-06 Kevin Greiner * gnus-agent.el (gnus-agent-fetch-group): Modified to permit execution - in either the group or summary buffer. + in either the group or summary buffer. New command "JS", in summary buffer, will fetch articles per the group's category, predicate, and processable flags. (gnus-agent-summary-fetch-series): Rewritten to call @@ -242,7 +248,7 @@ nntp-with-open-group forms in all, but one, occurrance. (nntp-accept-process-output): Bug fix. Detect when called with null process. - + 2003-01-06 Jesper Harder * mm-util.el (mm-find-mime-charset-region): Don't do Latin-9 hack @@ -281,7 +287,7 @@ 2003-01-05 Lars Magne Ingebrigtsen - * gnus-msg.el (gnus-inews-make-draft): Quote article-reply. + * gnus-msg.el (gnus-inews-make-draft): Quote article-reply. * gnus-group.el (gnus-number-of-unseen-articles-in-group): Protect against unactive groups. @@ -295,7 +301,7 @@ (gnus-group-line-format-alist): ?U. (gnus-number-of-unseen-articles-in-group): New function. - * nntp.el (nntp-accept-process-output): Use a 0.1 second timeout. + * nntp.el (nntp-accept-process-output): Use a 0.1 second timeout. * gnus.el (gnus-version-number): Bump version number. @@ -320,18 +326,18 @@ 2003-01-04 Lars Magne Ingebrigtsen - * gnus.el (gnus-variable-list): Write gnus-format-specs last. + * gnus.el (gnus-variable-list): Write gnus-format-specs last. * gnus-sum.el (gnus-summary-goto-subjects): Fix typo. 2003-01-04 Kevin Ryde * gnus-art.el (gnus-mime-jka-compr-maybe-uncompress): New - function. + function. 2003-01-04 Lars Magne Ingebrigtsen - * gnus-sum.el (gnus-summary-exit): Bind gnus-group-is-exiting-p. + * gnus-sum.el (gnus-summary-exit): Bind gnus-group-is-exiting-p. (gnus-summary-read-group-1): Update group line. (gnus-summary-exit-no-update): Update group on exit. @@ -364,12 +370,12 @@ 2003-01-02 Teodor Zlatanov * spam.el (spam-group-spam-contents-p, spam-group-ham-contents-p) - (spam-group-processor-p, spam-group-processor-bogofilter-p) - (spam-group-processor-ifile-p, spam-group-processor-blacklist-p) - (spam-group-processor-whitelist-p, spam-group-processor-BBDB-p) - (spam-mark-spam-as-expired-and-move-routine) - (spam-generic-register-routine, spam-BBDB-register-routine) - (spam-ifile-register-routine, spam-blacklist-register-routine) + (spam-group-processor-p, spam-group-processor-bogofilter-p) + (spam-group-processor-ifile-p, spam-group-processor-blacklist-p) + (spam-group-processor-whitelist-p, spam-group-processor-BBDB-p) + (spam-mark-spam-as-expired-and-move-routine) + (spam-generic-register-routine, spam-BBDB-register-routine) + (spam-ifile-register-routine, spam-blacklist-register-routine) (spam-whitelist-register-routine): new functions (spam-summary-prepare-exit): added summary exit processing (expire or move) of spam-marked articles for spam groups; added slots for @@ -381,7 +387,7 @@ (pop3-read-response): Ditto. * gnus-msg.el (gnus-setup-message): Get the evaliation order - right. + right. (gnus-inews-make-draft): New function. (gnus-setup-message): Use it. diff --git a/lisp/gnus-spec.el b/lisp/gnus-spec.el index d35fc99..e6f2c7d 100644 --- a/lisp/gnus-spec.el +++ b/lisp/gnus-spec.el @@ -440,7 +440,7 @@ characters when given a pad value." ;; them will have the balloon-help text property. (let ((case-fold-search nil)) (if (string-match - "\\`\\(.*\\)%[0-9]?[{(«]\\(.*\\)%[0-9]?[»})]\\(.*\n?\\)\\'\\|%[-0-9]*=\\|%[-0-9]*~" + "\\`\\(.*\\)%[0-9]?[{(«]\\(.*\\)%[0-9]?[»})]\\(.*\n?\\)\\'\\|%[-0-9]*=\\|%[-0-9]*\\*" format) (gnus-parse-complex-format format spec-alist) ;; This is a simple format. @@ -476,7 +476,7 @@ characters when given a pad value." ;; Convert point position commands. (goto-char (point-min)) (let ((case-fold-search nil)) - (while (re-search-forward "%\\([-0-9]+\\)?~" nil t) + (while (re-search-forward "%\\([-0-9]+\\)?\\*" nil t) (replace-match "\"(point)\"" t t) (setq cursor-spec t))) ;; Convert TAB commands. diff --git a/lisp/gnus.el b/lisp/gnus.el index ea85969..323eb2f 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -1903,15 +1903,46 @@ to do spam-processed article moving, associated with the destination group or `nil' for explicit expiration. This only makes sense for mail groups." :variable-group spam - :variable-type '(repeat :tag "Spam-processed articles destination" - (list - (regexp :tag "Group Regexp") - (choice :tag "Destination for spam-processed articles at summary exit" - (string :tag "Move to a group") - (other :tag "Expire" nil)))) + :variable-type '(repeat + :tag "Spam-processed articles destination" + (list + (regexp :tag "Group Regexp") + (choice + :tag "Destination for spam-processed articles at summary exit" + (string :tag "Move to a group") + (other :tag "Expire" nil)))) :parameter-document "Where spam-processed articles will go at summary exit.") +(gnus-define-group-parameter + ham-process-destination + :parameter-type '(choice + :tag "Destination for ham articles at summary exit from a spam group" + (string :tag "Move to a group") + (other :tag "Do nothing" nil)) + :function-document + "Where ham articles will go at summary exit from a spam group." + :variable gnus-ham-process-destinations + :variable-default nil + :variable-document + "*Groups in which to explicitly send ham articles to +another group, or do nothing (the default). If non-nil, this should +be a list of group name regexps that should match all groups in which +to do ham article moving, associated with the destination +group or `nil' for explicit ignoring. This only makes sense for +mail groups, and only works in spam groups." + :variable-group spam + :variable-type '(repeat + :tag "Ham articles destination" + (list + (regexp :tag "Group Regexp") + (choice + :tag "Destination for ham articles at summary exit from spam group" + (string :tag "Move to a group") + (other :tag "Expire" nil)))) + :parameter-document + "Where ham articles will go at summary exit from a spam group.") + (defcustom gnus-group-uncollapsed-levels 1 "Number of group name elements to leave alone when making a short group name." :group 'gnus-group-visual diff --git a/lisp/lpath.el b/lisp/lpath.el index df816d5..2e1e2e7 100644 --- a/lisp/lpath.el +++ b/lisp/lpath.el @@ -9,8 +9,7 @@ (defun maybe-bind (args) (mapcar (lambda (var) (unless (boundp var) (set var nil))) args)) -(maybe-fbind '(bbdb-records - bbdb-search bbdb-create-internal +(maybe-fbind '(bbdb-create-internal bbdb-records create-image display-graphic-p display-time-event-handler find-image image-size image-type-available-p insert-image diff --git a/lisp/message.el b/lisp/message.el index a7433e0..bac36fc 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -2326,7 +2326,7 @@ Point is left at the beginning of the narrowed-to region." (easy-menu-define message-mode-field-menu message-mode-map "" - '("Field" + `("Field" ["Fetch To" message-insert-to t] ["Fetch Newsgroups" message-insert-newsgroups t] "----" diff --git a/lisp/nnmaildir.el b/lisp/nnmaildir.el index 641ebcb..66e82ec 100644 --- a/lisp/nnmaildir.el +++ b/lisp/nnmaildir.el @@ -462,7 +462,7 @@ by nnmaildir-request-article.") (setq nlist (cons (cons num article) nlist)) (setq insert-nlist t nlist-cdr (cdr nlist)) - (while (< num (caar nlist-cdr)) + (while (and nlist-cdr (< num (caar nlist-cdr))) (setq nlist nlist-cdr nlist-cdr (cdr nlist)))) (let ((inhibit-quit t)) diff --git a/lisp/spam.el b/lisp/spam.el index e0a463b..6e4c3de 100644 --- a/lisp/spam.el +++ b/lisp/spam.el @@ -63,6 +63,14 @@ :type 'directory :group 'spam) +(defcustom spam-move-spam-nonspam-groups-only t + "Whether spam should be moved in non-spam groups only. +When nil, only ham and unclassified groups will have their spam moved +to the spam-process-destination. When t, spam will also be moved from +spam groups." + :type 'boolean + :group 'spam-ifile) + (defcustom spam-whitelist (expand-file-name "whitelist" spam-directory) "The location of the whitelist. The file format is one regular expression per line. @@ -167,6 +175,12 @@ Such articles will be transmitted to `bogofilter -s' on group exit." (const :tag "ifile is not installed")) :group 'spam-ifile) +(defcustom spam-ifile-database-path nil + "File path of the ifile database." + :type '(choice (file :tag "Location of the ifile database") + (const :tag "Use the default")) + :group 'spam-ifile) + (defcustom spam-ifile-spam-category "spam" "Name of the spam ifile category." :type 'string @@ -291,18 +305,29 @@ articles before they get registered by Bogofilter." (when (spam-group-spam-processor-bogofilter-p gnus-newsgroup-name) (spam-blacklist-register-routine)) - ;; Only for spam groups, we expire and maybe move articles - (when (spam-group-spam-contents-p gnus-newsgroup-name) + (if spam-move-spam-nonspam-groups-only + (when (not (spam-group-spam-contents-p gnus-newsgroup-name)) + (spam-mark-spam-as-expired-and-move-routine + (gnus-parameter-spam-process-destination gnus-newsgroup-name))) (spam-mark-spam-as-expired-and-move-routine (gnus-parameter-spam-process-destination gnus-newsgroup-name))) + ;; now we redo spam-mark-spam-as-expired-and-move-routine to only + ;; expire spam, in case the above did not expire them + (spam-mark-spam-as-expired-and-move-routine nil) + (when (spam-group-ham-contents-p gnus-newsgroup-name) (when (spam-group-ham-processor-whitelist-p gnus-newsgroup-name) (spam-whitelist-register-routine)) (when (spam-group-ham-processor-ifile-p gnus-newsgroup-name) (spam-ifile-register-ham-routine)) (when (spam-group-ham-processor-BBDB-p gnus-newsgroup-name) - (spam-BBDB-register-routine)))) + (spam-BBDB-register-routine))) + + ;; now move all ham articles out of spam groups + (when (spam-group-spam-contents-p gnus-newsgroup-name) + (spam-ham-move-routine + (gnus-parameter-ham-process-destination gnus-newsgroup-name)))) (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit) @@ -328,13 +353,26 @@ articles before they get registered by Bogofilter." (let ((gnus-current-article article)) (gnus-summary-move-article nil group))))))) +(defun spam-ham-move-routine (&optional group) + (let ((articles gnus-newsgroup-articles) + article ham-mark-values mark) + (dolist (mark spam-ham-marks) + (push (symbol-value mark) ham-mark-values)) + + (while articles + (setq article (pop articles)) + (when (and (memq mark ham-mark-values) + (stringp group)) + (let ((gnus-current-article article)) + (gnus-summary-move-article nil group)))))) + (defun spam-generic-register-routine (spam-func ham-func) (let ((articles gnus-newsgroup-articles) article mark ham-articles spam-articles spam-mark-values ham-mark-values) ;; marks are stored as symbolic values, so we have to dereference - ;; them for memq to work we wouldn't have to do this if + ;; them for memq to work. we wouldn't have to do this if ;; gnus-summary-article-mark returned a symbol. (dolist (mark spam-ham-marks) (push (symbol-value mark) ham-mark-values)) @@ -459,48 +497,54 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (when matches spam-split-group))) -;;;; BBDB original idea for spam-check-BBDB from Alexander Kotelnikov +;;;; BBDB + +;;; original idea for spam-check-BBDB from Alexander Kotelnikov ;;; ;; all this is done inside a condition-case to trap errors + (condition-case nil (progn - + (require 'bbdb) (require 'bbdb-com) - - (defun spam-enter-ham-BBDB (from) - "Enter an address into the BBDB; implies ham (non-spam) sender" - (when (stringp from) - (let* ((parsed-address (gnus-extract-address-components from)) - (name (or (car parsed-address) "Ham Sender")) - (net-address (car (cdr parsed-address)))) - (message "Adding address %s to BBDB" from) - (when (and net-address - (not (bbdb-search (bbdb-records) nil nil net-address))) - (bbdb-create-internal name nil net-address nil nil - "ham sender added by spam.el"))))) - - (defun spam-BBDB-register-routine () - (spam-generic-register-routine - ;; spam function - nil - ;; ham function - (lambda (article) - (spam-enter-ham-BBDB (spam-fetch-field-from-fast article))))) - - (defun spam-check-BBDB () - "Mail from people in the BBDB is never considered spam" - (let ((who (message-fetch-field "from"))) - (when who - (setq who (regexp-quote (cadr - (gnus-extract-address-components who)))) - (if (bbdb-search (bbdb-records) nil nil who) - nil spam-split-group))))) + + (defun spam-enter-ham-BBDB (from) + "Enter an address into the BBDB; implies ham (non-spam) sender" + (when (stringp from) + (let* ((parsed-address (gnus-extract-address-components from)) + (name (or (car parsed-address) "Ham Sender")) + (net-address (car (cdr parsed-address)))) + (message "Adding address %s to BBDB" from) + (when (and net-address + (not (bbdb-search-simple nil net-address))) + (bbdb-create-internal name nil net-address nil nil + "ham sender added by spam.el"))))) + + (defun spam-BBDB-register-routine () + (spam-generic-register-routine + ;; spam function + nil + ;; ham function + (lambda (article) + (spam-enter-ham-BBDB (spam-fetch-field-from-fast article))))) + + (defun spam-check-BBDB () + "Mail from people in the BBDB is never considered spam" + (let ((who (message-fetch-field "from"))) + (when who + (setq who (regexp-quote (cadr + (gnus-extract-address-components who)))) + (if (bbdb-search-simple nil who) + nil spam-split-group))))) (file-error (progn - (setq spam-list-of-checks - (delete (assoc 'spam-use-BBDB spam-list-of-checks) - spam-list-of-checks))))) + (defalias 'bbdb-search-simple 'ignore) + (defalias 'spam-check-BBDB 'ignore) + (defalias 'spam-BBDB-register-routine 'ignore) + (defalias 'spam-enter-ham-BBDB 'ignore) + (defalias 'bbdb-create-internal 'ignore) + (defalias 'bbdb-records 'ignore)))) ;;;; ifile @@ -508,6 +552,12 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." ;;; check the ifile backend; return nil if the mail was NOT classified ;;; as spam +(defun spam-get-ifile-database-parameter () + "Get the command-line parameter for ifile's database from spam-ifile-database-path." + (if spam-ifile-database-path + (format "--db-file=%s" spam-ifile-database-path) + "")) + (defun spam-check-ifile () "Check the ifile backend for the classification of this message" (let ((article-buffer-name (buffer-name)) @@ -517,7 +567,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (save-excursion (set-buffer article-buffer-name) (call-process-region (point-min) (point-max) spam-ifile-path - nil temp-buffer-name nil "-q" "-c")) + nil temp-buffer-name nil + "-q" "-c" (spam-get-ifile-database-parameter))) (goto-char (point-min)) (if (not (eobp)) (setq category (buffer-substring (point) (spam-point-at-eol)))) @@ -526,7 +577,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (setq return category) ;; else, if spam-ifile-all-categories is not set... (when (string-equal spam-ifile-spam-category category) - (setq return spam-split-group)))))) ; always accept the ifile category + ;; always accept the ifile category + (setq return spam-split-group)))))) return)) (defun spam-ifile-register-with-ifile (article-string category) @@ -537,7 +589,9 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)." (with-temp-buffer (insert-string article-string) (call-process-region (point-min) (point-max) spam-ifile-path - nil nil nil "-h" "-i" category))))) + nil nil nil + "-h" "-i" category + (spam-get-ifile-database-parameter)))))) (defun spam-ifile-register-spam-routine () (spam-generic-register-routine -- 1.7.10.4