1 |
;;; gnus-cite.el --- parse citations in articles for Gnus -*- coding: iso-latin-1 -*- |
;;; gnus-cite.el --- parse citations in articles for Gnus |
2 |
|
|
3 |
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 |
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 |
4 |
;; Free Software Foundation, Inc. |
;; Free Software Foundation, Inc. |
5 |
|
|
6 |
;; Author: Per Abhiddenware |
;; Author: Per Abhiddenware |
29 |
(eval-when-compile (require 'cl)) |
(eval-when-compile (require 'cl)) |
30 |
|
|
31 |
(require 'gnus) |
(require 'gnus) |
|
(require 'gnus-art) |
|
32 |
(require 'gnus-range) |
(require 'gnus-range) |
33 |
|
(require 'gnus-art) |
34 |
|
(require 'message) ; for message-cite-prefix-regexp |
35 |
|
|
36 |
;;; Customization: |
;;; Customization: |
37 |
|
|
41 |
:link '(custom-manual "(gnus)Article Highlighting") |
:link '(custom-manual "(gnus)Article Highlighting") |
42 |
:group 'gnus-article) |
:group 'gnus-article) |
43 |
|
|
|
(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))) |
|
|
|
|
44 |
(defcustom gnus-cited-opened-text-button-line-format "%(%{[-]%}%)\n" |
(defcustom gnus-cited-opened-text-button-line-format "%(%{[-]%}%)\n" |
45 |
"Format of opened cited text buttons." |
"Format of opened cited text buttons." |
46 |
:group 'gnus-cite |
:group 'gnus-cite |
67 |
:type '(choice (const :tag "all" nil) |
:type '(choice (const :tag "all" nil) |
68 |
integer)) |
integer)) |
69 |
|
|
|
(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) |
|
|
|
|
70 |
(defcustom gnus-cite-max-prefix 20 |
(defcustom gnus-cite-max-prefix 20 |
71 |
"Maximum possible length for a citation prefix." |
"Maximum possible length for a citation prefix." |
72 |
:group 'gnus-cite |
:group 'gnus-cite |
73 |
:type 'integer) |
:type 'integer) |
74 |
|
|
75 |
(defcustom gnus-supercite-regexp |
(defcustom gnus-supercite-regexp |
76 |
(concat "^\\(" gnus-cite-prefix-regexp "\\)? *" |
(concat "^\\(" message-cite-prefix-regexp "\\)? *" |
77 |
">>>>> +\"\\([^\"\n]+\\)\" +==") |
">>>>> +\"\\([^\"\n]+\\)\" +==") |
78 |
"*Regexp matching normal Supercite attribution lines. |
"*Regexp matching normal Supercite attribution lines. |
79 |
The first grouping must match prefixes added by other packages." |
The first grouping must match prefixes added by other packages." |
91 |
:group 'gnus-cite |
:group 'gnus-cite |
92 |
:type 'integer) |
:type 'integer) |
93 |
|
|
94 |
|
;; Some Microsoft products put in a citation that extends to the |
95 |
|
;; remainder of the message: |
96 |
|
;; |
97 |
|
;; -----Original Message----- |
98 |
|
;; From: ... |
99 |
|
;; To: ... |
100 |
|
;; Sent: ... [date, in non-RFC-2822 format] |
101 |
|
;; Subject: ... |
102 |
|
;; |
103 |
|
;; Cited message, with no prefixes |
104 |
|
;; |
105 |
|
;; The four headers are always the same. But note they are prone to |
106 |
|
;; folding without additional indentation. |
107 |
|
;; |
108 |
|
;; Others use "----- Original Message -----" instead, and properly quote |
109 |
|
;; the body using "> ". This style is handled without special cases. |
110 |
|
|
111 |
(defcustom gnus-cite-attribution-prefix |
(defcustom gnus-cite-attribution-prefix |
112 |
"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 ?-----" |
113 |
"*Regexp matching the beginning of an attribution line." |
"*Regexp matching the beginning of an attribution line." |
114 |
:group 'gnus-cite |
:group 'gnus-cite |
115 |
:type 'regexp) |
:type 'regexp) |
116 |
|
|
117 |
(defcustom gnus-cite-attribution-suffix |
(defcustom gnus-cite-attribution-suffix |
118 |
"\\(\\(wrote\\|writes\\|said\\|says\\|>\\)\\(:\\|\\.\\.\\.\\)\\|-----Original Message-----\\)[ \t]*$" |
"\\(\\(wrote\\|writes\\|said\\|says\\|>\\)\\(:\\|\\.\\.\\.\\)\\|----- ?Original Message ?-----\\)[ \t]*$" |
119 |
"*Regexp matching the end of an attribution line. |
"*Regexp matching the end of an attribution line. |
120 |
The text matching the first grouping will be used as a button." |
The text matching the first grouping will be used as a button." |
121 |
:group 'gnus-cite |
:group 'gnus-cite |
122 |
:type 'regexp) |
:type 'regexp) |
123 |
|
|
124 |
|
(defcustom gnus-cite-unsightly-citation-regexp |
125 |
|
"^-----Original Message-----\nFrom: \\(.+\n\\)+\n" |
126 |
|
"Regexp matching Microsoft-type rest-of-message citations." |
127 |
|
:group 'gnus-cite |
128 |
|
:type 'regexp) |
129 |
|
|
130 |
|
(defcustom gnus-cite-ignore-quoted-from t |
131 |
|
"Non-nil means don't regard lines beginning with \">From \" as cited text. |
132 |
|
Those lines may have been quoted by MTAs in order not to mix up with |
133 |
|
the envelope From line." |
134 |
|
:group 'gnus-cite |
135 |
|
:type 'boolean) |
136 |
|
|
137 |
(defface gnus-cite-attribution-face '((t |
(defface gnus-cite-attribution-face '((t |
138 |
(:slant italic))) |
(:italic t))) |
139 |
"Face used for attribution lines.") |
"Face used for attribution lines.") |
140 |
|
|
141 |
(defcustom gnus-cite-attribution-face 'gnus-cite-attribution-face |
(defcustom gnus-cite-attribution-face 'gnus-cite-attribution-face |
151 |
(background light)) |
(background light)) |
152 |
(:foreground "MidnightBlue")) |
(:foreground "MidnightBlue")) |
153 |
(t |
(t |
154 |
(:slant italic))) |
(:italic t))) |
155 |
"Citation face.") |
"Citation face.") |
156 |
|
|
157 |
(defface gnus-cite-face-2 '((((class color) |
(defface gnus-cite-face-2 '((((class color) |
161 |
(background light)) |
(background light)) |
162 |
(:foreground "firebrick")) |
(:foreground "firebrick")) |
163 |
(t |
(t |
164 |
(:slant italic))) |
(:italic t))) |
165 |
"Citation face.") |
"Citation face.") |
166 |
|
|
167 |
(defface gnus-cite-face-3 '((((class color) |
(defface gnus-cite-face-3 '((((class color) |
171 |
(background light)) |
(background light)) |
172 |
(:foreground "dark green")) |
(:foreground "dark green")) |
173 |
(t |
(t |
174 |
(:slant italic))) |
(:italic t))) |
175 |
"Citation face.") |
"Citation face.") |
176 |
|
|
177 |
(defface gnus-cite-face-4 '((((class color) |
(defface gnus-cite-face-4 '((((class color) |
181 |
(background light)) |
(background light)) |
182 |
(:foreground "OrangeRed")) |
(:foreground "OrangeRed")) |
183 |
(t |
(t |
184 |
(:slant italic))) |
(:italic t))) |
185 |
"Citation face.") |
"Citation face.") |
186 |
|
|
187 |
(defface gnus-cite-face-5 '((((class color) |
(defface gnus-cite-face-5 '((((class color) |
191 |
(background light)) |
(background light)) |
192 |
(:foreground "dark khaki")) |
(:foreground "dark khaki")) |
193 |
(t |
(t |
194 |
(:slant italic))) |
(:italic t))) |
195 |
"Citation face.") |
"Citation face.") |
196 |
|
|
197 |
(defface gnus-cite-face-6 '((((class color) |
(defface gnus-cite-face-6 '((((class color) |
201 |
(background light)) |
(background light)) |
202 |
(:foreground "dark violet")) |
(:foreground "dark violet")) |
203 |
(t |
(t |
204 |
(:slant italic))) |
(:italic t))) |
205 |
"Citation face.") |
"Citation face.") |
206 |
|
|
207 |
(defface gnus-cite-face-7 '((((class color) |
(defface gnus-cite-face-7 '((((class color) |
211 |
(background light)) |
(background light)) |
212 |
(:foreground "SteelBlue4")) |
(:foreground "SteelBlue4")) |
213 |
(t |
(t |
214 |
(:slant italic))) |
(:italic t))) |
215 |
"Citation face.") |
"Citation face.") |
216 |
|
|
217 |
(defface gnus-cite-face-8 '((((class color) |
(defface gnus-cite-face-8 '((((class color) |
221 |
(background light)) |
(background light)) |
222 |
(:foreground "magenta")) |
(:foreground "magenta")) |
223 |
(t |
(t |
224 |
(:slant italic))) |
(:italic t))) |
225 |
"Citation face.") |
"Citation face.") |
226 |
|
|
227 |
(defface gnus-cite-face-9 '((((class color) |
(defface gnus-cite-face-9 '((((class color) |
231 |
(background light)) |
(background light)) |
232 |
(:foreground "violet")) |
(:foreground "violet")) |
233 |
(t |
(t |
234 |
(:slant italic))) |
(:italic t))) |
235 |
"Citation face.") |
"Citation face.") |
236 |
|
|
237 |
(defface gnus-cite-face-10 '((((class color) |
(defface gnus-cite-face-10 '((((class color) |
241 |
(background light)) |
(background light)) |
242 |
(:foreground "medium purple")) |
(:foreground "medium purple")) |
243 |
(t |
(t |
244 |
(:slant italic))) |
(:italic t))) |
245 |
"Citation face.") |
"Citation face.") |
246 |
|
|
247 |
(defface gnus-cite-face-11 '((((class color) |
(defface gnus-cite-face-11 '((((class color) |
251 |
(background light)) |
(background light)) |
252 |
(:foreground "turquoise")) |
(:foreground "turquoise")) |
253 |
(t |
(t |
254 |
(:slant italic))) |
(:italic t))) |
255 |
"Citation face.") |
"Citation face.") |
256 |
|
|
257 |
(defcustom gnus-cite-face-list |
(defcustom gnus-cite-face-list |
281 |
:group 'gnus-cite |
:group 'gnus-cite |
282 |
:type 'boolean) |
:type 'boolean) |
283 |
|
|
284 |
|
;; This has to go here because its default value depends on |
285 |
|
;; gnus-cite-face-list. |
286 |
|
(defcustom gnus-article-boring-faces (cons 'gnus-signature-face |
287 |
|
gnus-cite-face-list) |
288 |
|
"List of faces that are not worth reading. |
289 |
|
If an article has more pages below the one you are looking at, but |
290 |
|
nothing on those pages is a word of at least three letters that is not |
291 |
|
in a boring face, then the pages will be skipped." |
292 |
|
:type '(repeat face) |
293 |
|
:group 'gnus-article-hiding) |
294 |
|
|
295 |
;;; Internal Variables: |
;;; Internal Variables: |
296 |
|
|
297 |
(defvar gnus-cite-article nil) |
(defvar gnus-cite-article nil) |
339 |
corresponding citation merged with `gnus-cite-attribution-face'. |
corresponding citation merged with `gnus-cite-attribution-face'. |
340 |
|
|
341 |
Text is considered cited if at least `gnus-cite-minimum-match-count' |
Text is considered cited if at least `gnus-cite-minimum-match-count' |
342 |
lines matches `gnus-cite-prefix-regexp' with the same prefix. |
lines matches `message-cite-prefix-regexp' with the same prefix. |
343 |
|
|
344 |
Lines matching `gnus-cite-attribution-suffix' and perhaps |
Lines matching `gnus-cite-attribution-suffix' and perhaps |
345 |
`gnus-cite-attribution-prefix' are considered attribution lines." |
`gnus-cite-attribution-prefix' are considered attribution lines." |
380 |
(goto-char (point-min)) |
(goto-char (point-min)) |
381 |
(forward-line (1- number)) |
(forward-line (1- number)) |
382 |
(when (re-search-forward gnus-cite-attribution-suffix |
(when (re-search-forward gnus-cite-attribution-suffix |
383 |
(save-excursion (end-of-line 1) (point)) |
(gnus-point-at-eol) |
384 |
t) |
t) |
385 |
(gnus-article-add-button (match-beginning 1) (match-end 1) |
(gnus-article-add-button (match-beginning 1) (match-end 1) |
386 |
'gnus-cite-toggle prefix)) |
'gnus-cite-toggle prefix)) |
472 |
(narrow-to-region (caar marks) (caadr marks)) |
(narrow-to-region (caar marks) (caadr marks)) |
473 |
(let ((adaptive-fill-regexp |
(let ((adaptive-fill-regexp |
474 |
(concat "^" (regexp-quote (cdar marks)) " *")) |
(concat "^" (regexp-quote (cdar marks)) " *")) |
475 |
(fill-prefix (cdar marks))) |
(fill-prefix |
476 |
|
(if (string= (cdar marks) "") "" |
477 |
|
(concat (cdar marks) " "))) |
478 |
|
use-hard-newlines) |
479 |
(fill-region (point-min) (point-max))) |
(fill-region (point-min) (point-max))) |
480 |
(set-marker (caar marks) nil) |
(set-marker (caar marks) nil) |
481 |
(setq marks (cdr marks))) |
(setq marks (cdr marks))) |
544 |
(setq beg nil) |
(setq beg nil) |
545 |
(setq end (point-marker)))))) |
(setq end (point-marker)))))) |
546 |
(when (and beg end) |
(when (and beg end) |
547 |
|
(gnus-add-wash-type 'cite) |
548 |
;; We use markers for the end-points to facilitate later |
;; We use markers for the end-points to facilitate later |
549 |
;; wrapping and mangling of text. |
;; wrapping and mangling of text. |
550 |
(setq beg (set-marker (make-marker) beg) |
(setq beg (set-marker (make-marker) beg) |
584 |
(and (> arg 0) (not hidden)) |
(and (> arg 0) (not hidden)) |
585 |
(and (< arg 0) hidden)) |
(and (< arg 0) hidden)) |
586 |
(if hidden |
(if hidden |
587 |
(gnus-remove-text-properties-when |
(progn |
588 |
'article-type 'cite beg end |
;; Can't remove 'cite from g-a-wash-types here because |
589 |
(cons 'article-type (cons 'cite |
;; multiple citations may be hidden -jas |
590 |
gnus-hidden-properties))) |
(gnus-remove-text-properties-when |
591 |
|
'article-type 'cite beg end |
592 |
|
(cons 'article-type (cons 'cite |
593 |
|
gnus-hidden-properties)))) |
594 |
|
(gnus-add-wash-type 'cite) |
595 |
(gnus-add-text-properties-when |
(gnus-add-text-properties-when |
596 |
'article-type nil beg end |
'article-type nil beg end |
597 |
(cons 'article-type (cons 'cite |
(cons 'article-type (cons 'cite |
598 |
gnus-hidden-properties)))) |
gnus-hidden-properties)))) |
599 |
|
(let ((gnus-article-mime-handle-alist-1 gnus-article-mime-handle-alist)) |
600 |
|
(gnus-set-mode-line 'article)) |
601 |
(save-excursion |
(save-excursion |
602 |
(goto-char start) |
(goto-char start) |
603 |
(gnus-delete-line) |
(gnus-delete-line) |
626 |
variables are ignored. |
variables are ignored. |
627 |
See also the documentation for `gnus-article-highlight-citation'." |
See also the documentation for `gnus-article-highlight-citation'." |
628 |
(interactive (append (gnus-article-hidden-arg) '(force))) |
(interactive (append (gnus-article-hidden-arg) '(force))) |
629 |
(unless (gnus-article-check-hidden-text 'cite arg) |
(with-current-buffer gnus-article-buffer |
630 |
(save-excursion |
(gnus-delete-wash-type 'cite) |
631 |
(set-buffer gnus-article-buffer) |
(unless (gnus-article-check-hidden-text 'cite arg) |
632 |
(gnus-cite-parse-maybe force) |
(save-excursion |
633 |
(article-goto-body) |
(gnus-cite-parse-maybe force) |
634 |
(let ((start (point)) |
(article-goto-body) |
635 |
(atts gnus-cite-attribution-alist) |
(let ((start (point)) |
636 |
(buffer-read-only nil) |
(atts gnus-cite-attribution-alist) |
637 |
(inhibit-point-motion-hooks t) |
(buffer-read-only nil) |
638 |
(hidden 0) |
(inhibit-point-motion-hooks t) |
639 |
total) |
(hidden 0) |
640 |
(goto-char (point-max)) |
total) |
641 |
(gnus-article-search-signature) |
(goto-char (point-max)) |
642 |
(setq total (count-lines start (point))) |
(gnus-article-search-signature) |
643 |
(while atts |
(setq total (count-lines start (point))) |
|
(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) |
|
644 |
(while atts |
(while atts |
645 |
(setq total (cdr (assoc (cdar atts) gnus-cite-prefix-alist)) |
(setq hidden (+ hidden (length (cdr (assoc (cdar atts) |
646 |
atts (cdr atts)) |
gnus-cite-prefix-alist)))) |
647 |
(while total |
atts (cdr atts))) |
648 |
(setq hidden (car total) |
(when (or force |
649 |
total (cdr total)) |
(and (> (* 100 hidden) (* gnus-cite-hide-percentage total)) |
650 |
(goto-char (point-min)) |
(> hidden gnus-cite-hide-absolute))) |
651 |
(forward-line (1- hidden)) |
(gnus-add-wash-type 'cite) |
652 |
(unless (assq hidden gnus-cite-attribution-alist) |
(setq atts gnus-cite-attribution-alist) |
653 |
(gnus-add-text-properties |
(while atts |
654 |
(point) (progn (forward-line 1) (point)) |
(setq total (cdr (assoc (cdar atts) gnus-cite-prefix-alist)) |
655 |
(nconc (list 'article-type 'cite) |
atts (cdr atts)) |
656 |
gnus-hidden-properties)))))))))) |
(while total |
657 |
|
(setq hidden (car total) |
658 |
|
total (cdr total)) |
659 |
|
(goto-char (point-min)) |
660 |
|
(forward-line (1- hidden)) |
661 |
|
(unless (assq hidden gnus-cite-attribution-alist) |
662 |
|
(gnus-add-text-properties |
663 |
|
(point) (progn (forward-line 1) (point)) |
664 |
|
(nconc (list 'article-type 'cite) |
665 |
|
gnus-hidden-properties))))))))) |
666 |
|
(gnus-set-mode-line 'article))) |
667 |
|
|
668 |
(defun gnus-article-hide-citation-in-followups () |
(defun gnus-article-hide-citation-in-followups () |
669 |
"Hide cited text in non-root articles." |
"Hide cited text in non-root articles." |
698 |
|
|
699 |
(defun gnus-cite-delete-overlays () |
(defun gnus-cite-delete-overlays () |
700 |
(dolist (overlay gnus-cite-overlay-list) |
(dolist (overlay gnus-cite-overlay-list) |
701 |
(when (or (not (gnus-overlay-end overlay)) |
(ignore-errors |
702 |
(and (>= (gnus-overlay-end overlay) (point-min)) |
(when (or (not (gnus-overlay-end overlay)) |
703 |
(<= (gnus-overlay-end overlay) (point-max)))) |
(and (>= (gnus-overlay-end overlay) (point-min)) |
704 |
(setq gnus-cite-overlay-list (delete overlay gnus-cite-overlay-list)) |
(<= (gnus-overlay-end overlay) (point-max)))) |
705 |
(gnus-delete-overlay overlay)))) |
(setq gnus-cite-overlay-list (delete overlay gnus-cite-overlay-list)) |
706 |
|
(ignore-errors |
707 |
|
(gnus-delete-overlay overlay)))))) |
708 |
|
|
709 |
(defun gnus-cite-parse-wrapper () |
(defun gnus-cite-parse-wrapper () |
710 |
;; Wrap chopped gnus-cite-parse. |
;; Wrap chopped gnus-cite-parse. |
727 |
(goto-char (point-max)) |
(goto-char (point-max)) |
728 |
(gnus-article-search-signature) |
(gnus-article-search-signature) |
729 |
(point))) |
(point))) |
730 |
alist entry start begin end numbers prefix) |
(prefix-regexp (concat "^\\(" message-cite-prefix-regexp "\\)")) |
731 |
|
alist entry start begin end numbers prefix guess-limit) |
732 |
;; Get all potential prefixes in `alist'. |
;; Get all potential prefixes in `alist'. |
733 |
(while (< (point) max) |
(while (< (point) max) |
734 |
;; Each line. |
;; Each line. |
735 |
(setq begin (point) |
(setq begin (point) |
736 |
end (progn (beginning-of-line 2) (point)) |
guess-limit (progn (skip-chars-forward "^> \t\r\n") (point)) |
737 |
|
end (gnus-point-at-bol 2) |
738 |
start end) |
start end) |
739 |
(goto-char begin) |
(goto-char begin) |
740 |
;; Ignore standard Supercite attribution prefix. |
;; Ignore standard Supercite attribution prefix. |
741 |
(when (looking-at gnus-supercite-regexp) |
(when (and (< guess-limit (+ begin gnus-cite-max-prefix)) |
742 |
|
(looking-at gnus-supercite-regexp)) |
743 |
(if (match-end 1) |
(if (match-end 1) |
744 |
(setq end (1+ (match-end 1))) |
(setq end (1+ (match-end 1))) |
745 |
(setq end (1+ begin)))) |
(setq end (1+ begin)))) |
746 |
;; Ignore very long prefixes. |
;; Ignore very long prefixes. |
747 |
(when (> end (+ (point) gnus-cite-max-prefix)) |
(when (> end (+ begin gnus-cite-max-prefix)) |
748 |
(setq end (+ (point) gnus-cite-max-prefix))) |
(setq end (+ begin gnus-cite-max-prefix))) |
749 |
(while (re-search-forward gnus-cite-prefix-regexp (1- end) t) |
;; Ignore quoted envelope From_. |
750 |
|
(when (and gnus-cite-ignore-quoted-from |
751 |
|
(prog2 |
752 |
|
(setq case-fold-search nil) |
753 |
|
(looking-at ">From ") |
754 |
|
(setq case-fold-search t))) |
755 |
|
(setq end (1+ begin))) |
756 |
|
(while (re-search-forward prefix-regexp (1- end) t) |
757 |
;; Each prefix. |
;; Each prefix. |
758 |
(setq end (match-end 0) |
(setq end (match-end 0) |
759 |
prefix (buffer-substring begin end)) |
prefix (buffer-substring begin end)) |
765 |
(goto-char begin)) |
(goto-char begin)) |
766 |
(goto-char start) |
(goto-char start) |
767 |
(setq line (1+ line))) |
(setq line (1+ line))) |
768 |
|
;; Horrible special case for some Microsoft mailers. |
769 |
|
(goto-char (point-min)) |
770 |
|
(when (re-search-forward gnus-cite-unsightly-citation-regexp max t) |
771 |
|
(setq begin (count-lines (point-min) (point))) |
772 |
|
(setq end (count-lines (point-min) max)) |
773 |
|
(setq entry nil) |
774 |
|
(while (< begin end) |
775 |
|
(push begin entry) |
776 |
|
(setq begin (1+ begin))) |
777 |
|
(push (cons "" entry) alist)) |
778 |
;; We got all the potential prefixes. Now create |
;; We got all the potential prefixes. Now create |
779 |
;; `gnus-cite-prefix-alist' containing the oldest prefix for each |
;; `gnus-cite-prefix-alist' containing the oldest prefix for each |
780 |
;; line that appears at least gnus-cite-minimum-match-count |
;; line that appears at least `gnus-cite-minimum-match-count' |
781 |
;; times. First sort them by length. Longer is older. |
;; times. First sort them by length. Longer is older. |
782 |
(setq alist (sort alist (lambda (a b) |
(setq alist (sort alist (lambda (a b) |
783 |
(> (length (car a)) (length (car b)))))) |
(> (length (car a)) (length (car b)))))) |
1017 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1018 |
(forward-line (1- number)) |
(forward-line (1- number)) |
1019 |
(cond ((get-text-property (point) 'invisible) |
(cond ((get-text-property (point) 'invisible) |
1020 |
|
;; Can't remove 'cite from g-a-wash-types here because |
1021 |
|
;; multiple citations may be hidden -jas |
1022 |
(remove-text-properties (point) (progn (forward-line 1) (point)) |
(remove-text-properties (point) (progn (forward-line 1) (point)) |
1023 |
gnus-hidden-properties)) |
gnus-hidden-properties)) |
1024 |
((assq number gnus-cite-attribution-alist)) |
((assq number gnus-cite-attribution-alist)) |
1025 |
(t |
(t |
1026 |
|
(gnus-add-wash-type 'cite) |
1027 |
(gnus-add-text-properties |
(gnus-add-text-properties |
1028 |
(point) (progn (forward-line 1) (point)) |
(point) (progn (forward-line 1) (point)) |
1029 |
(nconc (list 'article-type 'cite) |
(nconc (list 'article-type 'cite) |
1030 |
gnus-hidden-properties)))))))) |
gnus-hidden-properties)))) |
1031 |
|
(let ((gnus-article-mime-handle-alist-1 |
1032 |
|
gnus-article-mime-handle-alist)) |
1033 |
|
(gnus-set-mode-line 'article)))))) |
1034 |
|
|
1035 |
(defun gnus-cite-find-prefix (line) |
(defun gnus-cite-find-prefix (line) |
1036 |
;; Return citation prefix for LINE. |
;; Return citation prefix for LINE. |
1053 |
(while vars |
(while vars |
1054 |
(make-local-variable (pop vars))))) |
(make-local-variable (pop vars))))) |
1055 |
|
|
1056 |
|
(defun gnus-cited-line-p () |
1057 |
|
"Say whether the current line is a cited line." |
1058 |
|
(save-excursion |
1059 |
|
(beginning-of-line) |
1060 |
|
(let ((found nil)) |
1061 |
|
(dolist (prefix (mapcar 'car gnus-cite-prefix-alist)) |
1062 |
|
(when (string= (buffer-substring (point) (+ (length prefix) (point))) |
1063 |
|
prefix) |
1064 |
|
(setq found t))) |
1065 |
|
found))) |
1066 |
|
|
1067 |
(gnus-ems-redefine) |
(gnus-ems-redefine) |
1068 |
|
|
1069 |
(provide 'gnus-cite) |
(provide 'gnus-cite) |