(gmm-tool-bar-from-list): Fix typos in doc string. Remove debug

[gnus] / lisp / gnus-cite.el

diff --git a/lisp/gnus-cite.el b/lisp/gnus-cite.el
index 9c1d57b..89fcbce 100644 (file)
--- a/lisp/gnus-cite.el
+++ b/lisp/gnus-cite.el
@@ -1,7 +1,7 @@
 ;;; gnus-cite.el --- parse citations in articles for Gnus
 
 ;;; gnus-cite.el --- parse citations in articles for Gnus
 

-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
-;;        Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
+;;   2004, 2005 Free Software Foundation, Inc.

 
 ;; Author: Per Abhiddenware
 
 
 ;; Author: Per Abhiddenware
 


@@ -19,8 +19,8 @@
 
 ;; 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
 
 ;; 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.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.

 
 ;;; Commentary:
 
 
 ;;; Commentary:
 


@@ -124,133 +124,177 @@ 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."
 (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)
 
   :group 'gnus-cite
   :type 'regexp)
 

-(defface gnus-cite-attribution-face '((t
-                                      (:italic t)))
-  "Face used for attribution lines.")
+(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 '((t (:italic t)))
+  "Face used for attribution lines."
+  :group 'gnus-cite)
+;; backward-compatibility alias
+(put 'gnus-cite-attribution-face 'face-alias 'gnus-cite-attribution)

 
 

-(defcustom gnus-cite-attribution-face 'gnus-cite-attribution-face
+(defcustom gnus-cite-attribution-face 'gnus-cite-attribution

   "Face used for attribution lines.
 It is merged with the face for the cited text belonging to the attribution."
   "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)
 
   :group 'gnus-cite
   :type 'face)
 

-(defface gnus-cite-face-1 '((((class color)
-                             (background dark))
-                            (:foreground "light blue"))
-                           (((class color)
-                             (background light))
-                            (:foreground "MidnightBlue"))
-                           (t
-                            (:italic t)))
-  "Citation face.")
-
-(defface gnus-cite-face-2 '((((class color)
-                             (background dark))
-                            (:foreground "light cyan"))
-                           (((class color)
-                             (background light))
-                            (:foreground "firebrick"))
-                           (t
-                            (:italic t)))
-  "Citation face.")
-
-(defface gnus-cite-face-3 '((((class color)
-                             (background dark))
-                            (:foreground "light yellow"))
-                           (((class color)
-                             (background light))
-                            (:foreground "dark green"))
-                           (t
-                            (:italic t)))
-  "Citation face.")
-
-(defface gnus-cite-face-4 '((((class color)
-                             (background dark))
-                            (:foreground "light pink"))
-                           (((class color)
-                             (background light))
-                            (:foreground "OrangeRed"))
-                           (t
-                            (:italic t)))
-  "Citation face.")
-
-(defface gnus-cite-face-5 '((((class color)
-                             (background dark))
-                            (:foreground "pale green"))
-                           (((class color)
-                             (background light))
-                            (:foreground "dark khaki"))
-                           (t
-                            (:italic t)))
-  "Citation face.")
-
-(defface gnus-cite-face-6 '((((class color)
-                             (background dark))
-                            (:foreground "beige"))
-                           (((class color)
-                             (background light))
-                            (:foreground "dark violet"))
-                           (t
-                            (:italic t)))
-  "Citation face.")
-
-(defface gnus-cite-face-7 '((((class color)
-                             (background dark))
-                            (:foreground "orange"))
-                           (((class color)
-                             (background light))
-                            (:foreground "SteelBlue4"))
-                           (t
-                            (:italic t)))
-  "Citation face.")
-
-(defface gnus-cite-face-8 '((((class color)
-                             (background dark))
-                            (:foreground "magenta"))
-                           (((class color)
-                             (background light))
-                            (:foreground "magenta"))
-                           (t
-                            (:italic t)))
-  "Citation face.")
-
-(defface gnus-cite-face-9 '((((class color)
-                             (background dark))
-                            (:foreground "violet"))
-                           (((class color)
-                             (background light))
-                            (:foreground "violet"))
-                           (t
-                            (:italic t)))
-  "Citation face.")
-
-(defface gnus-cite-face-10 '((((class color)
-                              (background dark))
-                             (:foreground "medium purple"))
-                            (((class color)
-                              (background light))
-                             (:foreground "medium purple"))
-                            (t
-                             (:italic t)))
-  "Citation face.")
-
-(defface gnus-cite-face-11 '((((class color)
-                              (background dark))
-                             (:foreground "turquoise"))
-                            (((class color)
-                              (background light))
-                             (:foreground "turquoise"))
-                            (t
-                             (:italic t)))
-  "Citation face.")
+(defface gnus-cite-1 '((((class color)
+                        (background dark))
+                       (:foreground "light blue"))
+                      (((class color)
+                        (background light))
+                       (:foreground "MidnightBlue"))
+                      (t
+                       (:italic t)))
+  "Citation face."
+  :group 'gnus-cite)
+;; backward-compatibility alias
+(put 'gnus-cite-face-1 'face-alias 'gnus-cite-1)
+
+(defface gnus-cite-2 '((((class color)
+                        (background dark))
+                       (:foreground "light cyan"))
+                      (((class color)
+                        (background light))
+                       (:foreground "firebrick"))
+                      (t
+                       (:italic t)))
+  "Citation face."
+  :group 'gnus-cite)
+;; backward-compatibility alias
+(put 'gnus-cite-face-2 'face-alias 'gnus-cite-2)
+
+(defface gnus-cite-3 '((((class color)
+                        (background dark))
+                       (:foreground "light yellow"))
+                      (((class color)
+                        (background light))
+                       (:foreground "dark green"))
+                      (t
+                       (:italic t)))
+  "Citation face."
+  :group 'gnus-cite)
+;; backward-compatibility alias
+(put 'gnus-cite-face-3 'face-alias 'gnus-cite-3)
+
+(defface gnus-cite-4 '((((class color)
+                        (background dark))
+                       (:foreground "light pink"))
+                      (((class color)
+                        (background light))
+                       (:foreground "OrangeRed"))
+                      (t
+                       (:italic t)))
+  "Citation face."
+  :group 'gnus-cite)
+;; backward-compatibility alias
+(put 'gnus-cite-face-4 'face-alias 'gnus-cite-4)
+
+(defface gnus-cite-5 '((((class color)
+                        (background dark))
+                       (:foreground "pale green"))
+                      (((class color)
+                        (background light))
+                       (:foreground "dark khaki"))
+                      (t
+                       (:italic t)))
+  "Citation face."
+  :group 'gnus-cite)
+;; backward-compatibility alias
+(put 'gnus-cite-face-5 'face-alias 'gnus-cite-5)
+
+(defface gnus-cite-6 '((((class color)
+                        (background dark))
+                       (:foreground "beige"))
+                      (((class color)
+                        (background light))
+                       (:foreground "dark violet"))
+                      (t
+                       (:italic t)))
+  "Citation face."
+  :group 'gnus-cite)
+;; backward-compatibility alias
+(put 'gnus-cite-face-6 'face-alias 'gnus-cite-6)
+
+(defface gnus-cite-7 '((((class color)
+                        (background dark))
+                       (:foreground "orange"))
+                      (((class color)
+                        (background light))
+                       (:foreground "SteelBlue4"))
+                      (t
+                       (:italic t)))
+  "Citation face."
+  :group 'gnus-cite)
+;; backward-compatibility alias
+(put 'gnus-cite-face-7 'face-alias 'gnus-cite-7)
+
+(defface gnus-cite-8 '((((class color)
+                        (background dark))
+                       (:foreground "magenta"))
+                      (((class color)
+                        (background light))
+                       (:foreground "magenta"))
+                      (t
+                       (:italic t)))
+  "Citation face."
+  :group 'gnus-cite)
+;; backward-compatibility alias
+(put 'gnus-cite-face-8 'face-alias 'gnus-cite-8)
+
+(defface gnus-cite-9 '((((class color)
+                        (background dark))
+                       (:foreground "violet"))
+                      (((class color)
+                        (background light))
+                       (:foreground "violet"))
+                      (t
+                       (:italic t)))
+  "Citation face."
+  :group 'gnus-cite)
+;; backward-compatibility alias
+(put 'gnus-cite-face-9 'face-alias 'gnus-cite-9)
+
+(defface gnus-cite-10 '((((class color)
+                         (background dark))
+                        (:foreground "medium purple"))
+                       (((class color)
+                         (background light))
+                        (:foreground "medium purple"))
+                       (t
+                        (:italic t)))
+  "Citation face."
+  :group 'gnus-cite)
+;; backward-compatibility alias
+(put 'gnus-cite-face-10 'face-alias 'gnus-cite-10)
+
+(defface gnus-cite-11 '((((class color)
+                         (background dark))
+                        (:foreground "turquoise"))
+                       (((class color)
+                         (background light))
+                        (:foreground "turquoise"))
+                       (t
+                        (:italic t)))
+  "Citation face."
+  :group 'gnus-cite)
+;; backward-compatibility alias
+(put 'gnus-cite-face-11 'face-alias 'gnus-cite-11)

 
 (defcustom gnus-cite-face-list
 
 (defcustom gnus-cite-face-list

-  '(gnus-cite-face-1 gnus-cite-face-2 gnus-cite-face-3 gnus-cite-face-4
-                    gnus-cite-face-5 gnus-cite-face-6 gnus-cite-face-7 gnus-cite-face-8
-                    gnus-cite-face-9 gnus-cite-face-10 gnus-cite-face-11)
+  '(gnus-cite-1 gnus-cite-2 gnus-cite-3 gnus-cite-4 gnus-cite-5 gnus-cite-6
+    gnus-cite-7 gnus-cite-8 gnus-cite-9 gnus-cite-10 gnus-cite-11)

   "*List of faces used for highlighting citations.
 
 When there are citations from multiple articles in the same message,
   "*List of faces used for highlighting citations.
 
 When there are citations from multiple articles in the same message,


@@ -276,8 +320,7 @@ This should make it easier to see who wrote what."
 
 ;; This has to go here because its default value depends on
 ;; gnus-cite-face-list.
 
 ;; 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)
+(defcustom gnus-article-boring-faces (cons 'gnus-signature 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
   "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


@@ -329,7 +372,7 @@ in a boring face, then the pages will be skipped."
 Each citation in the article will be highlighted with a different face.
 The faces are taken from `gnus-cite-face-list'.
 Attribution lines are highlighted with the same face as the
 Each citation in the article will be highlighted with a different face.
 The faces are taken from `gnus-cite-face-list'.
 Attribution lines are highlighted with the same face as the

-corresponding citation merged with `gnus-cite-attribution-face'.
+corresponding citation merged with the face `gnus-cite-attribution'.

 
 Text is considered cited if at least `gnus-cite-minimum-match-count'
 lines matches `message-cite-prefix-regexp' with the same prefix.
 
 Text is considered cited if at least `gnus-cite-minimum-match-count'
 lines matches `message-cite-prefix-regexp' with the same prefix.


@@ -739,6 +782,13 @@ 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 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)
       (while (re-search-forward prefix-regexp (1- end) t)
        ;; Each prefix.
        (setq end (match-end 0)


@@ -986,6 +1036,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)
        (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)
          (gnus-overlay-put overlay 'face face))))))
 
 (defun gnus-cite-toggle (prefix)