Synch to No Gnus 200506091113.
[elisp/gnus.git-] / lisp / gnus-cite.el
index 2028d78..3ab4ad5 100644 (file)
@@ -1,6 +1,7 @@
 ;;; gnus-cite.el --- parse citations in articles for Gnus
 
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;; 2005
 ;;        Free Software Foundation, Inc.
 
 ;; Author: Per Abhiddenware
@@ -125,16 +126,27 @@ The text matching the first grouping will be used as a button."
 (defcustom gnus-cite-unsightly-citation-regexp
   "^-----Original Message-----\nFrom: \\(.+\n\\)+\n"
   "Regexp matching Microsoft-type rest-of-message citations."
+  :version "22.1"
   :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."
+  :version "22.1"
+  :group 'gnus-cite
+  :type 'boolean)
+
 (defface gnus-cite-attribution-face '((t
                                       (:italic t)))
-  "Face used for attribution lines.")
+  "Face used for attribution lines."
+  :group 'gnus-cite)
 
 (defcustom gnus-cite-attribution-face 'gnus-cite-attribution-face
   "Face used for attribution lines.
 It is merged with the face for the cited text belonging to the attribution."
+  :version "22.1"
   :group 'gnus-cite
   :type 'face)
 
@@ -146,7 +158,8 @@ It is merged with the face for the cited text belonging to the attribution."
                             (:foreground "MidnightBlue"))
                            (t
                             (:italic t)))
-  "Citation face.")
+  "Citation face."
+  :group 'gnus-cite)
 
 (defface gnus-cite-face-2 '((((class color)
                              (background dark))
@@ -156,7 +169,8 @@ It is merged with the face for the cited text belonging to the attribution."
                             (:foreground "firebrick"))
                            (t
                             (:italic t)))
-  "Citation face.")
+  "Citation face."
+  :group 'gnus-cite)
 
 (defface gnus-cite-face-3 '((((class color)
                              (background dark))
@@ -166,7 +180,8 @@ It is merged with the face for the cited text belonging to the attribution."
                             (:foreground "dark green"))
                            (t
                             (:italic t)))
-  "Citation face.")
+  "Citation face."
+  :group 'gnus-cite)
 
 (defface gnus-cite-face-4 '((((class color)
                              (background dark))
@@ -176,7 +191,8 @@ It is merged with the face for the cited text belonging to the attribution."
                             (:foreground "OrangeRed"))
                            (t
                             (:italic t)))
-  "Citation face.")
+  "Citation face."
+  :group 'gnus-cite)
 
 (defface gnus-cite-face-5 '((((class color)
                              (background dark))
@@ -186,7 +202,8 @@ It is merged with the face for the cited text belonging to the attribution."
                             (:foreground "dark khaki"))
                            (t
                             (:italic t)))
-  "Citation face.")
+  "Citation face."
+  :group 'gnus-cite)
 
 (defface gnus-cite-face-6 '((((class color)
                              (background dark))
@@ -196,7 +213,8 @@ It is merged with the face for the cited text belonging to the attribution."
                             (:foreground "dark violet"))
                            (t
                             (:italic t)))
-  "Citation face.")
+  "Citation face."
+  :group 'gnus-cite)
 
 (defface gnus-cite-face-7 '((((class color)
                              (background dark))
@@ -206,7 +224,8 @@ It is merged with the face for the cited text belonging to the attribution."
                             (:foreground "SteelBlue4"))
                            (t
                             (:italic t)))
-  "Citation face.")
+  "Citation face."
+  :group 'gnus-cite)
 
 (defface gnus-cite-face-8 '((((class color)
                              (background dark))
@@ -216,7 +235,8 @@ It is merged with the face for the cited text belonging to the attribution."
                             (:foreground "magenta"))
                            (t
                             (:italic t)))
-  "Citation face.")
+  "Citation face."
+  :group 'gnus-cite)
 
 (defface gnus-cite-face-9 '((((class color)
                              (background dark))
