From 4c4dcce37cbad12c5895cc26ff5e08bf43acfedd Mon Sep 17 00:00:00 2001 From: yamaoka Date: Wed, 12 Feb 2003 22:55:48 +0000 Subject: [PATCH] Synch to Oort Gnus. --- lisp/ChangeLog | 33 +++++++++++++++++++++++++++++++++ lisp/gnus-art.el | 39 ++++++++++++++++++++++++++++++++++----- lisp/gnus-cite.el | 51 +++++++++++++++++++++++++++++++++++++++++++++++---- lisp/gnus-sum.el | 3 ++- lisp/spam.el | 39 ++++++++++++++++++++++++--------------- texi/ChangeLog | 11 +++++++++++ texi/gnus-ja.texi | 18 ++++++++++++++++-- texi/gnus.texi | 14 ++++++++++++++ 8 files changed, 181 insertions(+), 27 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index b9439d9..121ed5f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,36 @@ +2003-02-13 Michael Shields + + * gnus-cite.el + (gnus-cite-attribution-suffix, gnus-cite-parse): + Better handling for Microsoft citation styles. + (gnus-unsightly-citation-regexp): New. + +2003-02-12 Michael Shields + + * gnus-art.el (article-strip-banner): Strip both per-group and + per-user-address banners. + (article-really-strip-banner): New. + +2003-02-12 Michael Shields + + * gnus-sum.el (gnus-article-goto-next-page, + gnus-article-goto-prev-page): Call gnus-summary-*-page, instead of + relying on the summary bindings of `n' and `p'. + +2003-02-12 Michael Shields + + * gnus-art.el (gnus-article-only-boring-p): New. + (gnus-article-skip-boring): New. + * gnus-cite.el (gnus-article-boring-faces): New. + * gnus-sum.el (gnus-summary-next-page): Use + gnus-article-only-boring-p. + +2003-02-12 Teodor Zlatanov + + * spam.el (spam-mark-spam-as-expired-and-move-routine) + (spam-ham-move-routine): unmark all articles before marking those + of interest and calling gnus-summary-move-article + 2003-02-12 Jesper Harder * gnus.el (gnus-kill-buffer): Move to gnus.el because it's diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index dffdb68..53394c2 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -209,6 +209,15 @@ Possible values in this list are: (const :tag "Multiple To and/or Cc headers." many-to)) :group 'gnus-article-hiding) +(defcustom gnus-article-skip-boring nil + "Skip over text that is not worth reading. +By default, if you set this t, then Gnus will display citations and +signatures, but will never scroll down to show you a page consisting +only of boring text. Boring text is controlled by +`gnus-article-boring-faces'." + :type 'boolean + :group 'gnus-article-hiding) + (defcustom gnus-signature-separator '("^-- $" "^-- *$") "Regexp matching signature separator. This can also be a list of regexps. In that case, it will be checked @@ -5050,15 +5059,14 @@ If given a numerical ARG, move forward ARG pages." (defun gnus-article-goto-next-page () "Show the next page of the article." (interactive) - (when (gnus-article-next-page) - (goto-char (point-min)) - (gnus-article-read-summary-keys nil (gnus-character-to-event ?n)))) + (gnus-eval-in-buffer-window gnus-summary-buffer + (gnus-summary-next-page))) (defun gnus-article-goto-prev-page () "Show the next page of the article." (interactive) - (if (bobp) (gnus-article-read-summary-keys nil (gnus-character-to-event ?p)) - (gnus-article-prev-page nil))) + (gnus-eval-in-buffer-window gnus-summary-buffer + (gnus-summary-prev-page))) (defun gnus-article-next-page (&optional lines) "Show the next page of the current article. @@ -5116,6 +5124,27 @@ Argument LINES specifies lines to be scrolled down." (beginning-of-buffer (goto-char (point-min)))))))) +(defun gnus-article-only-boring-p () + "Decide whether there is only boring text remaining in the article. +Something \"interesting\" is a word of at least two letters that does +not have a face in `gnus-article-boring-faces'." + (when (and gnus-article-skip-boring + gnus-article-boring-faces) + (save-excursion + (catch 'only-boring + (while (re-search-forward "\\b\\w\\w" nil t) + (forward-char -1) + (when (not (gnus-intersection + (cons (plist-get (text-properties-at (point)) + 'face) + (mapcar-extents + '(lambda (extent) + (extent-property extent 'face)) + nil (current-buffer) (point) (point))) + gnus-article-boring-faces)) + (throw 'only-boring nil))) + (throw 'only-boring t))))) + (defun gnus-article-refer-article () "Read article specified by message-id around point." (interactive) diff --git a/lisp/gnus-cite.el b/lisp/gnus-cite.el index ff551dd..b47c74e 100644 --- a/lisp/gnus-cite.el +++ b/lisp/gnus-cite.el @@ -30,7 +30,6 @@ (eval-when-compile (require 'static)) (require 'gnus) -(require 'gnus-art) (require 'gnus-range) (require 'message) ; for message-cite-prefix-regexp @@ -92,19 +91,42 @@ The first regexp group should match the Supercite attribution." :group 'gnus-cite :type 'integer) +;; Some Microsoft products put in a citation that extends to the +;; remainder of the message: +;; +;; -----Original Message----- +;; From: ... +;; To: ... +;; Sent: ... [date, in non-RFC-2822 format] +;; Subject: ... +;; +;; Cited message, with no prefixes +;; +;; The four headers are always the same. But note they are prone to +;; folding without additional indentation. +;; +;; Others use "----- Original Message -----" instead, and properly quote +;; the body using "> ". This style is handled without special cases. + (defcustom gnus-cite-attribution-prefix - "In article\\|in <\\|On \\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),\\|-----Original Message-----" + "In article\\|in <\\|On \\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),\\|----- ?Original Message ?-----" "*Regexp matching the beginning of an attribution line." :group 'gnus-cite :type 'regexp) (defcustom gnus-cite-attribution-suffix - "\\(\\(wrote\\|writes\\|said\\|says\\|>\\)\\(:\\|\\.\\.\\.\\)\\|-----Original Message-----\\)[ \t]*$" + "\\(\\(wrote\\|writes\\|said\\|says\\|>\\)\\(:\\|\\.\\.\\.\\)\\|----- ?Original Message ?-----\\)[ \t]*$" "*Regexp matching the end of an attribution line. The text matching the first grouping will be used as a button." :group 'gnus-cite :type 'regexp) +(defcustom gnus-unsightly-citation-regexp + "^-----Original Message-----\nFrom: \\(.+\n\\)+\n" + "Regexp matching Microsoft-type rest-of-message citations." + :group 'gnus-cite + :type 'regexp) + (defface gnus-cite-attribution-face '((t (:italic t))) "Face used for attribution lines.") @@ -252,6 +274,17 @@ This should make it easier to see who wrote what." :group 'gnus-cite :type 'boolean) +;; This has to go here because its default value depends on +;; gnus-cite-face-list. +(defcustom gnus-article-boring-faces (cons 'gnus-signature-face + gnus-cite-face-list) + "List of faces that are not worth reading. +If an article has more pages below the one you are looking at, but +nothing on those pages is a word of at least three letters that is not +in a boring face, then the pages will be skipped." + :type '(repeat face) + :group 'gnus-article-hiding) + ;;; Internal Variables: (defvar gnus-cite-article nil) @@ -715,9 +748,19 @@ See also the documentation for `gnus-article-highlight-citation'." (goto-char begin)) (goto-char start) (setq line (1+ line))) + ;; Horrible special case for some Microsoft mailers. + (goto-char (point-min)) + (when (re-search-forward gnus-unsightly-citation-regexp max t) + (setq begin (count-lines (point-min) (point))) + (setq end (count-lines (point-min) max)) + (setq entry nil) + (while (< begin end) + (push begin entry) + (setq begin (1+ begin))) + (push (cons "" entry) alist)) ;; We got all the potential prefixes. Now create ;; `gnus-cite-prefix-alist' containing the oldest prefix for each - ;; line that appears at least gnus-cite-minimum-match-count + ;; line that appears at least `gnus-cite-minimum-match-count' ;; times. First sort them by length. Longer is older. (setq alist (sort alist (lambda (a b) (> (length (car a)) (length (car b)))))) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 332e00e..9ef0aad 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -7124,7 +7124,8 @@ If STOP is non-nil, just stop when reaching the end of the message." (gnus-summary-display-article article) (when article-window (gnus-eval-in-buffer-window gnus-article-buffer - (setq endp (gnus-article-next-page lines))) + (setq endp (or (gnus-article-next-page lines) + (gnus-article-only-boring-p)))) (when endp (cond (stop (gnus-message 3 "End of message")) diff --git a/lisp/spam.el b/lisp/spam.el index 22c9dd4..89f77e9 100644 --- a/lisp/spam.el +++ b/lisp/spam.el @@ -412,26 +412,35 @@ your main source of newsgroup names." (defun spam-mark-spam-as-expired-and-move-routine (&optional group) (let ((articles gnus-newsgroup-articles) - article) - (while articles - (setq article (pop articles)) + article tomove) + (dolist (article articles) + (gnus-summary-remove-process-mark article) (when (eq (gnus-summary-article-mark article) gnus-spam-mark) (gnus-summary-mark-article article gnus-expirable-mark) - (when (stringp group) - (gnus-summary-set-process-mark article) - (gnus-summary-move-article nil group)))))) + (push article tomove))) + + ;; now do the actual move + (when (stringp group) + (dolist (article tomove) + (gnus-summary-set-process-mark 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)) - (dolist (article articles) - (when (and (memq (gnus-summary-article-mark article) ham-mark-values) - (stringp group)) - (gnus-summary-set-process-mark article) - (gnus-summary-move-article nil group))))) + article ham-mark-values mark tomove) + (when (stringp group) ; this routine will do nothing + ; without a valid group + (dolist (mark spam-ham-marks) + (push (symbol-value mark) ham-mark-values)) + (dolist (article articles) + (gnus-summary-remove-process-mark article) + (when (memq (gnus-summary-article-mark article) ham-mark-values) + (push article tomove))) + + ;; now do the actual move + (dolist (article tomove) + (gnus-summary-set-process-mark article)) + (gnus-summary-move-article nil group)))) (defun spam-generic-register-routine (spam-func ham-func) (let ((articles gnus-newsgroup-articles) diff --git a/texi/ChangeLog b/texi/ChangeLog index 139725f..7cd6df6 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,14 @@ +2003-02-12 Michael Shields + + * gnus.texi (Paging the Article): Document + gnus-article-boring-faces. + (Choosing Commands): Explain that SPACE in the summary buffer + is used for both selecting and scrolling. + + * gnus.texi (Article Keymap): Say that SPACE and DEL in the + summary buffer are the same as switching to the article buffer + and using SPACE and DEL; since now that is the case. + 2003-02-11 Lars Magne Ingebrigtsen * gnus.texi (Topic Commands): Addition. diff --git a/texi/gnus-ja.texi b/texi/gnus-ja.texi index d2c6c80..2ad14fc 100644 --- a/texi/gnus-ja.texi +++ b/texi/gnus-ja.texi @@ -4935,6 +4935,10 @@ Summary Buffer} $B$r;2>H$7$F2<$5$$!#(B $B8=:_$N5-;v$+!"$=$l$,4{$KFI$^$l$F$$$k>l9g$OH$7$F2<$5$$!#(B @kbd{SPACE} $B$O5-;v$r0l%Z!<%8@h$K%9%/%m!<%k$7$^$9!#5-;v$N:G8e$K$$$k>l9g$O(B $B$7$+L5$$>l9g!"$=$l$O%9%-%C%W$5$l!"Be$o$j$K