Commit | Line | Data |
---|---|---|
41487370 | 1 | ;;; gnus-cite.el --- parse citations in articles for Gnus |
b578f267 | 2 | |
41487370 LMI |
3 | ;; Copyright (C) 1995 Free Software Foundation, Inc. |
4 | ||
5 | ;; Author: Per Abrahamsen <abraham@iesd.auc.dk> | |
6 | ;; Keywords: news, mail | |
7 | ||
8 | ;; This file is part of GNU Emacs. | |
9 | ||
10 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 | ;; it under the terms of the GNU General Public License as published by | |
12 | ;; the Free Software Foundation; either version 2, or (at your option) | |
13 | ;; any later version. | |
14 | ||
15 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
b578f267 EN |
21 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
22 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
23 | ;; Boston, MA 02111-1307, USA. | |
41487370 LMI |
24 | |
25 | ;;; Commentary: | |
26 | ||
27 | ;;; Code: | |
28 | ||
29 | (require 'gnus) | |
30 | (require 'gnus-msg) | |
31 | (require 'gnus-ems) | |
32 | ||
33 | (eval-and-compile | |
34 | (autoload 'gnus-article-add-button "gnus-vis") | |
35 | ) | |
36 | ||
37 | ;;; Customization: | |
38 | ||
39 | (defvar gnus-cite-parse-max-size 25000 | |
40 | "Maximum article size (in bytes) where parsing citations is allowed. | |
41 | Set it to nil to parse all articles.") | |
42 | ||
43 | (defvar gnus-cite-prefix-regexp | |
44 | "^[]>|:}+ ]*[]>|:}+]\\(.*>\\)?\\|^.*>" | |
45 | "Regexp matching the longest possible citation prefix on a line.") | |
46 | ||
47 | (defvar gnus-cite-max-prefix 20 | |
48 | "Maximal possible length for a citation prefix.") | |
49 | ||
50 | (defvar gnus-supercite-regexp | |
51 | (concat "^\\(" gnus-cite-prefix-regexp "\\)? *" | |
52 | ">>>>> +\"\\([^\"\n]+\\)\" +==") | |
53 | "Regexp matching normal SuperCite attribution lines. | |
54 | The first regexp group should match a prefix added by another package.") | |
55 | ||
56 | (defvar gnus-supercite-secondary-regexp "^.*\"\\([^\"\n]+\\)\" +==" | |
57 | "Regexp matching mangled SuperCite attribution lines. | |
58 | The first regexp group should match the SuperCite attribution.") | |
59 | ||
60 | (defvar gnus-cite-minimum-match-count 2 | |
61 | "Minimal number of identical prefix'es before we believe it is a citation.") | |
62 | ||
63 | ;see gnus-cus.el | |
64 | ;(defvar gnus-cite-face-list | |
65 | ; (if (eq gnus-display-type 'color) | |
66 | ; (if (eq gnus-background-mode 'dark) 'light 'dark) | |
67 | ; '(italic)) | |
68 | ; "Faces used for displaying different citations. | |
69 | ;It is either a list of face names, or one of the following special | |
70 | ;values: | |
71 | ||
72 | ;dark: Create faces from `gnus-face-dark-name-list'. | |
73 | ;light: Create faces from `gnus-face-light-name-list'. | |
74 | ||
75 | ;The variable `gnus-make-foreground' determines whether the created | |
76 | ;faces change the foreground or the background colors.") | |
77 | ||
78 | (defvar gnus-cite-attribution-prefix "in article\\|in <" | |
79 | "Regexp matching the beginning of an attribution line.") | |
80 | ||
81 | (defvar gnus-cite-attribution-postfix | |
82 | "\\(wrote\\|writes\\|said\\|says\\):[ \t]*$" | |
83 | "Regexp matching the end of an attribution line. | |
84 | The text matching the first grouping will be used as a button.") | |
85 | ||
86 | ;see gnus-cus.el | |
87 | ;(defvar gnus-cite-attribution-face 'underline | |
88 | ; "Face used for attribution lines. | |
89 | ;It is merged with the face for the cited text belonging to the attribution.") | |
90 | ||
91 | ;see gnus-cus.el | |
92 | ;(defvar gnus-cite-hide-percentage 50 | |
93 | ; "Only hide cited text if it is larger than this percent of the body.") | |
94 | ||
95 | ;see gnus-cus.el | |
96 | ;(defvar gnus-cite-hide-absolute 10 | |
97 | ; "Only hide cited text if there is at least this number of cited lines.") | |
98 | ||
99 | ;see gnus-cus.el | |
100 | ;(defvar gnus-face-light-name-list | |
101 | ; '("light blue" "light cyan" "light yellow" "light pink" | |
102 | ; "pale green" "beige" "orange" "magenta" "violet" "medium purple" | |
103 | ; "turquoise") | |
104 | ; "Names of light colors.") | |
105 | ||
106 | ;see gnus-cus.el | |
107 | ;(defvar gnus-face-dark-name-list | |
108 | ; '("dark salmon" "firebrick" | |
109 | ; "dark green" "dark orange" "dark khaki" "dark violet" | |
110 | ; "dark turquoise") | |
111 | ; "Names of dark colors.") | |
112 | ||
113 | ;;; Internal Variables: | |
114 | ||
115 | (defvar gnus-article-length nil) | |
116 | ;; Length of article last time we parsed it. | |
117 | ;; BUG! KLUDGE! UGLY! FIX ME! | |
118 | ||
119 | (defvar gnus-cite-prefix-alist nil) | |
120 | ;; Alist of citation prefixes. | |
121 | ;; The cdr is a list of lines with that prefix. | |
122 | ||
123 | (defvar gnus-cite-attribution-alist nil) | |
124 | ;; Alist of attribution lines. | |
125 | ;; The car is a line number. | |
126 | ;; The cdr is the prefix for the citation started by that line. | |
127 | ||
128 | (defvar gnus-cite-loose-prefix-alist nil) | |
129 | ;; Alist of citation prefixes that have no matching attribution. | |
130 | ;; The cdr is a list of lines with that prefix. | |
131 | ||
132 | (defvar gnus-cite-loose-attribution-alist nil) | |
133 | ;; Alist of attribution lines that have no matching citation. | |
134 | ;; Each member has the form (WROTE IN PREFIX TAG), where | |
135 | ;; WROTE: is the attribution line number | |
136 | ;; IN: is the line number of the previous line if part of the same attribution, | |
137 | ;; PREFIX: Is the citation prefix of the attribution line(s), and | |
138 | ;; TAG: Is a SuperCite tag, if any. | |
139 | ||
140 | ;;; Commands: | |
141 | ||
142 | (defun gnus-article-highlight-citation (&optional force) | |
143 | "Highlight cited text. | |
144 | Each citation in the article will be highlighted with a different face. | |
145 | The faces are taken from `gnus-cite-face-list'. | |
146 | Attribution lines are highlighted with the same face as the | |
147 | corresponding citation merged with `gnus-cite-attribution-face'. | |
148 | ||
149 | Text is considered cited if at least `gnus-cite-minimum-match-count' | |
150 | lines matches `gnus-cite-prefix-regexp' with the same prefix. | |
151 | ||
152 | Lines matching `gnus-cite-attribution-postfix' and perhaps | |
153 | `gnus-cite-attribution-prefix' are considered attribution lines." | |
154 | (interactive (list 'force)) | |
155 | ;; Create dark or light faces if necessary. | |
156 | (cond ((eq gnus-cite-face-list 'light) | |
157 | (setq gnus-cite-face-list | |
158 | (mapcar 'gnus-make-face gnus-face-light-name-list))) | |
159 | ((eq gnus-cite-face-list 'dark) | |
160 | (setq gnus-cite-face-list | |
161 | (mapcar 'gnus-make-face gnus-face-dark-name-list)))) | |
162 | (save-excursion | |
163 | (set-buffer gnus-article-buffer) | |
164 | (gnus-cite-parse-maybe force) | |
165 | (let ((buffer-read-only nil) | |
166 | (alist gnus-cite-prefix-alist) | |
167 | (faces gnus-cite-face-list) | |
168 | (inhibit-point-motion-hooks t) | |
169 | face entry prefix skip numbers number face-alist) | |
170 | ;; Loop through citation prefixes. | |
171 | (while alist | |
172 | (setq entry (car alist) | |
173 | alist (cdr alist) | |
174 | prefix (car entry) | |
175 | numbers (cdr entry) | |
176 | face (car faces) | |
177 | faces (or (cdr faces) gnus-cite-face-list) | |
178 | face-alist (cons (cons prefix face) face-alist)) | |
179 | (while numbers | |
180 | (setq number (car numbers) | |
181 | numbers (cdr numbers)) | |
182 | (and (not (assq number gnus-cite-attribution-alist)) | |
183 | (not (assq number gnus-cite-loose-attribution-alist)) | |
184 | (gnus-cite-add-face number prefix face)))) | |
185 | ;; Loop through attribution lines. | |
186 | (setq alist gnus-cite-attribution-alist) | |
187 | (while alist | |
188 | (setq entry (car alist) | |
189 | alist (cdr alist) | |
190 | number (car entry) | |
191 | prefix (cdr entry) | |
192 | skip (gnus-cite-find-prefix number) | |
193 | face (cdr (assoc prefix face-alist))) | |
194 | ;; Add attribution button. | |
195 | (goto-line number) | |
196 | (if (re-search-forward gnus-cite-attribution-postfix | |
197 | (save-excursion (end-of-line 1) (point)) | |
198 | t) | |
199 | (gnus-article-add-button (match-beginning 1) (match-end 1) | |
200 | 'gnus-cite-toggle prefix)) | |
201 | ;; Highlight attribution line. | |
202 | (gnus-cite-add-face number skip face) | |
203 | (gnus-cite-add-face number skip gnus-cite-attribution-face)) | |
204 | ;; Loop through attribution lines. | |
205 | (setq alist gnus-cite-loose-attribution-alist) | |
206 | (while alist | |
207 | (setq entry (car alist) | |
208 | alist (cdr alist) | |
209 | number (car entry) | |
210 | skip (gnus-cite-find-prefix number)) | |
211 | (gnus-cite-add-face number skip gnus-cite-attribution-face))))) | |
212 | ||
213 | (defun gnus-article-hide-citation (&optional force) | |
214 | "Hide all cited text except attribution lines. | |
215 | See the documentation for `gnus-article-highlight-citation'." | |
216 | (interactive (list 'force)) | |
217 | (save-excursion | |
218 | (set-buffer gnus-article-buffer) | |
219 | (gnus-cite-parse-maybe force) | |
220 | (let ((buffer-read-only nil) | |
221 | (alist gnus-cite-prefix-alist) | |
222 | (inhibit-point-motion-hooks t) | |
223 | numbers number) | |
224 | (while alist | |
225 | (setq numbers (cdr (car alist)) | |
226 | alist (cdr alist)) | |
227 | (while numbers | |
228 | (setq number (car numbers) | |
229 | numbers (cdr numbers)) | |
230 | (goto-line number) | |
231 | (or (assq number gnus-cite-attribution-alist) | |
232 | (add-text-properties (point) (progn (forward-line 1) (point)) | |
233 | gnus-hidden-properties))))))) | |
234 | ||
235 | (defun gnus-article-hide-citation-maybe (&optional force) | |
236 | "Hide cited text that has an attribution line. | |
237 | This will do nothing unless at least `gnus-cite-hide-percentage' | |
238 | percent and at least `gnus-cite-hide-absolute' lines of the body is | |
239 | cited text with attributions. When called interactively, these two | |
240 | variables are ignored. | |
241 | See also the documentation for `gnus-article-highlight-citation'." | |
242 | (interactive (list 'force)) | |
243 | (save-excursion | |
244 | (set-buffer gnus-article-buffer) | |
245 | (gnus-cite-parse-maybe force) | |
246 | (goto-char (point-min)) | |
247 | (search-forward "\n\n" nil t) | |
248 | (let ((start (point)) | |
249 | (atts gnus-cite-attribution-alist) | |
250 | (buffer-read-only nil) | |
251 | (inhibit-point-motion-hooks t) | |
252 | (hiden 0) | |
253 | total) | |
254 | (goto-char (point-max)) | |
255 | (re-search-backward gnus-signature-separator nil t) | |
256 | (setq total (count-lines start (point))) | |
257 | (while atts | |
258 | (setq hiden (+ hiden (length (cdr (assoc (cdr (car atts)) | |
259 | gnus-cite-prefix-alist)))) | |
260 | atts (cdr atts))) | |
261 | (if (or force | |
262 | (and (> (* 100 hiden) (* gnus-cite-hide-percentage total)) | |
263 | (> hiden gnus-cite-hide-absolute))) | |
264 | (progn | |
265 | (setq atts gnus-cite-attribution-alist) | |
266 | (while atts | |
267 | (setq total (cdr (assoc (cdr (car atts)) gnus-cite-prefix-alist)) | |
268 | atts (cdr atts)) | |
269 | (while total | |
270 | (setq hiden (car total) | |
271 | total (cdr total)) | |
272 | (goto-line hiden) | |
273 | (or (assq hiden gnus-cite-attribution-alist) | |
274 | (add-text-properties (point) | |
275 | (progn (forward-line 1) (point)) | |
276 | gnus-hidden-properties))))))))) | |
277 | ||
278 | ;;; Internal functions: | |
279 | ||
280 | (defun gnus-cite-parse-maybe (&optional force) | |
281 | ;; Parse if the buffer has changes since last time. | |
282 | (if (eq gnus-article-length (- (point-max) (point-min))) | |
283 | () | |
284 | ;;Reset parser information. | |
285 | (setq gnus-cite-prefix-alist nil | |
286 | gnus-cite-attribution-alist nil | |
287 | gnus-cite-loose-prefix-alist nil | |
288 | gnus-cite-loose-attribution-alist nil) | |
289 | ;; Parse if not too large. | |
290 | (if (and (not force) | |
291 | gnus-cite-parse-max-size | |
292 | (> (buffer-size) gnus-cite-parse-max-size)) | |
293 | () | |
294 | (setq gnus-article-length (- (point-max) (point-min))) | |
295 | (gnus-cite-parse)))) | |
296 | ||
297 | (defun gnus-cite-parse () | |
298 | ;; Parse and connect citation prefixes and attribution lines. | |
299 | ||
300 | ;; Parse current buffer searching for citation prefixes. | |
301 | (goto-char (point-min)) | |
302 | (or (search-forward "\n\n" nil t) | |
303 | (goto-char (point-max))) | |
304 | (let ((line (1+ (count-lines (point-min) (point)))) | |
305 | (case-fold-search t) | |
306 | (max (save-excursion | |
307 | (goto-char (point-max)) | |
308 | (re-search-backward gnus-signature-separator nil t) | |
309 | (point))) | |
310 | alist entry start begin end numbers prefix) | |
311 | ;; Get all potential prefixes in `alist'. | |
312 | (while (< (point) max) | |
313 | ;; Each line. | |
314 | (setq begin (point) | |
315 | end (progn (beginning-of-line 2) (point)) | |
316 | start end) | |
317 | (goto-char begin) | |
318 | ;; Ignore standard SuperCite attribution prefix. | |
319 | (if (looking-at gnus-supercite-regexp) | |
320 | (if (match-end 1) | |
321 | (setq end (1+ (match-end 1))) | |
322 | (setq end (1+ begin)))) | |
323 | ;; Ignore very long prefixes. | |
324 | (if (> end (+ (point) gnus-cite-max-prefix)) | |
325 | (setq end (+ (point) gnus-cite-max-prefix))) | |
326 | (while (re-search-forward gnus-cite-prefix-regexp (1- end) t) | |
327 | ;; Each prefix. | |
328 | (setq end (match-end 0) | |
329 | prefix (buffer-substring begin end)) | |
330 | (set-text-properties 0 (length prefix) nil prefix) | |
331 | (setq entry (assoc prefix alist)) | |
332 | (if entry | |
333 | (setcdr entry (cons line (cdr entry))) | |
334 | (setq alist (cons (list prefix line) alist))) | |
335 | (goto-char begin)) | |
336 | (goto-char start) | |
337 | (setq line (1+ line))) | |
338 | ;; We got all the potential prefixes. Now create | |
339 | ;; `gnus-cite-prefix-alist' containing the oldest prefix for each | |
340 | ;; line that appears at least gnus-cite-minimum-match-count | |
341 | ;; times. First sort them by length. Longer is older. | |
342 | (setq alist (sort alist (lambda (a b) | |
343 | (> (length (car a)) (length (car b)))))) | |
344 | (while alist | |
345 | (setq entry (car alist) | |
346 | prefix (car entry) | |
347 | numbers (cdr entry) | |
348 | alist (cdr alist)) | |
349 | (cond ((null numbers) | |
350 | ;; No lines with this prefix that wasn't also part of | |
351 | ;; a longer prefix. | |
352 | ) | |
353 | ((< (length numbers) gnus-cite-minimum-match-count) | |
354 | ;; Too few lines with this prefix. We keep it a bit | |
355 | ;; longer in case it is an exact match for an attribution | |
356 | ;; line, but we don't remove the line from other | |
357 | ;; prefixes. | |
358 | (setq gnus-cite-prefix-alist | |
359 | (cons entry gnus-cite-prefix-alist))) | |
360 | (t | |
361 | (setq gnus-cite-prefix-alist (cons entry | |
362 | gnus-cite-prefix-alist)) | |
363 | ;; Remove articles from other prefixes. | |
364 | (let ((loop alist) | |
365 | current) | |
366 | (while loop | |
367 | (setq current (car loop) | |
368 | loop (cdr loop)) | |
369 | (setcdr current | |
370 | (gnus-set-difference (cdr current) numbers)))))))) | |
371 | ;; No citations have been connected to attribution lines yet. | |
372 | (setq gnus-cite-loose-prefix-alist (append gnus-cite-prefix-alist nil)) | |
373 | ||
374 | ;; Parse current buffer searching for attribution lines. | |
375 | (goto-char (point-min)) | |
376 | (search-forward "\n\n" nil t) | |
377 | (while (re-search-forward gnus-cite-attribution-postfix (point-max) t) | |
378 | (let* ((start (match-beginning 0)) | |
379 | (end (match-end 0)) | |
380 | (wrote (count-lines (point-min) end)) | |
381 | (prefix (gnus-cite-find-prefix wrote)) | |
382 | ;; Check previous line for an attribution leader. | |
383 | (tag (progn | |
384 | (beginning-of-line 1) | |
385 | (and (looking-at gnus-supercite-secondary-regexp) | |
386 | (buffer-substring (match-beginning 1) | |
387 | (match-end 1))))) | |
388 | (in (progn | |
389 | (goto-char start) | |
390 | (and (re-search-backward gnus-cite-attribution-prefix | |
391 | (save-excursion | |
392 | (beginning-of-line 0) | |
393 | (point)) | |
394 | t) | |
395 | (not (re-search-forward gnus-cite-attribution-postfix | |
396 | start t)) | |
397 | (count-lines (point-min) (1+ (point))))))) | |
398 | (if (eq wrote in) | |
399 | (setq in nil)) | |
400 | (goto-char end) | |
401 | (setq gnus-cite-loose-attribution-alist | |
402 | (cons (list wrote in prefix tag) | |
403 | gnus-cite-loose-attribution-alist)))) | |
404 | ;; Find exact supercite citations. | |
405 | (gnus-cite-match-attributions 'small nil | |
406 | (lambda (prefix tag) | |
407 | (if tag | |
408 | (concat "\\`" | |
409 | (regexp-quote prefix) "[ \t]*" | |
410 | (regexp-quote tag) ">")))) | |
411 | ;; Find loose supercite citations after attributions. | |
412 | (gnus-cite-match-attributions 'small t | |
413 | (lambda (prefix tag) | |
414 | (if tag (concat "\\<" | |
415 | (regexp-quote tag) | |
416 | "\\>")))) | |
417 | ;; Find loose supercite citations anywhere. | |
418 | (gnus-cite-match-attributions 'small nil | |
419 | (lambda (prefix tag) | |
420 | (if tag (concat "\\<" | |
421 | (regexp-quote tag) | |
422 | "\\>")))) | |
423 | ;; Find nested citations after attributions. | |
424 | (gnus-cite-match-attributions 'small-if-unique t | |
425 | (lambda (prefix tag) | |
426 | (concat "\\`" (regexp-quote prefix) ".+"))) | |
427 | ;; Find nested citations anywhere. | |
428 | (gnus-cite-match-attributions 'small nil | |
429 | (lambda (prefix tag) | |
430 | (concat "\\`" (regexp-quote prefix) ".+"))) | |
431 | ;; Remove loose prefixes with too few lines. | |
432 | (let ((alist gnus-cite-loose-prefix-alist) | |
433 | entry) | |
434 | (while alist | |
435 | (setq entry (car alist) | |
436 | alist (cdr alist)) | |
437 | (if (< (length (cdr entry)) gnus-cite-minimum-match-count) | |
438 | (setq gnus-cite-prefix-alist | |
439 | (delq entry gnus-cite-prefix-alist) | |
440 | gnus-cite-loose-prefix-alist | |
441 | (delq entry gnus-cite-loose-prefix-alist))))) | |
442 | ;; Find flat attributions. | |
443 | (gnus-cite-match-attributions 'first t nil) | |
444 | ;; Find any attributions (are we getting desperate yet?). | |
445 | (gnus-cite-match-attributions 'first nil nil)) | |
446 | ||
447 | (defun gnus-cite-match-attributions (sort after fun) | |
448 | ;; Match all loose attributions and citations (SORT AFTER FUN) . | |
449 | ;; | |
450 | ;; If SORT is `small', the citation with the shortest prefix will be | |
451 | ;; used, if it is `first' the first prefix will be used, if it is | |
452 | ;; `small-if-unique' the shortest prefix will be used if the | |
453 | ;; attribution line does not share its own prefix with other | |
454 | ;; loose attribution lines, otherwise the first prefix will be used. | |
455 | ;; | |
456 | ;; If AFTER is non-nil, only citations after the attribution line | |
a7acbbe4 | 457 | ;; will be considered. |
41487370 LMI |
458 | ;; |
459 | ;; If FUN is non-nil, it will be called with the arguments (WROTE | |
460 | ;; PREFIX TAG) and expected to return a regular expression. Only | |
461 | ;; citations whose prefix matches the regular expression will be | |
a7acbbe4 | 462 | ;; considered. |
41487370 LMI |
463 | ;; |
464 | ;; WROTE is the attribution line number. | |
465 | ;; PREFIX is the attribution line prefix. | |
466 | ;; TAG is the SuperCite tag on the attribution line. | |
467 | (let ((atts gnus-cite-loose-attribution-alist) | |
468 | (case-fold-search t) | |
469 | att wrote in prefix tag regexp limit smallest best size) | |
470 | (while atts | |
471 | (setq att (car atts) | |
472 | atts (cdr atts) | |
473 | wrote (nth 0 att) | |
474 | in (nth 1 att) | |
475 | prefix (nth 2 att) | |
476 | tag (nth 3 att) | |
477 | regexp (if fun (funcall fun prefix tag) "") | |
478 | size (cond ((eq sort 'small) t) | |
479 | ((eq sort 'first) nil) | |
480 | (t (< (length (gnus-cite-find-loose prefix)) 2))) | |
481 | limit (if after wrote -1) | |
482 | smallest 1000000 | |
483 | best nil) | |
484 | (let ((cites gnus-cite-loose-prefix-alist) | |
485 | cite candidate numbers first compare) | |
486 | (while cites | |
487 | (setq cite (car cites) | |
488 | cites (cdr cites) | |
489 | candidate (car cite) | |
490 | numbers (cdr cite) | |
491 | first (apply 'min numbers) | |
492 | compare (if size (length candidate) first)) | |
493 | (and (> first limit) | |
494 | regexp | |
495 | (string-match regexp candidate) | |
496 | (< compare smallest) | |
497 | (setq best cite | |
498 | smallest compare)))) | |
499 | (if (null best) | |
500 | () | |
501 | (setq gnus-cite-loose-attribution-alist | |
502 | (delq att gnus-cite-loose-attribution-alist)) | |
503 | (setq gnus-cite-attribution-alist | |
504 | (cons (cons wrote (car best)) gnus-cite-attribution-alist)) | |
505 | (if in | |
506 | (setq gnus-cite-attribution-alist | |
507 | (cons (cons in (car best)) gnus-cite-attribution-alist))) | |
508 | (if (memq best gnus-cite-loose-prefix-alist) | |
509 | (let ((loop gnus-cite-prefix-alist) | |
510 | (numbers (cdr best)) | |
511 | current) | |
512 | (setq gnus-cite-loose-prefix-alist | |
513 | (delq best gnus-cite-loose-prefix-alist)) | |
514 | (while loop | |
515 | (setq current (car loop) | |
516 | loop (cdr loop)) | |
517 | (if (eq current best) | |
518 | () | |
519 | (setcdr current (gnus-set-difference (cdr current) numbers)) | |
520 | (if (null (cdr current)) | |
521 | (setq gnus-cite-loose-prefix-alist | |
522 | (delq current gnus-cite-loose-prefix-alist) | |
523 | atts (delq current atts))))))))))) | |
524 | ||
525 | (defun gnus-cite-find-loose (prefix) | |
526 | ;; Return a list of loose attribution lines prefixed by PREFIX. | |
527 | (let* ((atts gnus-cite-loose-attribution-alist) | |
528 | att line lines) | |
529 | (while atts | |
530 | (setq att (car atts) | |
531 | line (car att) | |
532 | atts (cdr atts)) | |
533 | (if (string-equal (gnus-cite-find-prefix line) prefix) | |
534 | (setq lines (cons line lines)))) | |
535 | lines)) | |
536 | ||
537 | (defun gnus-cite-add-face (number prefix face) | |
538 | ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line. | |
539 | (if face | |
540 | (let ((inhibit-point-motion-hooks t) | |
541 | from to) | |
542 | (goto-line number) | |
543 | (forward-char (length prefix)) | |
544 | (skip-chars-forward " \t") | |
545 | (setq from (point)) | |
546 | (end-of-line 1) | |
547 | (skip-chars-backward " \t") | |
548 | (setq to (point)) | |
549 | (if (< from to) | |
550 | (gnus-overlay-put (gnus-make-overlay from to) 'face face))))) | |
551 | ||
552 | (defun gnus-cite-toggle (prefix) | |
553 | (save-excursion | |
554 | (set-buffer gnus-article-buffer) | |
555 | (let ((buffer-read-only nil) | |
556 | (numbers (cdr (assoc prefix gnus-cite-prefix-alist))) | |
557 | (inhibit-point-motion-hooks t) | |
558 | number) | |
559 | (while numbers | |
560 | (setq number (car numbers) | |
561 | numbers (cdr numbers)) | |
562 | (goto-line number) | |
563 | (cond ((get-text-property (point) 'invisible) | |
564 | (remove-text-properties (point) (progn (forward-line 1) (point)) | |
565 | gnus-hidden-properties)) | |
566 | ((assq number gnus-cite-attribution-alist)) | |
567 | (t | |
568 | (add-text-properties (point) (progn (forward-line 1) (point)) | |
569 | gnus-hidden-properties))))))) | |
570 | ||
571 | (defun gnus-cite-find-prefix (line) | |
572 | ;; Return citation prefix for LINE. | |
573 | (let ((alist gnus-cite-prefix-alist) | |
574 | (prefix "") | |
575 | entry) | |
576 | (while alist | |
577 | (setq entry (car alist) | |
578 | alist (cdr alist)) | |
579 | (if (memq line (cdr entry)) | |
580 | (setq prefix (car entry)))) | |
581 | prefix)) | |
582 | ||
583 | (gnus-ems-redefine) | |
584 | ||
585 | (provide 'gnus-cite) | |
586 | ||
587 | ;;; gnus-cite.el ends here |