[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/gnus/gnus-cite.el [emacs-unicode-2]
From: |
Miles Bader |
Subject: |
[Emacs-diffs] Changes to emacs/lisp/gnus/gnus-cite.el [emacs-unicode-2] |
Date: |
Thu, 09 Sep 2004 17:41:11 -0400 |
Index: emacs/lisp/gnus/gnus-cite.el
diff -c emacs/lisp/gnus/gnus-cite.el:1.10.6.1
emacs/lisp/gnus/gnus-cite.el:1.10.6.2
*** emacs/lisp/gnus/gnus-cite.el:1.10.6.1 Fri Mar 12 00:02:56 2004
--- emacs/lisp/gnus/gnus-cite.el Thu Sep 9 09:36:25 2004
***************
*** 1,6 ****
! ;;; gnus-cite.el --- parse citations in articles for Gnus -*- coding:
iso-latin-1 -*-
! ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
;; Free Software Foundation, Inc.
;; Author: Per Abhiddenware
--- 1,6 ----
! ;;; gnus-cite.el --- parse citations in articles for Gnus
! ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
;; Free Software Foundation, Inc.
;; Author: Per Abhiddenware
***************
*** 29,36 ****
(eval-when-compile (require 'cl))
(require 'gnus)
- (require 'gnus-art)
(require 'gnus-range)
;;; Customization:
--- 29,37 ----
(eval-when-compile (require 'cl))
(require 'gnus)
(require 'gnus-range)
+ (require 'gnus-art)
+ (require 'message) ; for message-cite-prefix-regexp
;;; Customization:
***************
*** 40,58 ****
: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
--- 41,46 ----
***************
*** 79,98 ****
: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 "\\)? *"
">>>>> +\"\\([^\"\n]+\\)\" +==")
"*Regexp matching normal Supercite attribution lines.
The first grouping must match prefixes added by other packages."
--- 67,79 ----
:type '(choice (const :tag "all" nil)
integer))
(defcustom gnus-cite-max-prefix 20
"Maximum possible length for a citation prefix."
:group 'gnus-cite
:type 'integer)
(defcustom gnus-supercite-regexp
! (concat "^\\(" message-cite-prefix-regexp "\\)? *"
">>>>> +\"\\([^\"\n]+\\)\" +==")
"*Regexp matching normal Supercite attribution lines.
The first grouping must match prefixes added by other packages."
***************
*** 110,130 ****
:group 'gnus-cite
:type 'integer)
(defcustom gnus-cite-attribution-prefix
! "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]*$"
"*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)
(defface gnus-cite-attribution-face '((t
! (:slant italic)))
"Face used for attribution lines.")
(defcustom gnus-cite-attribution-face 'gnus-cite-attribution-face
--- 91,141 ----
: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 ?-----"
"*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]*$"
"*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
! (:italic t)))
"Face used for attribution lines.")
(defcustom gnus-cite-attribution-face 'gnus-cite-attribution-face
***************
*** 140,146 ****
(background light))
(:foreground "MidnightBlue"))
(t
! (:slant italic)))
"Citation face.")
(defface gnus-cite-face-2 '((((class color)
--- 151,157 ----
(background light))
(:foreground "MidnightBlue"))
(t
! (:italic t)))
"Citation face.")
(defface gnus-cite-face-2 '((((class color)
***************
*** 150,156 ****
(background light))
(:foreground "firebrick"))
(t
! (:slant italic)))
"Citation face.")
(defface gnus-cite-face-3 '((((class color)
--- 161,167 ----
(background light))
(:foreground "firebrick"))
(t
! (:italic t)))
"Citation face.")
(defface gnus-cite-face-3 '((((class color)
***************
*** 160,166 ****
(background light))
(:foreground "dark green"))
(t
! (:slant italic)))
"Citation face.")
(defface gnus-cite-face-4 '((((class color)
--- 171,177 ----
(background light))
(:foreground "dark green"))
(t
! (:italic t)))
"Citation face.")
(defface gnus-cite-face-4 '((((class color)
***************
*** 170,176 ****
(background light))
(:foreground "OrangeRed"))
(t
! (:slant italic)))
"Citation face.")
(defface gnus-cite-face-5 '((((class color)
--- 181,187 ----
(background light))
(:foreground "OrangeRed"))
(t
! (:italic t)))
"Citation face.")
(defface gnus-cite-face-5 '((((class color)
***************
*** 180,186 ****
(background light))
(:foreground "dark khaki"))
(t
! (:slant italic)))
"Citation face.")
(defface gnus-cite-face-6 '((((class color)
--- 191,197 ----
(background light))
(:foreground "dark khaki"))
(t
! (:italic t)))
"Citation face.")
(defface gnus-cite-face-6 '((((class color)
***************
*** 190,196 ****
(background light))
(:foreground "dark violet"))
(t
! (:slant italic)))
"Citation face.")
(defface gnus-cite-face-7 '((((class color)
--- 201,207 ----
(background light))
(:foreground "dark violet"))
(t
! (:italic t)))
"Citation face.")
(defface gnus-cite-face-7 '((((class color)
***************
*** 200,206 ****
(background light))
(:foreground "SteelBlue4"))
(t
! (:slant italic)))
"Citation face.")
(defface gnus-cite-face-8 '((((class color)
--- 211,217 ----
(background light))
(:foreground "SteelBlue4"))
(t
! (:italic t)))
"Citation face.")
(defface gnus-cite-face-8 '((((class color)
***************
*** 210,216 ****
(background light))
(:foreground "magenta"))
(t
! (:slant italic)))
"Citation face.")
(defface gnus-cite-face-9 '((((class color)
--- 221,227 ----
(background light))
(:foreground "magenta"))
(t
! (:italic t)))
"Citation face.")
(defface gnus-cite-face-9 '((((class color)
***************
*** 220,226 ****
(background light))
(:foreground "violet"))
(t
! (:slant italic)))
"Citation face.")
(defface gnus-cite-face-10 '((((class color)
--- 231,237 ----
(background light))
(:foreground "violet"))
(t
! (:italic t)))
"Citation face.")
(defface gnus-cite-face-10 '((((class color)
***************
*** 230,236 ****
(background light))
(:foreground "medium purple"))
(t
! (:slant italic)))
"Citation face.")
(defface gnus-cite-face-11 '((((class color)
--- 241,247 ----
(background light))
(:foreground "medium purple"))
(t
! (:italic t)))
"Citation face.")
(defface gnus-cite-face-11 '((((class color)
***************
*** 240,246 ****
(background light))
(:foreground "turquoise"))
(t
! (:slant italic)))
"Citation face.")
(defcustom gnus-cite-face-list
--- 251,257 ----
(background light))
(:foreground "turquoise"))
(t
! (:italic t)))
"Citation face.")
(defcustom gnus-cite-face-list
***************
*** 270,275 ****
--- 281,297 ----
: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,323 ****
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 matching `gnus-cite-attribution-suffix' and perhaps
`gnus-cite-attribution-prefix' are considered attribution lines."
--- 339,345 ----
corresponding citation merged with `gnus-cite-attribution-face'.
Text is considered cited if at least `gnus-cite-minimum-match-count'
! 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,364 ****
(goto-char (point-min))
(forward-line (1- number))
(when (re-search-forward gnus-cite-attribution-suffix
! (save-excursion (end-of-line 1) (point))
t)
(gnus-article-add-button (match-beginning 1) (match-end 1)
'gnus-cite-toggle prefix))
--- 380,386 ----
(goto-char (point-min))
(forward-line (1- number))
(when (re-search-forward gnus-cite-attribution-suffix
! (gnus-point-at-eol)
t)
(gnus-article-add-button (match-beginning 1) (match-end 1)
'gnus-cite-toggle prefix))
***************
*** 450,456 ****
(narrow-to-region (caar marks) (caadr marks))
(let ((adaptive-fill-regexp
(concat "^" (regexp-quote (cdar marks)) " *"))
! (fill-prefix (cdar marks)))
(fill-region (point-min) (point-max)))
(set-marker (caar marks) nil)
(setq marks (cdr marks)))
--- 472,481 ----
(narrow-to-region (caar marks) (caadr marks))
(let ((adaptive-fill-regexp
(concat "^" (regexp-quote (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,524 ****
--- 544,550 ----
(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,571 ****
(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)))
(gnus-add-text-properties-when
'article-type nil beg end
(cons 'article-type (cons 'cite
gnus-hidden-properties))))
(save-excursion
(goto-char start)
(gnus-delete-line)
--- 584,603 ----
(and (> arg 0) (not hidden))
(and (< arg 0) hidden))
(if hidden
! (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,634 ****
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)
(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))))))))))
(defun gnus-article-hide-citation-in-followups ()
"Hide cited text in non-root articles."
--- 626,669 ----
variables are ignored.
See also the documentation for `gnus-article-highlight-citation'."
(interactive (append (gnus-article-hidden-arg) '(force)))
! (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 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,673 ****
(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))))
(defun gnus-cite-parse-wrapper ()
;; Wrap chopped gnus-cite-parse.
--- 698,710 ----
(defun gnus-cite-delete-overlays ()
(dolist (overlay gnus-cite-overlay-list)
! (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,712 ****
(goto-char (point-max))
(gnus-article-search-signature)
(point)))
! alist entry start begin end numbers prefix)
;; Get all potential prefixes in `alist'.
(while (< (point) max)
;; Each line.
(setq begin (point)
! end (progn (beginning-of-line 2) (point))
start end)
(goto-char begin)
;; Ignore standard Supercite attribution prefix.
! (when (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)
;; Each prefix.
(setq end (match-end 0)
prefix (buffer-substring begin end))
--- 727,759 ----
(goto-char (point-max))
(gnus-article-search-signature)
(point)))
! (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)
! 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 (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 (+ 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,726 ****
(goto-char begin))
(goto-char start)
(setq line (1+ line)))
;; 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
;; times. First sort them by length. Longer is older.
(setq alist (sort alist (lambda (a b)
(> (length (car a)) (length (car b))))))
--- 765,783 ----
(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'
;; times. First sort them by length. Longer is older.
(setq alist (sort alist (lambda (a b)
(> (length (car a)) (length (car b))))))
***************
*** 960,973 ****
(goto-char (point-min))
(forward-line (1- number))
(cond ((get-text-property (point) 'invisible)
(remove-text-properties (point) (progn (forward-line 1) (point))
gnus-hidden-properties))
((assq number gnus-cite-attribution-alist))
(t
(gnus-add-text-properties
(point) (progn (forward-line 1) (point))
(nconc (list 'article-type 'cite)
! gnus-hidden-properties))))))))
(defun gnus-cite-find-prefix (line)
;; Return citation prefix for LINE.
--- 1017,1036 ----
(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))))
! (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,995 ****
--- 1053,1069 ----
(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)
- [Emacs-diffs] Changes to emacs/lisp/gnus/gnus-cite.el [emacs-unicode-2],
Miles Bader <=