Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Merge from emacs--gnus--5.10, gnus--rel--5.10

Patches applied:

 * miles@gnu.org--gnu-2004/emacs--gnus--5.10--base-0
   tag of miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-464

 * miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-1
   Import from CVS branch gnus-5_10-branch

 * miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-2
   Merge from lorentey@elte.hu--2004/emacs--multi-tty--0, emacs--cvs-trunk--0

 * miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-3
   Merge from gnus--rel--5.10

 * miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-4
   Merge from gnus--rel--5.10

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-18
   Update from CVS

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-19
   Remove autoconf-generated files from archive

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-20
   Update from CVS

1 files changed, 166 insertions, 92 deletions

diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el
index 5a041d11197..51617918a4c 100644
--- a/lisp/gnus/gnus-cite.el
+++ b/lisp/gnus/gnus-cite.el
@@ -1,6 +1,6 @@
-;;; gnus-cite.el --- parse citations in articles for Gnus  -*- coding: iso-latin-1 -*-
+;;; gnus-cite.el --- parse citations in articles for Gnus
 
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
 ;;        Free Software Foundation, Inc.
 
 ;; Author: Per Abhiddenware
@@ -29,8 +29,9 @@
 (eval-when-compile (require 'cl))
 
 (require 'gnus)
-(require 'gnus-art)
 (require 'gnus-range)
+(require 'gnus-art)
+(require 'message)	; for message-cite-prefix-regexp
 
 ;;; Customization:
 
@@ -40,19 +41,6 @@
   :link '(custom-manual "(gnus)Article Highlighting")
   :group 'gnus-article)
 
-(defcustom gnus-cite-reply-regexp
-  "^\\(Subject: Re\\|In-Reply-To\\|References\\):"
-  "*If headers match this regexp it is reasonable to believe that
-article has citations."
-  :group 'gnus-cite
-  :type 'string)
-
-(defcustom gnus-cite-always-check nil
-  "Check article always for citations.  Set it t to check all articles."
-  :group 'gnus-cite
-  :type '(choice (const :tag "no" nil)
-		 (const :tag "yes" t)))
-
 (defcustom gnus-cited-opened-text-button-line-format "%(%{[-]%}%)\n"
   "Format of opened cited text buttons."
   :group 'gnus-cite
@@ -79,20 +67,13 @@ Set it to nil to parse all articles."
   :type '(choice (const :tag "all" nil)
 		 integer))
 
-(defcustom gnus-cite-prefix-regexp
-  ;; The Latin-1 angle quote looks pretty dubious.  -- fx
-  "^[]>»|:}+ ]*[]>»|:}+]\\(.*>»\\)?\\|^.*>"
-  "*Regexp matching the longest possible citation prefix on a line."
-  :group 'gnus-cite
-  :type 'regexp)
-
 (defcustom gnus-cite-max-prefix 20
   "Maximum possible length for a citation prefix."
   :group 'gnus-cite
   :type 'integer)
 
 (defcustom gnus-supercite-regexp
-  (concat "^\\(" gnus-cite-prefix-regexp "\\)? *"
+  (concat "^\\(" message-cite-prefix-regexp "\\)? *"
 	  ">>>>> +\"\\([^\"\n]+\\)\" +==")
   "*Regexp matching normal Supercite attribution lines.
 The first grouping must match prefixes added by other packages."
@@ -110,21 +91,51 @@ 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-cite-unsightly-citation-regexp
+  "^-----Original Message-----\nFrom: \\(.+\n\\)+\n"
+  "Regexp matching Microsoft-type rest-of-message citations."
+  :group 'gnus-cite
+  :type 'regexp)
+
+(defcustom gnus-cite-ignore-quoted-from t
+  "Non-nil means don't regard lines beginning with \">From \" as cited text.
+Those lines may have been quoted by MTAs in order not to mix up with
+the envelope From line."
+  :group 'gnus-cite
+  :type 'boolean)
+
 (defface gnus-cite-attribution-face '((t
-				       (:slant italic)))
+				       (:italic t)))
   "Face used for attribution lines.")
 
 (defcustom gnus-cite-attribution-face 'gnus-cite-attribution-face
@@ -140,7 +151,7 @@ It is merged with the face for the cited text belonging to the attribution."
 			      (background light))
 			     (:foreground "MidnightBlue"))
 			    (t
-			     (:slant italic)))
+			     (:italic t)))
   "Citation face.")
 
 (defface gnus-cite-face-2 '((((class color)
@@ -150,7 +161,7 @@ It is merged with the face for the cited text belonging to the attribution."
 			      (background light))
 			     (:foreground "firebrick"))
 			    (t
-			     (:slant italic)))
+			     (:italic t)))
   "Citation face.")
 
 (defface gnus-cite-face-3 '((((class color)
@@ -160,7 +171,7 @@ It is merged with the face for the cited text belonging to the attribution."
 			      (background light))
 			     (:foreground "dark green"))
 			    (t
-			     (:slant italic)))
+			     (:italic t)))
   "Citation face.")
 
 (defface gnus-cite-face-4 '((((class color)
@@ -170,7 +181,7 @@ It is merged with the face for the cited text belonging to the attribution."
 			      (background light))
 			     (:foreground "OrangeRed"))
 			    (t
-			     (:slant italic)))
+			     (:italic t)))
   "Citation face.")
 
 (defface gnus-cite-face-5 '((((class color)
@@ -180,7 +191,7 @@ It is merged with the face for the cited text belonging to the attribution."
 			      (background light))
 			     (:foreground "dark khaki"))
 			    (t
-			     (:slant italic)))
+			     (:italic t)))
   "Citation face.")
 
 (defface gnus-cite-face-6 '((((class color)
@@ -190,7 +201,7 @@ It is merged with the face for the cited text belonging to the attribution."
 			      (background light))
 			     (:foreground "dark violet"))
 			    (t
-			     (:slant italic)))
+			     (:italic t)))
   "Citation face.")
 
 (defface gnus-cite-face-7 '((((class color)
@@ -200,7 +211,7 @@ It is merged with the face for the cited text belonging to the attribution."
 			      (background light))
 			     (:foreground "SteelBlue4"))
 			    (t
-			     (:slant italic)))
+			     (:italic t)))
   "Citation face.")
 
 (defface gnus-cite-face-8 '((((class color)
@@ -210,7 +221,7 @@ It is merged with the face for the cited text belonging to the attribution."
 			      (background light))
 			     (:foreground "magenta"))
 			    (t
-			     (:slant italic)))
+			     (:italic t)))
   "Citation face.")
 
 (defface gnus-cite-face-9 '((((class color)
@@ -220,7 +231,7 @@ It is merged with the face for the cited text belonging to the attribution."
 			      (background light))
 			     (:foreground "violet"))
 			    (t
-			     (:slant italic)))
+			     (:italic t)))
   "Citation face.")
 
 (defface gnus-cite-face-10 '((((class color)
@@ -230,7 +241,7 @@ It is merged with the face for the cited text belonging to the attribution."
 			       (background light))
 			      (:foreground "medium purple"))
 			     (t
-			      (:slant italic)))
+			      (:italic t)))
   "Citation face.")
 
 (defface gnus-cite-face-11 '((((class color)
@@ -240,7 +251,7 @@ It is merged with the face for the cited text belonging to the attribution."
 			       (background light))
 			      (:foreground "turquoise"))
 			     (t
-			      (:slant italic)))
+			      (:italic t)))
   "Citation face.")
 
 (defcustom gnus-cite-face-list
@@ -270,6 +281,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)
@@ -317,7 +339,7 @@ Attribution lines are highlighted with the same face as the
 corresponding citation merged with `gnus-cite-attribution-face'.
 
 Text is considered cited if at least `gnus-cite-minimum-match-count'