@@ -226,7 +246,8 @@ It is merged with the face for the cited text belonging to the attribution."
                             (:foreground "violet"))
                            (t
                             (:italic t)))
-  "Citation face.")
+  "Citation face."
+  :group 'gnus-cite)
 
 (defface gnus-cite-face-10 '((((class color)
                               (background dark))
@@ -236,7 +257,8 @@ It is merged with the face for the cited text belonging to the attribution."
                              (:foreground "medium purple"))
                             (t
                              (:italic t)))
-  "Citation face.")
+  "Citation face."
+  :group 'gnus-cite)
 
 (defface gnus-cite-face-11 '((((class color)
                               (background dark))
@@ -246,7 +268,8 @@ It is merged with the face for the cited text belonging to the attribution."
                              (:foreground "turquoise"))
                             (t
                              (:italic t)))
-  "Citation face.")
+  "Citation face."
+  :group 'gnus-cite)
 
 (defcustom gnus-cite-face-list
   '(gnus-cite-face-1 gnus-cite-face-2 gnus-cite-face-3 gnus-cite-face-4
@@ -374,7 +397,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
-                                (gnus-point-at-eol)
+                                (point-at-eol)
                                 t)
          (gnus-article-add-button (match-beginning 1) (match-end 1)
                                   'gnus-cite-toggle prefix))
@@ -728,7 +751,7 @@ See also the documentation for `gnus-article-highlight-citation'."
       ;; Each line.
       (setq begin (point)
            guess-limit (progn (skip-chars-forward "^> \t\r\n") (point))
-           end (gnus-point-at-bol 2)
+           end (point-at-bol 2)
            start end)
       (goto-char begin)
       ;; Ignore standard Supercite attribution prefix.
@@ -740,11 +763,18 @@ See also the documentation for `gnus-article-highlight-citation'."
       ;; Ignore very long prefixes.
       (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))
-       (gnus-set-text-properties 0 (length prefix) nil prefix)
+       (set-text-properties 0 (length prefix) nil prefix)
        (setq entry (assoc prefix alist))
        (if entry
            (setcdr entry (cons line (cdr entry)))
@@ -826,11 +856,10 @@ See also the documentation for `gnus-article-highlight-citation'."
        (let ((al (buffer-substring (save-excursion (beginning-of-line 0)
                                                    (1+ (point)))
                                    end)))
-         (if (not (assoc al al-alist))
-             (progn
-               (push (list wrote in prefix tag)
-                     gnus-cite-loose-attribution-alist)
-               (push (cons al t) al-alist))))))))
+         (when (not (assoc al al-alist))
+           (push (list wrote in prefix tag)
+                 gnus-cite-loose-attribution-alist)
+           (push (cons al t) al-alist)))))))
 
 (defun gnus-cite-connect-attributions ()
   ;; Connect attributions to citations
@@ -979,12 +1008,7 @@ See also the documentation for `gnus-article-highlight-citation'."
          from to overlay)
       (goto-char (point-min))
       (when (zerop (forward-line (1- number)))
-       (static-if (or (featurep 'xemacs)
-                      (and (eq emacs-major-version 20)
-                           (>= emacs-minor-version 3))
-                      (>= emacs-major-version 21))
-           (forward-char (length prefix))
-         (move-to-column (string-width prefix)))
+       (forward-char (length prefix))
        (skip-chars-forward " \t")
        (setq from (point))
        (end-of-line 1)
@@ -993,6 +1017,7 @@ See also the documentation for `gnus-article-highlight-citation'."
        (when (< from to)
          (push (setq overlay (gnus-make-overlay from to))
                gnus-cite-overlay-list)
+         (gnus-overlay-put overlay 'evaporate t)
          (gnus-overlay-put overlay 'face face))))))
 
 (defun gnus-cite-toggle (prefix)