X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-cite.el;h=648659921c5627f4239074dff9842389f2e3f70e;hb=348ca824b5116f395afc7d69321c3cedf60b0d3f;hp=31ee34acc86cae0ad7cafec504ace69ce61ab437;hpb=49d38b41c190eaab2cb34294fac7302a9c9ea353;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-cite.el b/lisp/gnus-cite.el index 31ee34a..6486599 100644 --- a/lisp/gnus-cite.el +++ b/lisp/gnus-cite.el @@ -1,7 +1,7 @@ ;;; 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 @@ -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 -;; 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: @@ -31,6 +31,7 @@ (require 'gnus) (require 'gnus-range) +(require 'gnus-art) (require 'message) ; for message-cite-prefix-regexp ;;; Customization: @@ -124,133 +125,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." + :version "22.1" :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) -(defcustom gnus-cite-attribution-face 'gnus-cite-attribution-face +(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 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) -(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 - '(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, @@ -276,8 +321,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. -(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 @@ -329,7 +373,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 -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. @@ -373,7 +417,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)) @@ -619,41 +663,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." @@ -718,13 +765,13 @@ See also the documentation for `gnus-article-highlight-citation'." (gnus-article-search-signature) (point))) (prefix-regexp (concat "^\\(" message-cite-prefix-regexp "\\)")) - alist entry start begin end numbers prefix guess-limit mc-flag) + alist entry start begin end numbers prefix guess-limit) ;; Get all potential prefixes in `alist'. (while (< (point) max) ;; 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. @@ -736,11 +783,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))) @@ -822,11 +876,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 @@ -975,12 +1028,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) @@ -989,6 +1037,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)