From: yamaoka Date: Thu, 23 Jan 2003 23:05:11 +0000 (+0000) Subject: Synch with Oort Gnus. X-Git-Tag: t-gnus-6_15_15-00-quimby~7 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=dd9a68a616c4b59193ccf45ca41cdc9624db494f;p=elisp%2Fgnus.git- Synch with Oort Gnus. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 0a5562c..4a7cc58 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,26 @@ +2003-01-23 Lars Magne Ingebrigtsen + + * gnus-async.el (gnus-async-wait-for-article): Don't use a + timeout. + + * nntp.el (nntp-accept-process-output): Removed timeout. + (nntp-read-timeout): New variable. + (nntp-accept-process-output): Use it. + + * gnus-sum.el (gnus-data-find-list): Remove *. + +2002-01-23 Kevin Greiner + + * gnus-sum.el (gnus-summary-first-subject): Fixed bug that I + introduced on 2002-01-22. + (gnus-summary-first-unseen-or-unread-subject): Ditto. + +2003-01-23 Teodor Zlatanov + + * spam.el (spam-check-regex-headers, spam-list-of-checks) + (spam-regex-headers-spam, spam-regex-headers-ham): added spam/ham + checks of incoming mail based on simple header regexp matching + 2003-01-22 Teodor Zlatanov * gnus-sum.el (gnus-spam-mark): set to `$' diff --git a/lisp/gnus-async.el b/lisp/gnus-async.el index 56d8f67..5dac280 100644 --- a/lisp/gnus-async.el +++ b/lisp/gnus-async.el @@ -276,7 +276,7 @@ It should return non-nil if the article is to be prefetched." ;; needs to be done in nntp.el. (while (eq article gnus-async-current-prefetch-article) (incf tries) - (when (nntp-accept-process-output proc 1) + (when (nntp-accept-process-output proc) (setq tries 0)) (when (and (not nntp-have-messaged) (= tries 3)) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 9479307..7b9e7c9 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -6744,36 +6744,16 @@ Returns the article selected or nil if there are no matching articles." (gnus-data-number (car gnus-newsgroup-data))) ;; Find the first unread article. (t - (let ((data gnus-newsgroup-data) - (gnus-newsgroup-unreads gnus-newsgroup-unreads) - (gnus-newsgroup-undownloaded gnus-newsgroup-undownloaded) - (gnus-newsgroup-unseen gnus-newsgroup-unseen) - (gnus-newsgroup-unfetched gnus-newsgroup-unfetched)) + (let ((data gnus-newsgroup-data)) (while (and data - (not (let ((num (gnus-data-number (car data))) - (matched nil)) - (while (> num (or (car gnus-newsgroup-unfetched) - (1+ num))) - (pop gnus-newsgroup-unfetched)) - (unless (eq num (car gnus-newsgroup-unfetched)) - (when unread - (while (> num (or (car gnus-newsgroup-unreads) - (1+ num))) - (pop gnus-newsgroup-unreads)) - (setq matched (eq num (car gnus-newsgroup-unreads)))) - (unless matched - (when undownloaded - (while (> num (or (car gnus-newsgroup-undownloaded) - (1+ num))) - (pop gnus-newsgroup-undownloaded)) - (setq matched (eq num (car gnus-newsgroup-undownloaded)))) - (unless matched - (when unseen - (while (> num (or (car gnus-newsgroup-unseen) - (1+ num))) - (pop gnus-newsgroup-unseen)) - (setq matched (eq num (car gnus-newsgroup-unseen))))))) - matched))) + (let ((num (gnus-data-number (car data)))) + (or (memq num gnus-newsgroup-unfetched) + (not (or (and unread + (memq num gnus-newsgroup-unreads)) + (and undownloaded + (memq num gnus-newsgroup-undownloaded)) + (and unseen + (memq num gnus-newsgroup-unseen))))))) (setq data (cdr data))) (prog1 (if data @@ -7255,13 +7235,14 @@ Return nil if there are no unseen articles." (gnus-summary-position-point))) (defun gnus-summary-first-unseen-or-unread-subject () - "Place the point on the subject line of the first unseen article. -Return nil if there are no unseen articles." + "Place the point on the subject line of the first unseen article or, +if all article have been seen, on the subject line of the first unread +article." (interactive) (prog1 - (unless (when (gnus-summary-first-subject t nil t) + (unless (when (gnus-summary-first-subject nil nil t) (gnus-summary-show-thread) - (gnus-summary-first-subject t nil t)) + (gnus-summary-first-subject nil nil t)) (when (gnus-summary-first-subject t) (gnus-summary-show-thread) (gnus-summary-first-subject t))) diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index 49b5407..9e127a0 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -1294,9 +1294,9 @@ If RECURSIVE, search recursively." (defsubst mm-set-handle-multipart-parameter (handle parameter value) ;; HANDLE could be a CTL. - (if handle - (put-text-property 0 (length (car handle)) parameter value - (car handle)))) + (when handle + (put-text-property 0 (length (car handle)) parameter value + (car handle)))) (defun mm-possibly-verify-or-decrypt (parts ctl) (let ((type (car ctl)) @@ -1329,25 +1329,26 @@ If RECURSIVE, search recursively." protocols nil) (setq protocols (cdr protocols)))))) (setq func (nth 1 (assoc protocol mm-verify-function-alist))) - (if (cond - ((eq mm-verify-option 'never) nil) - ((eq mm-verify-option 'always) t) - ((eq mm-verify-option 'known) - (and func - (or (not (setq functest - (nth 3 (assoc protocol - mm-verify-function-alist)))) - (funcall functest parts ctl)))) - (t (y-or-n-p + (when (cond + ((eq mm-verify-option 'never) nil) + ((eq mm-verify-option 'always) t) + ((eq mm-verify-option 'known) + (and func + (or (not (setq functest + (nth 3 (assoc protocol + mm-verify-function-alist)))) + (funcall functest parts ctl)))) + (t + (y-or-n-p (format "Verify signed (%s) part? " (or (nth 2 (assoc protocol mm-verify-function-alist)) (format "protocol=%s" protocol)))))) - (save-excursion - (if func - (funcall func parts ctl) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details - (format "Unknown sign protocol (%s)" protocol)))))) + (save-excursion + (if func + (funcall func parts ctl) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details + (format "Unknown sign protocol (%s)" protocol)))))) ((equal subtype "encrypted") (unless (setq protocol (mm-handle-multipart-ctl-parameter ctl 'protocol)) @@ -1360,25 +1361,26 @@ If RECURSIVE, search recursively." parts nil) (setq parts (cdr parts)))))) (setq func (nth 1 (assoc protocol mm-decrypt-function-alist))) - (if (cond - ((eq mm-decrypt-option 'never) nil) - ((eq mm-decrypt-option 'always) t) - ((eq mm-decrypt-option 'known) - (and func - (or (not (setq functest - (nth 3 (assoc protocol - mm-decrypt-function-alist)))) - (funcall functest parts ctl)))) - (t (y-or-n-p + (when (cond + ((eq mm-decrypt-option 'never) nil) + ((eq mm-decrypt-option 'always) t) + ((eq mm-decrypt-option 'known) + (and func + (or (not (setq functest + (nth 3 (assoc protocol + mm-decrypt-function-alist)))) + (funcall functest parts ctl)))) + (t + (y-or-n-p (format "Decrypt (%s) part? " (or (nth 2 (assoc protocol mm-decrypt-function-alist)) (format "protocol=%s" protocol)))))) - (save-excursion - (if func - (setq parts (funcall func parts ctl)) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details - (format "Unknown encrypt protocol (%s)" protocol)))))) + (save-excursion + (if func + (setq parts (funcall func parts ctl)) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details + (format "Unknown encrypt protocol (%s)" protocol)))))) (t nil)) parts)) diff --git a/lisp/nntp.el b/lisp/nntp.el index fe5f9e0..0b822a5 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -237,6 +237,10 @@ NOTE: This variable is never seen to work in Emacs 20 and XEmacs 21.") "*Hook run just before posting an article. It is supposed to be used to insert Cancel-Lock headers.") +(defvoo nntp-read-timeout 0.1 + "How long nntp should wait between checking for the end of output. +Shorter values mean quicker response, but is more CPU intensive.") + ;;; Internal variables. (defvar nntp-record-commands nil @@ -611,17 +615,15 @@ command whose response triggered the error." nntp-server-buffer)) (buffer (and process (process-buffer process)))) - ; when I an able to identify - ; the connection to the server - ; AND I've received NO reponse - ; for nntp-connection-timeout - ; seconds. + ;; When I an able to identify the + ;; connection to the server AND I've + ;; received NO reponse for + ;; nntp-connection-timeout seconds. (when (and buffer (eq 0 (buffer-size buffer))) - ; Close the connection. Take - ; no other action as the - ; accept input code will - ; handle the closed - ; connection. + ;; Close the connection. Take no + ;; other action as the accept input + ;; code will handle the closed + ;; connection. (nntp-kill-buffer buffer)))))))) (unwind-protect (setq nntp-with-open-group-internal @@ -629,8 +631,7 @@ command whose response triggered the error." (progn ,@forms) (quit (nntp-close-server) - (signal 'quit nil))) - ) + (signal 'quit nil)))) (when timer (nnheader-cancel-timer timer))) nil)) @@ -1336,7 +1337,7 @@ password contained in '~/.nntp-authinfo'." (nnheader-report 'nntp message) message)) -(defun nntp-accept-process-output (process &optional timeout) +(defun nntp-accept-process-output (process) "Wait for output from PROCESS and message some dots." (save-excursion (set-buffer (or (nntp-find-connection-buffer nntp-server-buffer) @@ -1346,15 +1347,18 @@ password contained in '~/.nntp-authinfo'." (unless (< len 10) (setq nntp-have-messaged t) (nnheader-message 7 "nntp read: %dk" len))) - (if timeout - (accept-process-output process timeout) - (accept-process-output process 0 100)) + (accept-process-output + process + (truncate nntp-read-timeout) + (truncate (* (- nntp-read-timeout + (truncate nntp-read-timeout)) + 1000))) ;; accept-process-output may update status of process to indicate ;; that the server has closed the connection. This MUST be ;; handled here as the buffer restored by the save-excursion may ;; be the process's former output buffer (i.e. now killed) (or (and process - (memq (process-status process) '(open run))) + (memq (process-status process) '(open run))) (nntp-report "Server closed connection")))) (defun nntp-accept-response () diff --git a/lisp/spam.el b/lisp/spam.el index 40b750c..87cc0a9 100644 --- a/lisp/spam.el +++ b/lisp/spam.el @@ -102,6 +102,12 @@ The regular expression is matched against the address." :type 'boolean :group 'spam) +(defcustom spam-use-regex-headers nil + "Whether a header regular expression match should be used by spam-split. +Also see the variable `spam-spam-regex-headers' and `spam-ham-regex-headers'." + :type 'boolean + :group 'spam) + (defcustom spam-use-bogofilter-headers nil "Whether bogofilter headers should be used by spam-split. Enable this if you pre-process messages with Bogofilter BEFORE Gnus sees them." @@ -174,6 +180,16 @@ Such articles will be transmitted to `bogofilter -s' on group exit." :type 'face :group 'spam) +(defcustom spam-regex-headers-spam '("^X-Spam-Flag: YES") + "Regular expression for positive header spam matches" + :type '(repeat (regexp :tag "Regular expression to match spam header")) + :group 'spam) + +(defcustom spam-regex-headers-ham '("^X-Spam-Flag: NO") + "Regular expression for positive header ham matches" + :type '(repeat (regexp :tag "Regular expression to match ham header")) + :group 'spam) + (defgroup spam-ifile nil "Spam ifile configuration." :group 'spam) @@ -461,6 +477,7 @@ your main source of newsgroup names." (defvar spam-list-of-checks '((spam-use-blacklist . spam-check-blacklist) + (spam-use-regex-headers . spam-check-regex-headers) (spam-use-whitelist . spam-check-whitelist) (spam-use-BBDB . spam-check-BBDB) (spam-use-ifile . spam-check-ifile) @@ -501,6 +518,26 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." nil decision))) +;;;; Regex headers + +(defun spam-check-regex-headers () + (let (ret found) + (dolist (h-regex spam-regex-headers-ham) + (unless found + (goto-char (point-min)) + (when (re-search-forward h-regex nil t) + (message "Ham regex header search positive.") + (setq found t)))) + (dolist (s-regex spam-regex-headers-spam) + (unless found + (goto-char (point-min)) + (when (re-search-forward s-regex nil t) + (message "Spam regex header search positive." (match-string 1)) + (setq found t) + (setq ret spam-split-group)))) + ret)) + + ;;;; Blackholes. (defun spam-check-blackholes () diff --git a/texi/ChangeLog b/texi/ChangeLog index 47c5944..efeb708 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,12 @@ +2003-01-23 Lars Magne Ingebrigtsen + + * gnus.texi (NNTP): Addition. + +2003-01-23 Teodor Zlatanov + + * gnus.texi (Regular Expressions Header Matching): documentation + for new spam splitting functionality + 2003-01-23 Jesper Harder * gnus.texi (Signing and encrypting): Index. diff --git a/texi/gnus-ja.texi b/texi/gnus-ja.texi index 782fd44..28c5955 100644 --- a/texi/gnus-ja.texi +++ b/texi/gnus-ja.texi @@ -11654,6 +11654,13 @@ default force yes $B$9$Y$F$N%5!<%P!<$,?d>)(B ID $B$r%5%]!<%H$7$F$$$k$o$1$G$O$J$$$3$H$KCm0U$7$F2<(B $B$5$$!#$3$l$ONc$($P(B INN 2.3.0 $B0J>e$GF0:n$7$^$9!#(B +@item nntp-read-timeout +@vindex nntp-read-timeout +Nntp $B$,=PNO$,=*N;$7$?$3$H$r3NG'$9$k$?$a$KBT$D$Y$-;~4V$G$9!#CM$rC;$/$9$l(B +$B$PH?1~$,B.$/$J$j$^$9$,(B CPU $B$r?)$$$^$9!#%G%#%U%)%k%H$O(B 0.1 $BIC$G$9!#%5!<%P!<(B +$B$KCY$$2s@~$G@\B3$7$F$$$k>l9g$O(B ($B$=$7$F(B Emacs $B$,(B CPU $B%Q%o!<$r?)$&$N$rK>$^(B +$B$J$1$l$P(B)$B!"$3$l$rNc$($P(B 1 $B$K$7$F$b9=$$$^$;$s!#(B + @item nntp-list-options @vindex nntp-list-options LIST $B%3%^%s%I$N%*%W%7%g%s$K;H$C$F!"(B($B%5!<%P!<$N(B) $B%j%9%H=PNO$r@_Dj$7$?%K%e!<(B @@ -21038,6 +21045,7 @@ spam-check-bogofilter$B!"(Bspam-check-ifile $B$^$?$O(B spam-check-stat ($B$ * Blacklists and Whitelists:: * BBDB Whitelists:: * Blackholes:: +* Regular Expressions Header Matching:: * Bogofilter:: * ifile spam filtering:: * spam-stat spam filtering:: @@ -21172,6 +21180,40 @@ spam-check-bogofilter$B!"(Bspam-check-ifile $B$^$?$O(B spam-check-stat ($B$ $B%V%i%C%/%[!<%k!&%A%'%C%/$OF~$C$FMh$k%a!<%k$KBP$7$F$@$19T$J$o$l$^$9!#%V%i%C(B $B%/%[!<%k$K(B spam $B$^$?$O(B ham $B%W%m%;%C%5!<$O$"$j$^$;$s!#(B +@node Regular Expressions Header Matching +@subsubsection $B@55,I=8=$K$h$k%X%C%@!<$N9gCW8!::(B +@cindex spam filtering +@cindex regular expressions header matching, spam filtering +@cindex spam + +@defvar spam-use-regex-headers + +$B$3$N%*%W%7%g%s$O%G%#%U%)%k%H$GL58z$K$J$C$F$$$^$9!#$3$N%*%W%7%g%s$r%;%C%H(B +$B$9$k$H!"(Bgnus $B$K@55,I=8=$N%j%9%H$H%a%C%;!<%8%X%C%@!<$r>H9g$5$;$k$3$H$,$G(B +$B$-$^$9!#JQ?t(B @code{spam-regex-headers-spam} $B$*$h(B +$B$S(B @code{spam-regex-headers-ham} $B$,@55,I=8=$N%j%9%H$r;}$A$^$9!#%a%C%;!<(B +$B%8$,(B spam $B$^$?$O(B ham $B$+$I$&$+$r7h$a$k$?$a$K!"(BGnus $B$O%a%C%;!<%8%X%C%@!<$N(B +$B$=$l$>$l$r8!::$7$^$9!#(B + +@end defvar + +@defvar spam-regex-headers-spam + +$B%a%C%;!<%8%X%C%@!<$NCf$G0lCW$7$?;~$K!"$=$l$,L@$i$+$K(B spam $B$G$"$k$3$H$r8+(B +$BJ,$1$k$?$a$N@55,I=8=$N%j%9%H$G$9!#(B + +@end defvar + +@defvar spam-regex-headers-ham + +$B%a%C%;!<%8%X%C%@!<$NCf$G0lCW$7$?;~$K!"$=$l$,L@$i$+$K(B ham $B$G$"$k$3$H$r8+(B +$BJ,$1$k$?$a$N@55,I=8=$N%j%9%H$G$9!#(B + +@end defvar + +$B@55,I=8=$K$h$k%X%C%@!<$N8!::$O!"F~$C$F$-$?%a!<%k$KBP$7$F$@$19T$J$o$l$^$9!#(B +$B@55,I=8=$N$?$a$KFCM-$J(B spam $B$^$?$O(B ham $B%W%m%;%C%5!<$O$"$j$^$;$s!#(B + @node Bogofilter @subsubsection Bogofilter @cindex spam filtering diff --git a/texi/gnus.texi b/texi/gnus.texi index b3f0bd0..7c20e90 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -12229,6 +12229,14 @@ inhibit Gnus to add a @code{Message-ID} header, you could say: Note that not all servers support the recommended ID. This works for INN versions 2.3.0 and later, for instance. +@item nntp-read-timeout +@vindex nntp-read-timeout +How long nntp should wait between checking for the end of output. +Shorter values mean quicker response, but is more CPU intensive. The +default is 0.1 seconds. If you have a slow line to the server (and +don't like to see Emacs eat your available CPU power), you might set +this to, say, 1. + @item nntp-list-options @vindex nntp-list-options List of newsgroup name used for a option of the LIST command to restrict @@ -21510,6 +21518,7 @@ The following are the methods you can use to control the behavior of * Blacklists and Whitelists:: * BBDB Whitelists:: * Blackholes:: +* Regular Expressions Header Matching:: * Bogofilter:: * ifile spam filtering:: * spam-stat spam filtering:: @@ -21644,6 +21653,40 @@ The default setting of @code{t} is recommended. Blackhole checks are done only on incoming mail. There is no spam or ham processor for blackholes. +@node Regular Expressions Header Matching +@subsubsection Regular Expressions Header Matching +@cindex spam filtering +@cindex regular expressions header matching, spam filtering +@cindex spam + +@defvar spam-use-regex-headers + +This option is disabled by default. You can let Gnus check the +message headers against lists of regular expressions when you set this +option. The variables @code{spam-regex-headers-spam} and +@code{spam-regex-headers-ham} hold the list of regular expressions. +Gnus will check against the message headers to determine if the +message is spam or ham, respectively. + +@end defvar + +@defvar spam-regex-headers-spam + +The list of regular expressions that, when matched in the headers of +the message, positively identify it as spam. + +@end defvar + +@defvar spam-regex-headers-ham + +The list of regular expressions that, when matched in the headers of +the message, positively identify it as ham. + +@end defvar + +Regular expression header checks are done only on incoming mail. +There is no specific spam or ham processor for regular expressions. + @node Bogofilter @subsubsection Bogofilter @cindex spam filtering