Import Oort Gnus v0.16.

[elisp/gnus.git-] / lisp / gnus-cite.el

diff --git a/lisp/gnus-cite.el b/lisp/gnus-cite.el
index f3e53a2..a119ac7 100644 (file)
--- a/lisp/gnus-cite.el
+++ b/lisp/gnus-cite.el
@@ -29,7 +29,6 @@
 (eval-when-compile (require 'cl))
 
 (require 'gnus)
-(require 'gnus-art)
 (require 'gnus-range)
 (require 'message)     ; for message-cite-prefix-regexp
 
@@ -91,19 +90,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-cite-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.")
@@ -251,6 +273,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)
@@ -339,7 +372,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))
@@ -690,7 +723,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 (progn (beginning-of-line 2) (point))
+           end (gnus-point-at-bol 2)
            start end)
       (goto-char begin)
       ;; Ignore standard Supercite attribution prefix.
@@ -714,9 +747,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))))))
@@ -992,6 +1035,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)