-lines matches `gnus-cite-prefix-regexp' with the same prefix.
+lines matches `message-cite-prefix-regexp' with the same prefix.
 
 Lines matching `gnus-cite-attribution-suffix' and perhaps
 `gnus-cite-attribution-prefix' are considered attribution lines."
@@ -358,7 +380,7 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps
 	(goto-char (point-min))
 	(forward-line (1- number))
 	(when (re-search-forward gnus-cite-attribution-suffix
-				 (save-excursion (end-of-line 1) (point))
+				 (gnus-point-at-eol)
 				 t)
 	  (gnus-article-add-button (match-beginning 1) (match-end 1)
 				   'gnus-cite-toggle prefix))
@@ -450,7 +472,10 @@ If WIDTH (the numerical prefix), use that text width when filling."
 	  (narrow-to-region (caar marks) (caadr marks))
 	  (let ((adaptive-fill-regexp
 		 (concat "^" (regexp-quote (cdar marks)) " *"))
-		(fill-prefix (cdar marks)))
+		(fill-prefix
+		 (if (string= (cdar marks) "") ""
+		   (concat (cdar marks) " ")))
+		use-hard-newlines)
 	    (fill-region (point-min) (point-max)))
 	  (set-marker (caar marks) nil)
 	  (setq marks (cdr marks)))
