From 75abc4e81d52b987818012b1a4220b5668818356 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Sat, 8 Feb 2003 06:54:25 +0000 Subject: [PATCH] Synch to Oort Gnus. --- lisp/ChangeLog | 59 ++++++++++++++++++++++++++++++++++++++++++++++ lisp/gnus-art.el | 2 +- lisp/gnus-int.el | 11 ++++++--- lisp/gnus-registry.el | 62 +++++++++++++++++++++++++++++++++++++++++++++++++ lisp/gnus-sum.el | 48 ++++++++++++++++++++++++++++++++++---- lisp/gnus-util.el | 25 +++++++++----------- lisp/gnus.el | 25 +++++++++++++++++--- lisp/mail-source.el | 2 +- lisp/mm-util.el | 8 +++---- lisp/nnmail.el | 7 ++++++ texi/ChangeLog | 11 +++++++++ texi/gnus.texi | 54 +++++++++++++++++++++++++++++++----------- 12 files changed, 271 insertions(+), 43 deletions(-) create mode 100644 lisp/gnus-registry.el diff --git a/lisp/ChangeLog b/lisp/ChangeLog index a1cf07b..8d07786 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,62 @@ +2003-02-08 Jesper Harder + + * gnus-art.el (gnus-article-refer-article): Use + gnus-replace-in-string. + + * gnus-util.el (gnus-map-function): Remove unneeded let-binding. + (gnus-remove-duplicates): do. + +2003-02-07 Teodor Zlatanov + + * gnus-int.el (gnus-internal-registry-spool-current-method): new variable + (gnus-request-scan): set + gnus-internal-registry-spool-current-method to gnus-command-method + before a request-scan operation + + * gnus-registry.el (regtest-nnmail): use + gnus-internal-registry-spool-current-method + + + +2003-02-07 Lars Magne Ingebrigtsen + + * mail-source.el (mail-source-fetch): Typo fix. + +2003-02-07 Teodor Zlatanov + + * nnmail.el (nnmail-spool-hook): new hook + (nnmail-cache-insert): call nnmail-spool-hook + + * gnus-registry.el: new file with examples of using the hooks + + * gnus.el (gnus-registry): added registry customization group + (gnus-group-prefixed-name): improve function to return full group + name optionally + (gnus-group-guess-prefixed-name): shortcut to + gnus-group-prefixed-name, using just the group name + (gnus-group-full-name): always get a group's full name + (gnus-group-guess-full-name): shortcut, using just the group name + + * gnus-sum.el (gnus-summary-article-move-hook) + (gnus-summary-article-delete-hook) + (gnus-summary-article-expire-hook): new hooks + (gnus-summary-move-article, gnus-summary-expire-articles) + (gnus-summary-delete-article): invoke the new hooks + +2003-02-07 Frank Weinberg + + * gnus-art.el (gnus-article-refer-article): Strip leading "news:" + from message-ID + +2003-02-07 Jesper Harder + + * gnus-util.el (gnus-run-hooks): Use save-current-buffer. + +2003-02-07 John Paul Wallington + + * mm-util.el (mm-delete-duplicates, mm-append-to-file) + (mm-write-region, mm-detect-coding-region): Doc fixes. + 2003-02-07 Lars Magne Ingebrigtsen * mail-source.el (mail-source-fetch): Ignore errors. diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index a3cae0a..dffdb68 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -5122,7 +5122,7 @@ Argument LINES specifies lines to be scrolled down." (let ((point (point))) (search-forward ">" nil t) ;Move point to end of "<....>". (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t) - (let ((message-id (match-string 1))) + (let ((message-id (gnus-replace-in-string (match-string 1) " +;; Keywords: news + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; 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. + +;;; Commentary: + +;;; Code: + +(eval-when-compile (require 'cl)) + +(require 'gnus) +(require 'gnus-int) +(require 'gnus-sum) +(require 'nnmail) + +;; (defcustom gnus-summary-article-spool-hook nil +;; "*A hook called after an article is spooled." +;; :group 'gnus-summary +;; :type 'hook) + +(defun regtest (action id from &optional to method) + (message "Registry: article %s %s from %s to %s" + id + (if method "respooling" "going") + (gnus-group-guess-full-name from) + (if to (gnus-group-guess-full-name to) "the Bit Bucket in the sky"))) + +(defun regtest-nnmail (id group) + (message "Registry: article %s spooled to %s" + id + (gnus-group-prefixed-name group gnus-internal-registry-spool-current-method t))) + +;;(add-hook 'gnus-summary-article-move-hook 'regtest) ; also does copy, respool, and crosspost +;;(add-hook 'gnus-summary-article-delete-hook 'regtest) +;;(add-hook 'gnus-summary-article-expire-hook 'regtest) +(add-hook 'nnmail-spool-hook 'regtest-nnmail) + +;; TODO: + +(provide 'gnus-registry) + +;;; gnus-registry.el ends here diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index b9b39e9..02ecda8 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -873,6 +873,21 @@ automatically when it is selected." :group 'gnus-summary :type 'hook) +(defcustom gnus-summary-article-move-hook nil + "*A hook called after an article is moved, copied, respooled, or crossposted." + :group 'gnus-summary + :type 'hook) + +(defcustom gnus-summary-article-delete-hook nil + "*A hook called after an article is deleted." + :group 'gnus-summary + :type 'hook) + +(defcustom gnus-summary-article-expire-hook nil + "*A hook called after an article is expired." + :group 'gnus-summary + :type 'hook) + (defcustom gnus-summary-display-arrow (and (fboundp 'display-graphic-p) (display-graphic-p)) @@ -8901,8 +8916,14 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (nnheader-get-report (car to-method)))) ((eq art-group 'junk) (when (eq action 'move) - (gnus-summary-mark-article article gnus-canceled-mark) - (gnus-message 4 "Deleted article %s" article))) + (let ((id (mail-header-id (gnus-data-header + (assoc article (gnus-data-list nil)))))) + (gnus-summary-mark-article article gnus-canceled-mark) + (gnus-message 4 "Deleted article %s" article) + ;; run the move/copy/crosspost/respool hook + (run-hook-with-args 'gnus-summary-article-delete-hook + action id gnus-newsgroup-name nil + select-method)))) (t (let* ((pto-group (gnus-group-prefixed-name (car art-group) to-method)) @@ -8986,7 +9007,14 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (gnus-request-article-this-buffer article gnus-newsgroup-name) (nnheader-replace-header "Xref" new-xref) (gnus-request-replace-article - article gnus-newsgroup-name (current-buffer))))) + article gnus-newsgroup-name (current-buffer)))) + + ;; run the move/copy/crosspost/respool hook + (let ((id (mail-header-id (gnus-data-header + (assoc article (gnus-data-list nil)))))) + (run-hook-with-args 'gnus-summary-article-move-hook + action id gnus-newsgroup-name to-newsgroup + select-method))) ;;;!!!Why is this necessary? (set-buffer gnus-summary-buffer) @@ -9207,7 +9235,13 @@ This will be the case if the article has both been mailed and posted." (dolist (article expirable) (when (and (not (memq article es)) (gnus-data-find article)) - (gnus-summary-mark-article article gnus-canceled-mark)))))) + (gnus-summary-mark-article article gnus-canceled-mark) + (let ((id (mail-header-id (gnus-data-header + (assoc article + (gnus-data-list nil)))))) + (run-hook-with-args 'gnus-summary-article-expire-hook + 'delete id gnus-newsgroup-name nil + nil))))))) (gnus-message 6 "Expiring articles...done"))))) (defun gnus-summary-expire-articles-now () @@ -9256,6 +9290,12 @@ delete these instead." ;; after all. (unless (memq (car articles) not-deleted) (gnus-summary-mark-article (car articles) gnus-canceled-mark)) + (let* ((article (car articles)) + (id (mail-header-id (gnus-data-header + (assoc article (gnus-data-list nil)))))) + (run-hook-with-args 'gnus-summary-article-delete-hook + 'delete id gnus-newsgroup-name nil + nil)) (setq articles (cdr articles))) (when not-deleted (gnus-message 4 "Couldn't delete articles %s" not-deleted))) diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index c78ad13..71cc93e 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -959,17 +959,14 @@ with potentially long computations." (defun gnus-map-function (funs arg) "Applies the result of the first function in FUNS to the second, and so on. ARG is passed to the first function." - (let ((myfuns funs)) - (while myfuns - (setq arg (funcall (pop myfuns) arg))) - arg)) + (while funs + (setq arg (funcall (pop funs) arg))) + arg) (defun gnus-run-hooks (&rest funcs) - "Does the same as `run-hooks', but saves excursion." - (let ((buf (current-buffer))) - (unwind-protect - (apply 'run-hooks funcs) - (set-buffer buf)))) + "Does the same as `run-hooks', but saves the current buffer." + (save-current-buffer + (apply 'run-hooks funcs))) ;;; Various @@ -983,11 +980,11 @@ ARG is passed to the first function." (eq major-mode 'gnus-group-mode)))) (defun gnus-remove-duplicates (list) - (let (new (tail list)) - (while tail - (or (member (car tail) new) - (setq new (cons (car tail) new))) - (setq tail (cdr tail))) + (let (new) + (while list + (or (member (car list) new) + (setq new (cons (car list) new))) + (setq list (cdr list))) (nreverse new))) (defun gnus-remove-if (predicate list) diff --git a/lisp/gnus.el b/lisp/gnus.el index 78d72b1..fec355f 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -60,6 +60,10 @@ :link '(custom-manual "(gnus)Article Caching") :group 'gnus) +(defgroup gnus-registry nil + "Article Registry." + :group 'gnus) + (defgroup gnus-start nil "Starting your favorite newsreader." :group 'gnus) @@ -3196,15 +3200,30 @@ that that variable is buffer-local to the summary buffers." (defsubst gnus-method-to-full-server-name (method) (format "%s+%s" (car method) (nth 1 method))) -(defun gnus-group-prefixed-name (group method) - "Return the whole name from GROUP and METHOD." +(defun gnus-group-prefixed-name (group method &optional full) + "Return the whole name from GROUP and METHOD. Call with full set to +get the fully qualified group name (even if the server is native)." (and (stringp method) (setq method (gnus-server-to-method method))) (if (or (not method) - (gnus-server-equal method "native") + (and (not full) (gnus-server-equal method "native")) (string-match ":" group)) group (concat (gnus-method-to-server-name method) ":" group))) +(defun gnus-group-guess-prefixed-name (group) + "Guess the whole name from GROUP and METHOD." + (gnus-group-prefixed-name group (gnus-find-method-for-group + group))) + +(defun gnus-group-full-name (group method) + "Return the full name from GROUP and METHOD, even if the method is +native." + (gnus-group-prefixed-name group method t)) + +(defun gnus-group-guess-full-name (group) + "Guess the full name from GROUP, even if the method is native." + (gnus-group-full-name group (gnus-find-method-for-group group))) + (defun gnus-group-real-prefix (group) "Return the prefix of the current group name." (if (string-match "^[^:]+:" group) diff --git a/lisp/mail-source.el b/lisp/mail-source.el index 1ed294f..a470606 100644 --- a/lisp/mail-source.el +++ b/lisp/mail-source.el @@ -483,7 +483,7 @@ Return the number of files that were found." (condition-case err (funcall function source callback) (error - (if (and (not mail-source-ignore-error) + (if (and (not mail-source-ignore-errors) (yes-or-no-p (format "Mail source %s error (%s). Continue? " (if (memq ':password source) diff --git a/lisp/mm-util.el b/lisp/mm-util.el index 94bcabf..da74fdd 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -463,7 +463,7 @@ If the charset is `composition', return the actual one." (mm-mule-charset-to-mime-charset charset))) (defun mm-delete-duplicates (list) - "Simple substitute for CL `delete-duplicates', testing with `equal'." + "Simple substitute for CL `delete-duplicates', testing with `equal'." (let (result head) (while list (setq head (car list)) @@ -695,7 +695,7 @@ START, END and FILENAME. START and END are buffer positions saying what text to write. Optional fourth argument specifies the coding system to use when encoding the file. -If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers." +If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'." (let ((coding-system-for-write (or codesys mm-text-coding-system-for-write mm-text-coding-system)) @@ -713,7 +713,7 @@ If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers." coding-system inhibit) "Like `write-region'. -If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers." +If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'." (let ((coding-system-for-write (or coding-system mm-text-coding-system-for-write mm-text-coding-system)) @@ -739,7 +739,7 @@ If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers." (if (fboundp 'detect-coding-region) (defun mm-detect-coding-region (start end) - "Like 'detect-coding-region' except returning the best one." + "Like `detect-coding-region' except returning the best one." (let ((coding-systems (detect-coding-region (point) (point-max)))) (or (car-safe coding-systems) diff --git a/lisp/nnmail.el b/lisp/nnmail.el index 46439f4..e20b0b1 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -347,6 +347,11 @@ discarded after running the split process." :group 'nnmail-split :type 'hook) +(defcustom nnmail-spool-hook nil + "*A hook called when a new article is spooled." + :group 'nnmail + :type 'hook) + (defcustom nnmail-large-newsgroup 50 "*The number of the articles which indicates a large newsgroup or nil. If the number of the articles is greater than the value, verbose @@ -1479,6 +1484,8 @@ See the documentation for the variable `nnmail-split-fancy' for details." (defvar group-art-list) (defvar group-art) (defun nnmail-cache-insert (id grp) + (run-hook-with-args 'nnmail-spool-hook + id grp) (when nnmail-treat-duplicates ;; Store some information about the group this message is written ;; to. This is passed in as the grp argument -- all locations this diff --git a/texi/ChangeLog b/texi/ChangeLog index 1d04330..477cd97 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,14 @@ +2003-02-07 Teodor Zlatanov + + * gnus.texi (BBDB Whitelists, Blacklists and Whitelists): + corrected existing docs, added spam-use-whitelist-exclusive and + spam-use-BBDB-exclusive to list of variables + +2003-02-07 Jesper Harder + + * gnus.texi (The problem of spam): Don't use @email for examples + -- it creates a mailto-link in HTML and PDF. + 2003-02-07 Lars Magne Ingebrigtsen * gnus.texi (Mail Source Customization): Addition. diff --git a/texi/gnus.texi b/texi/gnus.texi index 8aff37a..8109b74 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -21115,7 +21115,7 @@ requires its users to have a basic understanding of e-mail delivery and processing. The simplest approach to filtering spam is filtering. If you get 200 -spam messages per day from @email{random-address@@vmadmin.com}, you +spam messages per day from @samp{random-address@@vmadmin.com}, you block @samp{vmadmin.com}. If you get 200 messages about @samp{VIAGRA}, you discard all messages with @samp{VIAGRA} in the message. This, unfortunately, is a great way to discard legitimate @@ -21567,30 +21567,45 @@ The following are the methods you can use to control the behavior of @cindex spam @defvar spam-use-blacklist + Set this variable to @code{t} if you want to use blacklists when splitting incoming mail. Messages whose senders are in the blacklist will be sent to the @code{spam-split-group}. This is an explicit filter, meaning that it acts only on mail senders @emph{declared} to be spammers. + @end defvar @defvar spam-use-whitelist + Set this variable to @code{t} if you want to use whitelists when splitting incoming mail. Messages whose senders are not in the -whitelist will be sent to the @code{spam-split-group}. This is an -implicit filter, meaning it believes everyone to be a spammer unless -told otherwise. Use with care. +whitelist will be sent to the next spam-split rule. This is an +explicit filter, meaning that unless someone is in the whitelist, their +messages are not assumed to be spam or ham. + +@end defvar + +@defvar spam-use-whitelist-exclusive + +Set this variable to @code{t} if you want to use whitelists as an +implicit filter, meaning that every message will be considered spam +unless the sender is in the whitelist. Use with care. + @end defvar @defvar gnus-group-spam-exit-processor-blacklist + Add this symbol to a group's @code{spam-process} parameter by customizing the group parameters or the @code{gnus-spam-process-newsgroups} variable. When this symbol is added to a group's @code{spam-process} parameter, the senders of spam-marked articles will be added to the blacklist. + @end defvar @defvar gnus-group-ham-exit-processor-whitelist + Add this symbol to a group's @code{spam-process} parameter by customizing the group parameters or the @code{gnus-spam-process-newsgroups} variable. When this symbol is @@ -21598,6 +21613,7 @@ added to a group's @code{spam-process} parameter, the senders of ham-marked articles in @emph{ham} groups will be added to the whitelist. Note that this ham processor has no effect in @emph{spam} or @emph{unclassified} groups. + @end defvar Blacklists are lists of regular expressions matching addresses you @@ -21607,11 +21623,9 @@ blacklist. You start out with an empty blacklist. Blacklist entries use the Emacs regular expression syntax. Conversely, whitelists tell Gnus what addresses are considered -legitimate. All non-whitelisted addresses are considered spammers. -This option is probably not useful for most Gnus users unless the -whitelists is very comprehensive or permissive. Also see @ref{BBDB -Whitelists}. Whitelist entries use the Emacs regular expression -syntax. +legitimate. All messages from whitelisted addresses are considered +non-spam. Also see @ref{BBDB Whitelists}. Whitelist entries use the +Emacs regular expression syntax. The blacklist and whitelist file locations can be customized with the @code{spam-directory} variable (@file{~/News/spam} by default), or @@ -21630,14 +21644,27 @@ directly. The whitelist and blacklist files will by default be in the @defvar spam-use-BBDB Analogous to @code{spam-use-whitelist} (@pxref{Blacklists and -Whitelists}), but uses the BBDB as the source of whitelisted addresses, -without regular expressions. You must have the BBDB loaded for -@code{spam-use-BBDB} to work properly. Only addresses in the BBDB -will be allowed through; all others will be classified as spam. +Whitelists}), but uses the BBDB as the source of whitelisted +addresses, without regular expressions. You must have the BBDB loaded +for @code{spam-use-BBDB} to work properly. Messages whose senders are +not in the BBDB will be sent to the next spam-split rule. This is an +explicit filter, meaning that unless someone is in the BBDB, their +messages are not assumed to be spam or ham. + +@end defvar + +@defvar spam-use-BBDB-exclusive + +Set this variable to @code{t} if you want to use the BBDB as an +implicit filter, meaning that every message will be considered spam +unless the sender is in the BBDB. Use with care. Only sender +addresses in the BBDB will be allowed through; all others will be +classified as spammers. @end defvar @defvar gnus-group-ham-exit-processor-BBDB + Add this symbol to a group's @code{spam-process} parameter by customizing the group parameters or the @code{gnus-spam-process-newsgroups} variable. When this symbol is @@ -21645,6 +21672,7 @@ added to a group's @code{spam-process} parameter, the senders of ham-marked articles in @emph{ham} groups will be added to the BBDB. Note that this ham processor has no effect in @emph{spam} or @emph{unclassified} groups. + @end defvar @node Blackholes -- 1.7.10.4