@@ -519,6 +544,7 @@ always hide."
 		      (setq beg nil)
 		  (setq end (point-marker))))))
 	    (when (and beg end)
+	      (gnus-add-wash-type 'cite)
 	      ;; We use markers for the end-points to facilitate later
 	      ;; wrapping and mangling of text.
 	      (setq beg (set-marker (make-marker) beg)
@@ -558,14 +584,20 @@ means show, nil means toggle."
 	      (and (> arg 0) (not hidden))
 	      (and (< arg 0) hidden))
       (if hidden
-	  (gnus-remove-text-properties-when
-	   'article-type 'cite beg end
-	   (cons 'article-type (cons 'cite
-				     gnus-hidden-properties)))
+	  (progn
+	    ;; Can't remove 'cite from g-a-wash-types here because
+	    ;; multiple citations may be hidden -jas
+	    (gnus-remove-text-properties-when
+	     'article-type 'cite beg end
+	     (cons 'article-type (cons 'cite
+				       gnus-hidden-properties))))
+	(gnus-add-wash-type 'cite)
 	(gnus-add-text-properties-when
 	 'article-type nil beg end
 	 (cons 'article-type (cons 'cite
 				   gnus-hidden-properties))))
+      (let ((gnus-article-mime-handle-alist-1 gnus-article-mime-handle-alist))
+	(gnus-set-mode-line 'article))
       (save-excursion
 	(goto-char start)
 	(gnus-delete-line)
@@ -594,41 +626,44 @@ cited text with attributions.  When called interactively, these two
 variables are ignored.
 See also the documentation for `gnus-article-highlight-citation'."
   (interactive (append (gnus-article-hidden-arg) '(force)))
-  (unless (gnus-article-check-hidden-text 'cite arg)
-    (save-excursion
-      (set-buffer gnus-article-buffer)
-      (gnus-cite-parse-maybe force)
-      (article-goto-body)
-      (let ((start (point))
-	    (atts gnus-cite-attribution-alist)
-	    (buffer-read-only nil)
-	    (inhibit-point-motion-hooks t)
-	    (hidden 0)
-	    total)
-	(goto-char (point-max))
-	(gnus-article-search-signature)
-	(setq total (count-lines start (point)))
-	(while atts
-	  (setq hidden (+ hidden (length (cdr (assoc (cdar atts)
-						     gnus-cite-prefix-alist))))
-		atts (cdr atts)))
-	(when (or force
-		  (and (> (* 100 hidden) (* gnus-cite-hide-percentage total))
-		       (> hidden gnus-cite-hide-absolute)))
-	  (setq atts gnus-cite-attribution-alist)
+  (with-current-buffer gnus-article-buffer
+    (gnus-delete-wash-type 'cite)
+    (unless (gnus-article-check-hidden-text 'cite arg)
+      (save-excursion
+	(gnus-cite-parse-maybe force)
+	(article-goto-body)
+	(let ((start (point))
+	      (atts gnus-cite-attribution-alist)
+	      (buffer-read-only nil)
+	      (inhibit-point-motion-hooks t)
+	      (hidden 0)
+	      total)
+	  (goto-char (point-max))
+	  (gnus-article-search-signature)
+	  (setq total (count-lines start (point)))
 	  (while atts
-	    (setq total (cdr (assoc (cdar atts) gnus-cite-prefix-alist))
-		  atts (cdr atts))
-	    (while total
-	      (setq hidden (car total)
-		    total (cdr total))
-	      (goto-char (point-min))
-	      (forward-line (1- hidden))
-	      (unless (assq hidden gnus-cite-attribution-alist)
-		(gnus-add-text-properties
-		 (point) (progn (forward-line 1) (point))
-		 (nconc (list 'article-type 'cite)
-			gnus-hidden-properties))))))))))
+	    (setq hidden (+ hidden (length (cdr (assoc (cdar atts)
+						       gnus-cite-prefix-alist))))
+		  atts (cdr atts)))
+	  (when (or force
+		    (and (> (* 100 hidden) (* gnus-cite-hide-percentage total))
+			 (> hidden gnus-cite-hide-absolute)))
+	    (gnus-add-wash-type 'cite)
+	    (setq atts gnus-cite-attribution-alist)
+	    (while atts
+	      (setq total (cdr (assoc (cdar atts) gnus-cite-prefix-alist))
+		    atts (cdr atts))
+	      (while total
+		(setq hidden (car total)
+		      total (cdr total))
+		(goto-char (point-min))
+		(forward-line (1- hidden))
+		(unless (assq hidden gnus-cite-attribution-alist)
+		  (gnus-add-text-properties
+		   (point) (progn (forward-line 1) (point))
+		   (nconc (list 'article-type 'cite)
+			  gnus-hidden-properties)))))))))
+    (gnus-set-mode-line 'article)))
 
 (defun gnus-article-hide-citation-in-followups ()
   "Hide cited text in non-root articles."
@@ -663,11 +698,13 @@ See also the documentation for `gnus-article-highlight-citation'."
 
 (defun gnus-cite-delete-overlays ()
   (dolist (overlay gnus-cite-overlay-list)
-    (when (or (not (gnus-overlay-end overlay))
-	      (and (>= (gnus-overlay-end overlay) (point-min))
-		   (<= (gnus-overlay-end overlay) (point-max))))
-      (setq gnus-cite-overlay-list (delete overlay gnus-cite-overlay-list))
-      (gnus-delete-overlay overlay))))
+    (ignore-errors
+      (when (or (not (gnus-overlay-end overlay))
+		(and (>= (gnus-overlay-end overlay) (point-min))
+		     (<= (gnus-overlay-end overlay) (point-max))))
+	(setq gnus-cite-overlay-list (delete overlay gnus-cite-overlay-list))
+	(ignore-errors
+	  (gnus-delete-overlay overlay))))))
 
 (defun gnus-cite-parse-wrapper ()
   ;; Wrap chopped gnus-cite-parse.
@@ -690,23 +727,33 @@ See also the documentation for `gnus-article-highlight-citation'."
 	       (goto-char (point-max))
 	       (gnus-article-search-signature)
 	       (point)))
-	alist entry start begin end numbers prefix)
+	(prefix-regexp (concat "^\\(" message-cite-prefix-regexp "\\)"))
+	alist entry start begin end numbers prefix guess-limit)
     ;; Get all potential prefixes in `alist'.
     (while (< (point) max)
       ;; Each line.
       (setq begin (point)
-	    end (progn (beginning-of-line 2) (point))
+	    guess-limit (progn (skip-chars-forward "^> \t\r\n") (point))
+	    end (gnus-point-at-bol 2)
 	    start end)
       (goto-char begin)
       ;; Ignore standard Supercite attribution prefix.
-      (when (looking-at gnus-supercite-regexp)
+      (when (and (< guess-limit (+ begin gnus-cite-max-prefix))
+		 (looking-at gnus-supercite-regexp))
 	(if (match-end 1)
 	    (setq end (1+ (match-end 1)))
 	  (setq end (1+ begin))))
       ;; Ignore very long prefixes.
-      (when (> end (+ (point) gnus-cite-max-prefix))
-	(setq end (+ (point) gnus-cite-max-prefix)))
-      (while (re-search-forward gnus-cite-prefix-regexp (1- end) t)
+      (when (> end (+ begin gnus-cite-max-prefix))
+	(setq end (+ begin gnus-cite-max-prefix)))
+      ;; Ignore quoted envelope From_.
+      (when (and gnus-cite-ignore-quoted-from
+		 (prog2
+		     (setq case-fold-search nil)
+		     (looking-at ">From ")
+		   (setq case-fold-search t)))
+	(setq end (1+ begin)))
+      (while (re-search-forward prefix-regexp (1- end) t)
 	;; Each prefix.
 	(setq end (match-end 0)
 	      prefix (buffer-substring begin end))
@@ -718,9 +765,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-cite-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))))))
@@ -960,14 +1017,20 @@ See also the documentation for `gnus-article-highlight-citation'."
 	(goto-char (point-min))
 	(forward-line (1- number))
 	(cond ((get-text-property (point) 'invisible)
+	       ;; Can't remove 'cite from g-a-wash-types here because
+	       ;; multiple citations may be hidden -jas
 	       (remove-text-properties (point) (progn (forward-line 1) (point))
 				       gnus-hidden-properties))
 	      ((assq number gnus-cite-attribution-alist))
 	      (t
+	       (gnus-add-wash-type 'cite)
 	       (gnus-add-text-properties
 		(point) (progn (forward-line 1) (point))
 		(nconc (list 'article-type 'cite)
-		       gnus-hidden-properties))))))))
+		       gnus-hidden-properties))))
+	(let ((gnus-article-mime-handle-alist-1
+	       gnus-article-mime-handle-alist))
+	  (gnus-set-mode-line 'article))))))
 
 (defun gnus-cite-find-prefix (line)
   ;; Return citation prefix for LINE.
@@ -990,6 +1053,17 @@ See also the documentation for `gnus-article-highlight-citation'."
     (while vars
       (make-local-variable (pop vars)))))
 
+(defun gnus-cited-line-p ()
+  "Say whether the current line is a cited line."
+  (save-excursion
+    (beginning-of-line)
+    (let ((found nil))
+      (dolist (prefix (mapcar 'car gnus-cite-prefix-alist))
+	(when (string= (buffer-substring (point) (+ (length prefix) (point)))
+		       prefix)
+	  (setq found t)))
+      found)))
+
 (gnus-ems-redefine)
 
 (provide 'gnus-cite)