Mercurial > hg > xemacs-beta

comparison lisp/gnus/gnus-cite.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents ec9a17fef872
children 0d2f883870bc
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
1 ;;; gnus-cite.el --- parse citations in articles for Gnus 1 ;;; gnus-cite.el --- parse citations in articles for Gnus
2 ;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. 2 ;; Copyright (C) 1995,96 Free Software Foundation, Inc.
3 3
4 ;; Author: Per Abrahamsen <abraham@iesd.auc.dk> 4 ;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
5 ;; Keywords: news, mail 5 ;; Keywords: news, mail
6 6
7 ;; This file is part of GNU Emacs. 7 ;; This file is part of GNU Emacs.
24 ;;; Commentary: 24 ;;; Commentary:
25 25
26 ;;; Code: 26 ;;; Code:
27 27
28 (require 'gnus) 28 (require 'gnus)
29 (require 'gnus-art) 29 (require 'gnus-msg)
30 (require 'gnus-range) 30 (require 'gnus-ems)
31 (eval-when-compile (require 'cl))
32
33 (eval-and-compile
34 (autoload 'gnus-article-add-button "gnus-vis"))
31 35
32 ;;; Customization: 36 ;;; Customization:
33 37
34 (defgroup gnus-cite nil 38 (defvar gnus-cited-text-button-line-format "%(%{[...]%}%)\n"
35 "Citation." 39 "Format of cited text buttons.")
36 :prefix "gnus-cite-" 40
37 :link '(custom-manual "(gnus)Article Highlighting") 41 (defvar gnus-cited-lines-visible nil
38 :group 'gnus-article) 42 "The number of lines of hidden cited text to remain visible.")
39 43
40 (defcustom gnus-cite-reply-regexp 44 (defvar gnus-cite-parse-max-size 25000
41 "^\\(Subject: Re\\|In-Reply-To\\|References\\):"
42 "If headers match this regexp it is reasonable to believe that
43 article has citations."
44 :group 'gnus-cite
45 :type 'string)
46
47 (defcustom gnus-cite-always-check nil
48 "Check article always for citations. Set it t to check all articles."
49 :group 'gnus-cite
50 :type '(choice (const :tag "no" nil)
51 (const :tag "yes" t)))
52
53 (defcustom gnus-cited-text-button-line-format "%(%{[...]%}%)\n"
54 "Format of cited text buttons."
55 :group 'gnus-cite
56 :type 'string)
57
58 (defcustom gnus-cited-lines-visible nil
59 "The number of lines of hidden cited text to remain visible."
60 :group 'gnus-cite
61 :type '(choice (const :tag "none" nil)
62 integer))
63
64 (defcustom gnus-cite-parse-max-size 25000
65 "Maximum article size (in bytes) where parsing citations is allowed. 45 "Maximum article size (in bytes) where parsing citations is allowed.
66 Set it to nil to parse all articles." 46 Set it to nil to parse all articles.")
67 :group 'gnus-cite 47
68 :type '(choice (const :tag "all" nil) 48 (defvar gnus-cite-prefix-regexp
69 integer))
70
71 (defcustom gnus-cite-prefix-regexp
72 "^[]>|:}+ ]*[]>|:}+]\\(.*>\\)?\\|^.*>" 49 "^[]>|:}+ ]*[]>|:}+]\\(.*>\\)?\\|^.*>"
73 "Regexp matching the longest possible citation prefix on a line." 50 "Regexp matching the longest possible citation prefix on a line.")
74 :group 'gnus-cite 51
75 :type 'regexp) 52 (defvar gnus-cite-max-prefix 20
76 53 "Maximum possible length for a citation prefix.")
77 (defcustom gnus-cite-max-prefix 20 54
78 "Maximum possible length for a citation prefix." 55 (defvar gnus-supercite-regexp
79 :group 'gnus-cite
80 :type 'integer)
81
82 (defcustom gnus-supercite-regexp
83 (concat "^\\(" gnus-cite-prefix-regexp "\\)? *" 56 (concat "^\\(" gnus-cite-prefix-regexp "\\)? *"
84 ">>>>> +\"\\([^\"\n]+\\)\" +==") 57 ">>>>> +\"\\([^\"\n]+\\)\" +==")
85 "Regexp matching normal Supercite attribution lines. 58 "Regexp matching normal Supercite attribution lines.
86 The first grouping must match prefixes added by other packages." 59 The first grouping must match prefixes added by other packages.")
87 :group 'gnus-cite 60
88 :type 'regexp) 61 (defvar gnus-supercite-secondary-regexp "^.*\"\\([^\"\n]+\\)\" +=="
89
90 (defcustom gnus-supercite-secondary-regexp "^.*\"\\([^\"\n]+\\)\" +=="
91 "Regexp matching mangled Supercite attribution lines. 62 "Regexp matching mangled Supercite attribution lines.
92 The first regexp group should match the Supercite attribution." 63 The first regexp group should match the Supercite attribution.")
93 :group 'gnus-cite 64
94 :type 'regexp) 65 (defvar gnus-cite-minimum-match-count 2
95 66 "Minimum number of identical prefixes before we believe it's a citation.")
96 (defcustom gnus-cite-minimum-match-count 2 67
97 "Minimum number of identical prefixes before we believe it's a citation." 68 ;see gnus-cus.el
98 :group 'gnus-cite 69 ;(defvar gnus-cite-face-list
99 :type 'integer) 70 ; (if (eq gnus-display-type 'color)
100 71 ; (if (eq gnus-background-mode 'dark) 'light 'dark)
101 (defcustom gnus-cite-attribution-prefix "in article\\|in <" 72 ; '(italic))
102 "Regexp matching the beginning of an attribution line." 73 ; "Faces used for displaying different citations.
103 :group 'gnus-cite 74 ;It is either a list of face names, or one of the following special
104 :type 'regexp) 75 ;values:
105 76
106 (defcustom gnus-cite-attribution-suffix 77 ;dark: Create faces from `gnus-face-dark-name-list'.
78 ;light: Create faces from `gnus-face-light-name-list'.
79
80 ;The variable `gnus-make-foreground' determines whether the created
81 ;faces change the foreground or the background colors.")
82
83 (defvar gnus-cite-attribution-prefix "in article\\|in <"
84 "Regexp matching the beginning of an attribution line.")
85
86 (defvar gnus-cite-attribution-suffix
107 "\\(wrote\\|writes\\|said\\|says\\):[ \t]*$" 87 "\\(wrote\\|writes\\|said\\|says\\):[ \t]*$"
108 "Regexp matching the end of an attribution line. 88 "Regexp matching the end of an attribution line.
109 The text matching the first grouping will be used as a button." 89 The text matching the first grouping will be used as a button.")
110 :group 'gnus-cite 90
111 :type 'regexp) 91 ;see gnus-cus.el
112 92 ;(defvar gnus-cite-attribution-face 'underline
113 (defface gnus-cite-attribution-face '((t 93 ; "Face used for attribution lines.
114 (:underline t))) 94 ;It is merged with the face for the cited text belonging to the attribution.")
115 "Face used for attribution lines.") 95
116 96 ;see gnus-cus.el
117 (defcustom gnus-cite-attribution-face 'gnus-cite-attribution-face 97 ;(defvar gnus-cite-hide-percentage 50
118 "Face used for attribution lines. 98 ; "Only hide cited text if it is larger than this percent of the body.")
119 It is merged with the face for the cited text belonging to the attribution." 99
120 :group 'gnus-cite 100 ;see gnus-cus.el
121 :type 'face) 101 ;(defvar gnus-cite-hide-absolute 10
122 102 ; "Only hide cited text if there is at least this number of cited lines.")
123 (defface gnus-cite-face-1 '((((class color) 103
124 (background dark)) 104 ;see gnus-cus.el
125 (:foreground "light blue")) 105 ;(defvar gnus-face-light-name-list
126 (((class color) 106 ; '("light blue" "light cyan" "light yellow" "light pink"
127 (background light)) 107 ; "pale green" "beige" "orange" "magenta" "violet" "medium purple"
128 (:foreground "MidnightBlue")) 108 ; "turquoise")
129 (t 109 ; "Names of light colors.")
130 (:italic t))) 110
131 "Citation face.") 111 ;see gnus-cus.el
132 112 ;(defvar gnus-face-dark-name-list
133 (defface gnus-cite-face-2 '((((class color) 113 ; '("dark salmon" "firebrick"
134 (background dark)) 114 ; "dark green" "dark orange" "dark khaki" "dark violet"
135 (:foreground "light cyan")) 115 ; "dark turquoise")
136 (((class color) 116 ; "Names of dark colors.")
137 (background light))
138 (:foreground "firebrick"))
139 (t
140 (:italic t)))
141 "Citation face.")
142
143 (defface gnus-cite-face-3 '((((class color)
144 (background dark))
145 (:foreground "light yellow"))
146 (((class color)
147 (background light))
148 (:foreground "dark green"))
149 (t
150 (:italic t)))
151 "Citation face.")
152
153 (defface gnus-cite-face-4 '((((class color)
154 (background dark))
155 (:foreground "light pink"))
156 (((class color)
157 (background light))
158 (:foreground "OrangeRed"))
159 (t
160 (:italic t)))
161 "Citation face.")
162
163 (defface gnus-cite-face-5 '((((class color)
164 (background dark))
165 (:foreground "pale green"))
166 (((class color)
167 (background light))
168 (:foreground "dark khaki"))
169 (t
170 (:italic t)))
171 "Citation face.")
172
173 (defface gnus-cite-face-6 '((((class color)
174 (background dark))
175 (:foreground "beige"))
176 (((class color)
177 (background light))
178 (:foreground "dark violet"))
179 (t
180 (:italic t)))
181 "Citation face.")
182
183 (defface gnus-cite-face-7 '((((class color)
184 (background dark))
185 (:foreground "orange"))
186 (((class color)
187 (background light))
188 (:foreground "SteelBlue4"))
189 (t
190 (:italic t)))
191 "Citation face.")
192
193 (defface gnus-cite-face-8 '((((class color)
194 (background dark))
195 (:foreground "magenta"))
196 (((class color)
197 (background light))
198 (:foreground "magenta"))
199 (t
200 (:italic t)))
201 "Citation face.")
202
203 (defface gnus-cite-face-9 '((((class color)
204 (background dark))
205 (:foreground "violet"))
206 (((class color)
207 (background light))
208 (:foreground "violet"))
209 (t
210 (:italic t)))
211 "Citation face.")
212
213 (defface gnus-cite-face-10 '((((class color)
214 (background dark))
215 (:foreground "medium purple"))
216 (((class color)
217 (background light))
218 (:foreground "medium purple"))
219 (t
220 (:italic t)))
221 "Citation face.")
222
223 (defface gnus-cite-face-11 '((((class color)
224 (background dark))
225 (:foreground "turquoise"))
226 (((class color)
227 (background light))
228 (:foreground "turquoise"))
229 (t
230 (:italic t)))
231 "Citation face.")
232
233 (defcustom gnus-cite-face-list
234 '(gnus-cite-face-1 gnus-cite-face-2 gnus-cite-face-3 gnus-cite-face-4
235 gnus-cite-face-5 gnus-cite-face-6 gnus-cite-face-7 gnus-cite-face-8
236 gnus-cite-face-9 gnus-cite-face-10 gnus-cite-face-11)
237 "List of faces used for highlighting citations.
238
239 When there are citations from multiple articles in the same message,
240 Gnus will try to give each citation from each article its own face.
241 This should make it easier to see who wrote what."
242 :group 'gnus-cite
243 :type '(repeat face))
244
245 (defcustom gnus-cite-hide-percentage 50
246 "Only hide excess citation if above this percentage of the body."
247 :group 'gnus-cite
248 :type 'number)
249
250 (defcustom gnus-cite-hide-absolute 10
251 "Only hide excess citation if above this number of lines in the body."
252 :group 'gnus-cite
253 :type 'integer)
254 117
255 ;;; Internal Variables: 118 ;;; Internal Variables:
256 119
257 (defvar gnus-cite-article nil) 120 (defvar gnus-cite-article nil)
258 121
259 (defvar gnus-cite-prefix-alist nil) 122 (defvar gnus-cite-prefix-alist nil)
260 ;; Alist of citation prefixes. 123 ;; Alist of citation prefixes.
261 ;; The cdr is a list of lines with that prefix. 124 ;; The cdr is a list of lines with that prefix.
262 125
263 (defvar gnus-cite-attribution-alist nil) 126 (defvar gnus-cite-attribution-alist nil)
264 ;; Alist of attribution lines. 127 ;; Alist of attribution lines.
265 ;; The car is a line number. 128 ;; The car is a line number.
275 ;; WROTE: is the attribution line number 138 ;; WROTE: is the attribution line number
276 ;; IN: is the line number of the previous line if part of the same attribution, 139 ;; IN: is the line number of the previous line if part of the same attribution,
277 ;; PREFIX: Is the citation prefix of the attribution line(s), and 140 ;; PREFIX: Is the citation prefix of the attribution line(s), and
278 ;; TAG: Is a Supercite tag, if any. 141 ;; TAG: Is a Supercite tag, if any.
279 142
280 (defvar gnus-cited-text-button-line-format-alist 143 (defvar gnus-cited-text-button-line-format-alist
281 `((?b (marker-position beg) ?d) 144 `((?b beg ?d)
282 (?e (marker-position end) ?d) 145 (?e end ?d)
283 (?l (- end beg) ?d))) 146 (?l (- end beg) ?d)))
284 (defvar gnus-cited-text-button-line-format-spec nil) 147 (defvar gnus-cited-text-button-line-format-spec nil)
285 148
286 ;;; Commands: 149 ;;; Commands:
287 150
291 The faces are taken from `gnus-cite-face-list'. 154 The faces are taken from `gnus-cite-face-list'.
292 Attribution lines are highlighted with the same face as the 155 Attribution lines are highlighted with the same face as the
293 corresponding citation merged with `gnus-cite-attribution-face'. 156 corresponding citation merged with `gnus-cite-attribution-face'.
294 157
295 Text is considered cited if at least `gnus-cite-minimum-match-count' 158 Text is considered cited if at least `gnus-cite-minimum-match-count'
296 lines matches `gnus-cite-prefix-regexp' with the same prefix. 159 lines matches `gnus-cite-prefix-regexp' with the same prefix.
297 160
298 Lines matching `gnus-cite-attribution-suffix' and perhaps 161 Lines matching `gnus-cite-attribution-suffix' and perhaps
299 `gnus-cite-attribution-prefix' are considered attribution lines." 162 `gnus-cite-attribution-prefix' are considered attribution lines."
300 (interactive (list 'force)) 163 (interactive (list 'force))
164 ;; Create dark or light faces if necessary.
165 (cond ((eq gnus-cite-face-list 'light)
166 (setq gnus-cite-face-list
167 (mapcar 'gnus-make-face gnus-face-light-name-list)))
168 ((eq gnus-cite-face-list 'dark)
169 (setq gnus-cite-face-list
170 (mapcar 'gnus-make-face gnus-face-dark-name-list))))
301 (save-excursion 171 (save-excursion
302 (set-buffer gnus-article-buffer) 172 (set-buffer gnus-article-buffer)
303 (gnus-cite-parse-maybe force) 173 (gnus-cite-parse-maybe force)
304 (let ((buffer-read-only nil) 174 (let ((buffer-read-only nil)
305 (alist gnus-cite-prefix-alist) 175 (alist gnus-cite-prefix-alist)
330 prefix (cdr entry) 200 prefix (cdr entry)
331 skip (gnus-cite-find-prefix number) 201 skip (gnus-cite-find-prefix number)
332 face (cdr (assoc prefix face-alist))) 202 face (cdr (assoc prefix face-alist)))
333 ;; Add attribution button. 203 ;; Add attribution button.
334 (goto-line number) 204 (goto-line number)
335 (when (re-search-forward gnus-cite-attribution-suffix 205 (if (re-search-forward gnus-cite-attribution-suffix
336 (save-excursion (end-of-line 1) (point)) 206 (save-excursion (end-of-line 1) (point))
337 t) 207 t)
338 (gnus-article-add-button (match-beginning 1) (match-end 1) 208 (gnus-article-add-button (match-beginning 1) (match-end 1)
339 'gnus-cite-toggle prefix)) 209 'gnus-cite-toggle prefix))
340 ;; Highlight attribution line. 210 ;; Highlight attribution line.
341 (gnus-cite-add-face number skip face) 211 (gnus-cite-add-face number skip face)
342 (gnus-cite-add-face number skip gnus-cite-attribution-face)) 212 (gnus-cite-add-face number skip gnus-cite-attribution-face))
343 ;; Loop through attribution lines. 213 ;; Loop through attribution lines.
344 (setq alist gnus-cite-loose-attribution-alist) 214 (setq alist gnus-cite-loose-attribution-alist)
369 (= (1- number) (car numbers))) 239 (= (1- number) (car numbers)))
370 (setq number (pop numbers))) 240 (setq number (pop numbers)))
371 (goto-char (point-min)) 241 (goto-char (point-min))
372 (forward-line (1- number)) 242 (forward-line (1- number))
373 (push (cons (point-marker) prefix) marks))) 243 (push (cons (point-marker) prefix) marks)))
374 ;; Skip to the beginning of the body.
375 (goto-char (point-min)) 244 (goto-char (point-min))
376 (search-forward "\n\n" nil t) 245 (search-forward "\n\n" nil t)
377 (push (cons (point-marker) "") marks) 246 (push (cons (point-marker) "") marks)
378 ;; Find the end of the body.
379 (goto-char (point-max)) 247 (goto-char (point-max))
380 (gnus-article-search-signature) 248 (re-search-backward gnus-signature-separator nil t)
381 (push (cons (point-marker) "") marks) 249 (push (cons (point-marker) "") marks)
382 ;; Sort the marks.
383 (setq marks (sort marks (lambda (m1 m2) (< (car m1) (car m2))))) 250 (setq marks (sort marks (lambda (m1 m2) (< (car m1) (car m2)))))
384 (let ((omarks marks)) 251 (let* ((omarks marks))
385 (setq marks nil) 252 (setq marks nil)
386 (while (cdr omarks) 253 (while (cdr omarks)
387 (if (= (caar omarks) (caadr omarks)) 254 (if (= (caar omarks) (caadr omarks))
388 (progn 255 (progn
389 (unless (equal (cdar omarks) "") 256 (unless (equal (cdar omarks) "")
390 (push (car omarks) marks)) 257 (push (car omarks) marks))
391 (unless (equal (cdadr omarks) "") 258 (unless (equal (cdadr omarks) "")
392 (push (cadr omarks) marks)) 259 (push (cadr omarks) marks))
393 (unless (and (equal (cdar omarks) "") 260 (setq omarks (cdr omarks)))
394 (equal (cdadr omarks) "")
395 (not (cddr omarks)))
396 (setq omarks (cdr omarks))))
397 (push (car omarks) marks)) 261 (push (car omarks) marks))
398 (setq omarks (cdr omarks))) 262 (setq omarks (cdr omarks)))
399 (when (car omarks) 263 (when (car omarks)
400 (push (car omarks) marks)) 264 (push (car omarks) marks))
401 (setq marks (setq m (nreverse marks))) 265 (setq marks (setq m (nreverse marks)))
406 (forward-line 1) 270 (forward-line 1)
407 (= (point) (caaddr m))) 271 (= (point) (caaddr m)))
408 (setcdr m (cdddr m)) 272 (setcdr m (cdddr m))
409 (setq m (cdr m)))) 273 (setq m (cdr m))))
410 marks)))) 274 marks))))
411 275
412 (defun gnus-article-fill-cited-article (&optional force width) 276
413 "Do word wrapping in the current article. 277 (defun gnus-article-fill-cited-article (&optional force)
414 If WIDTH (the numerical prefix), use that text width when filling." 278 "Do word wrapping in the current article."
415 (interactive (list t current-prefix-arg)) 279 (interactive (list t))
416 (save-excursion 280 (save-excursion
417 (set-buffer gnus-article-buffer) 281 (set-buffer gnus-article-buffer)
418 (let ((buffer-read-only nil) 282 (let ((buffer-read-only nil)
419 (inhibit-point-motion-hooks t) 283 (inhibit-point-motion-hooks t)
420 (marks (gnus-dissect-cited-text)) 284 (marks (gnus-dissect-cited-text))
421 (adaptive-fill-mode nil) 285 (adaptive-fill-mode nil))
422 (filladapt-mode nil)
423 (fill-column (if width (prefix-numeric-value width) fill-column)))
424 (save-restriction 286 (save-restriction
425 (while (cdr marks) 287 (while (cdr marks)
426 (widen) 288 (widen)
427 (narrow-to-region (caar marks) (caadr marks)) 289 (narrow-to-region (caar marks) (caadr marks))
428 (let ((adaptive-fill-regexp 290 (let ((adaptive-fill-regexp
430 (fill-prefix (cdar marks))) 292 (fill-prefix (cdar marks)))
431 (fill-region (point-min) (point-max))) 293 (fill-region (point-min) (point-max)))
432 (set-marker (caar marks) nil) 294 (set-marker (caar marks) nil)
433 (setq marks (cdr marks))) 295 (setq marks (cdr marks)))
434 (when marks 296 (when marks
435 (set-marker (caar marks) nil)) 297 (set-marker (caar marks) nil))))))
436 ;; All this information is now incorrect.
437 (setq gnus-cite-prefix-alist nil
438 gnus-cite-attribution-alist nil
439 gnus-cite-loose-prefix-alist nil
440 gnus-cite-loose-attribution-alist nil)))))
441 298
442 (defun gnus-article-hide-citation (&optional arg force) 299 (defun gnus-article-hide-citation (&optional arg force)
443 "Toggle hiding of all cited text except attribution lines. 300 "Toggle hiding of all cited text except attribution lines.
444 See the documentation for `gnus-article-highlight-citation'. 301 See the documentation for `gnus-article-highlight-citation'.
445 If given a negative prefix, always show; if given a positive prefix, 302 If given a negative prefix, always show; if given a positive prefix,
446 always hide." 303 always hide."
447 (interactive (append (gnus-article-hidden-arg) (list 'force))) 304 (interactive (append (gnus-hidden-arg) (list 'force)))
448 (setq gnus-cited-text-button-line-format-spec 305 (setq gnus-cited-text-button-line-format-spec
449 (gnus-parse-format gnus-cited-text-button-line-format 306 (gnus-parse-format gnus-cited-text-button-line-format
450 gnus-cited-text-button-line-format-alist t)) 307 gnus-cited-text-button-line-format-alist t))
451 (save-excursion 308 (unless (gnus-article-check-hidden-text 'cite arg)
452 (set-buffer gnus-article-buffer) 309 (save-excursion
453 (cond 310 (set-buffer gnus-article-buffer)
454 ((gnus-article-check-hidden-text 'cite arg)
455 t)
456 ((gnus-article-text-type-exists-p 'cite)
457 (let ((buffer-read-only nil))
458 (gnus-article-hide-text-of-type 'cite)))
459 (t
460 (let ((buffer-read-only nil) 311 (let ((buffer-read-only nil)
461 (marks (gnus-dissect-cited-text)) 312 (marks (gnus-dissect-cited-text))
462 (inhibit-point-motion-hooks t) 313 (inhibit-point-motion-hooks t)
463 (props (nconc (list 'article-type 'cite) 314 (props (nconc (list 'gnus-type 'cite)
464 gnus-hidden-properties)) 315 gnus-hidden-properties))
465 beg end) 316 beg end)
466 (while marks 317 (while marks
467 (setq beg nil 318 (setq beg nil
468 end nil) 319 end nil)
469 (while (and marks (string= (cdar marks) "")) 320 (while (and marks (string= (cdar marks) ""))
470 (setq marks (cdr marks))) 321 (setq marks (cdr marks)))
471 (when marks 322 (when marks
472 (setq beg (caar marks))) 323 (setq beg (caar marks)))
473 (while (and marks (not (string= (cdar marks) ""))) 324 (while (and marks (not (string= (cdar marks) "")))
474 (setq marks (cdr marks))) 325 (setq marks (cdr marks)))
475 (when marks 326 (when marks
476 (setq end (caar marks))) 327 (setq end (caar marks)))
484 (when (and beg end) 335 (when (and beg end)
485 (gnus-add-text-properties beg end props) 336 (gnus-add-text-properties beg end props)
486 (goto-char beg) 337 (goto-char beg)
487 (unless (save-excursion (search-backward "\n\n" nil t)) 338 (unless (save-excursion (search-backward "\n\n" nil t))
488 (insert "\n")) 339 (insert "\n"))
489 (put-text-property 340 (gnus-article-add-button
490 (point) 341 (point)
491 (progn 342 (progn (eval gnus-cited-text-button-line-format-spec) (point))
492 (gnus-article-add-button 343 `gnus-article-toggle-cited-text (cons beg end))
493 (point) 344 (set-marker beg (point))))))))
494 (progn (eval gnus-cited-text-button-line-format-spec) (point))
495 `gnus-article-toggle-cited-text (cons beg end))
496 (point))
497 'article-type 'annotation)
498 (set-marker beg (point)))))))))
499 345
500 (defun gnus-article-toggle-cited-text (region) 346 (defun gnus-article-toggle-cited-text (region)
501 "Toggle hiding the text in REGION." 347 "Toggle hiding the text in REGION."
502 (let (buffer-read-only) 348 (let (buffer-read-only)
503 (funcall 349 (funcall
514 This will do nothing unless at least `gnus-cite-hide-percentage' 360 This will do nothing unless at least `gnus-cite-hide-percentage'
515 percent and at least `gnus-cite-hide-absolute' lines of the body is 361 percent and at least `gnus-cite-hide-absolute' lines of the body is
516 cited text with attributions. When called interactively, these two 362 cited text with attributions. When called interactively, these two
517 variables are ignored. 363 variables are ignored.
518 See also the documentation for `gnus-article-highlight-citation'." 364 See also the documentation for `gnus-article-highlight-citation'."
519 (interactive (append (gnus-article-hidden-arg) (list 'force))) 365 (interactive (append (gnus-hidden-arg) (list 'force)))
520 (unless (gnus-article-check-hidden-text 'cite arg) 366 (unless (gnus-article-check-hidden-text 'cite arg)
521 (save-excursion 367 (save-excursion
522 (set-buffer gnus-article-buffer) 368 (set-buffer gnus-article-buffer)
523 (gnus-cite-parse-maybe force) 369 (gnus-cite-parse-maybe force)
524 (goto-char (point-min)) 370 (goto-char (point-min))
528 (buffer-read-only nil) 374 (buffer-read-only nil)
529 (inhibit-point-motion-hooks t) 375 (inhibit-point-motion-hooks t)
530 (hiden 0) 376 (hiden 0)
531 total) 377 total)
532 (goto-char (point-max)) 378 (goto-char (point-max))
533 (gnus-article-search-signature) 379 (re-search-backward gnus-signature-separator nil t)
534 (setq total (count-lines start (point))) 380 (setq total (count-lines start (point)))
535 (while atts 381 (while atts
536 (setq hiden (+ hiden (length (cdr (assoc (cdar atts) 382 (setq hiden (+ hiden (length (cdr (assoc (cdar atts)
537 gnus-cite-prefix-alist)))) 383 gnus-cite-prefix-alist))))
538 atts (cdr atts))) 384 atts (cdr atts)))
539 (when (or force 385 (if (or force
540 (and (> (* 100 hiden) (* gnus-cite-hide-percentage total)) 386 (and (> (* 100 hiden) (* gnus-cite-hide-percentage total))
541 (> hiden gnus-cite-hide-absolute))) 387 (> hiden gnus-cite-hide-absolute)))
542 (setq atts gnus-cite-attribution-alist) 388 (progn
543 (while atts 389 (setq atts gnus-cite-attribution-alist)
544 (setq total (cdr (assoc (cdar atts) gnus-cite-prefix-alist)) 390 (while atts
545 atts (cdr atts)) 391 (setq total (cdr (assoc (cdar atts) gnus-cite-prefix-alist))
546 (while total 392 atts (cdr atts))
547 (setq hiden (car total) 393 (while total
548 total (cdr total)) 394 (setq hiden (car total)
549 (goto-line hiden) 395 total (cdr total))
550 (unless (assq hiden gnus-cite-attribution-alist) 396 (goto-line hiden)
551 (gnus-add-text-properties 397 (or (assq hiden gnus-cite-attribution-alist)
552 (point) (progn (forward-line 1) (point)) 398 (gnus-add-text-properties
553 (nconc (list 'article-type 'cite) 399 (point) (progn (forward-line 1) (point))
554 gnus-hidden-properties)))))))))) 400 (nconc (list 'gnus-type 'cite)
401 gnus-hidden-properties)))))))))))
555 402
556 (defun gnus-article-hide-citation-in-followups () 403 (defun gnus-article-hide-citation-in-followups ()
557 "Hide cited text in non-root articles." 404 "Hide cited text in non-root articles."
558 (interactive) 405 (interactive)
559 (save-excursion 406 (save-excursion
574 (setq gnus-cite-prefix-alist nil 421 (setq gnus-cite-prefix-alist nil
575 gnus-cite-attribution-alist nil 422 gnus-cite-attribution-alist nil
576 gnus-cite-loose-prefix-alist nil 423 gnus-cite-loose-prefix-alist nil
577 gnus-cite-loose-attribution-alist nil) 424 gnus-cite-loose-attribution-alist nil)
578 ;; Parse if not too large. 425 ;; Parse if not too large.
579 (if (and (not force) 426 (if (and (not force)
580 gnus-cite-parse-max-size 427 gnus-cite-parse-max-size
581 (> (buffer-size) gnus-cite-parse-max-size)) 428 (> (buffer-size) gnus-cite-parse-max-size))
582 () 429 ()
583 (setq gnus-cite-article (cons (car gnus-article-current) 430 (setq gnus-cite-article (cons (car gnus-article-current)
584 (cdr gnus-article-current))) 431 (cdr gnus-article-current)))
585 (gnus-cite-parse-wrapper)))) 432 (gnus-cite-parse))))
586
587 (defun gnus-cite-parse-wrapper ()
588 ;; Wrap chopped gnus-cite-parse
589 (goto-char (point-min))
590 (unless (search-forward "\n\n" nil t)
591 (goto-char (point-max)))
592 (save-excursion
593 (gnus-cite-parse-attributions))
594 ;; Try to avoid check citation if there is no reason to believe
595 ;; that article has citations
596 (if (or gnus-cite-always-check
597 (save-excursion
598 (re-search-backward gnus-cite-reply-regexp nil t))
599 gnus-cite-loose-attribution-alist)
600 (progn (save-excursion
601 (gnus-cite-parse))
602 (save-excursion
603 (gnus-cite-connect-attributions)))))
604 433
605 (defun gnus-cite-parse () 434 (defun gnus-cite-parse ()
606 ;; Parse and connect citation prefixes and attribution lines. 435 ;; Parse and connect citation prefixes and attribution lines.
607 436
608 ;; Parse current buffer searching for citation prefixes. 437 ;; Parse current buffer searching for citation prefixes.
438 (goto-char (point-min))
439 (or (search-forward "\n\n" nil t)
440 (goto-char (point-max)))
609 (let ((line (1+ (count-lines (point-min) (point)))) 441 (let ((line (1+ (count-lines (point-min) (point))))
610 (case-fold-search t) 442 (case-fold-search t)
611 (max (save-excursion 443 (max (save-excursion
612 (goto-char (point-max)) 444 (goto-char (point-max))
613 (gnus-article-search-signature) 445 (re-search-backward gnus-signature-separator nil t)
614 (point))) 446 (point)))
615 alist entry start begin end numbers prefix) 447 alist entry start begin end numbers prefix)
616 ;; Get all potential prefixes in `alist'. 448 ;; Get all potential prefixes in `alist'.
617 (while (< (point) max) 449 (while (< (point) max)
618 ;; Each line. 450 ;; Each line.
619 (setq begin (point) 451 (setq begin (point)
620 end (progn (beginning-of-line 2) (point)) 452 end (progn (beginning-of-line 2) (point))
621 start end) 453 start end)
622 (goto-char begin) 454 (goto-char begin)
623 ;; Ignore standard Supercite attribution prefix. 455 ;; Ignore standard Supercite attribution prefix.
624 (when (looking-at gnus-supercite-regexp) 456 (if (looking-at gnus-supercite-regexp)
625 (if (match-end 1) 457 (if (match-end 1)
626 (setq end (1+ (match-end 1))) 458 (setq end (1+ (match-end 1)))
627 (setq end (1+ begin)))) 459 (setq end (1+ begin))))
628 ;; Ignore very long prefixes. 460 ;; Ignore very long prefixes.
629 (when (> end (+ (point) gnus-cite-max-prefix)) 461 (if (> end (+ (point) gnus-cite-max-prefix))
630 (setq end (+ (point) gnus-cite-max-prefix))) 462 (setq end (+ (point) gnus-cite-max-prefix)))
631 (while (re-search-forward gnus-cite-prefix-regexp (1- end) t) 463 (while (re-search-forward gnus-cite-prefix-regexp (1- end) t)
632 ;; Each prefix. 464 ;; Each prefix.
633 (setq end (match-end 0) 465 (setq end (match-end 0)
634 prefix (buffer-substring begin end)) 466 prefix (buffer-substring begin end))
635 (gnus-set-text-properties 0 (length prefix) nil prefix) 467 (gnus-set-text-properties 0 (length prefix) nil prefix)
636 (setq entry (assoc prefix alist)) 468 (setq entry (assoc prefix alist))
637 (if entry 469 (if entry
638 (setcdr entry (cons line (cdr entry))) 470 (setcdr entry (cons line (cdr entry)))
639 (push (list prefix line) alist)) 471 (setq alist (cons (list prefix line) alist)))
640 (goto-char begin)) 472 (goto-char begin))
641 (goto-char start) 473 (goto-char start)
642 (setq line (1+ line))) 474 (setq line (1+ line)))
643 ;; We got all the potential prefixes. Now create 475 ;; We got all the potential prefixes. Now create
644 ;; `gnus-cite-prefix-alist' containing the oldest prefix for each 476 ;; `gnus-cite-prefix-alist' containing the oldest prefix for each
645 ;; line that appears at least gnus-cite-minimum-match-count 477 ;; line that appears at least gnus-cite-minimum-match-count
646 ;; times. First sort them by length. Longer is older. 478 ;; times. First sort them by length. Longer is older.
647 (setq alist (sort alist (lambda (a b) 479 (setq alist (sort alist (lambda (a b)
648 (> (length (car a)) (length (car b)))))) 480 (> (length (car a)) (length (car b))))))
649 (while alist 481 (while alist
650 (setq entry (car alist) 482 (setq entry (car alist)
651 prefix (car entry) 483 prefix (car entry)
657 ) 489 )
658 ((< (length numbers) gnus-cite-minimum-match-count) 490 ((< (length numbers) gnus-cite-minimum-match-count)
659 ;; Too few lines with this prefix. We keep it a bit 491 ;; Too few lines with this prefix. We keep it a bit
660 ;; longer in case it is an exact match for an attribution 492 ;; longer in case it is an exact match for an attribution
661 ;; line, but we don't remove the line from other 493 ;; line, but we don't remove the line from other
662 ;; prefixes. 494 ;; prefixes.
663 (push entry gnus-cite-prefix-alist)) 495 (setq gnus-cite-prefix-alist
496 (cons entry gnus-cite-prefix-alist)))
664 (t 497 (t
665 (push entry 498 (setq gnus-cite-prefix-alist (cons entry
666 gnus-cite-prefix-alist) 499 gnus-cite-prefix-alist))
667 ;; Remove articles from other prefixes. 500 ;; Remove articles from other prefixes.
668 (let ((loop alist) 501 (let ((loop alist)
669 current) 502 current)
670 (while loop 503 (while loop
671 (setq current (car loop) 504 (setq current (car loop)
672 loop (cdr loop)) 505 loop (cdr loop))
673 (setcdr current 506 (setcdr current
674 (gnus-set-difference (cdr current) numbers))))))))) 507 (gnus-set-difference (cdr current) numbers))))))))
675
676 (defun gnus-cite-parse-attributions ()
677 (let (al-alist)
678 ;; Parse attributions
679 (while (re-search-forward gnus-cite-attribution-suffix (point-max) t)
680 (let* ((start (match-beginning 0))
681 (end (match-end 0))
682 (wrote (count-lines (point-min) end))
683 (prefix (gnus-cite-find-prefix wrote))
684 ;; Check previous line for an attribution leader.
685 (tag (progn
686 (beginning-of-line 1)
687 (when (looking-at gnus-supercite-secondary-regexp)
688 (buffer-substring (match-beginning 1)
689 (match-end 1)))))
690 (in (progn
691 (goto-char start)
692 (and (re-search-backward gnus-cite-attribution-prefix
693 (save-excursion
694 (beginning-of-line 0)
695 (point))
696 t)
697 (not (re-search-forward gnus-cite-attribution-suffix
698 start t))
699 (count-lines (point-min) (1+ (point)))))))
700 (when (eq wrote in)
701 (setq in nil))
702 (goto-char end)
703 ;; don't add duplicates
704 (let ((al (buffer-substring (save-excursion (beginning-of-line 0)
705 (1+ (point)))
706 end)))
707 (if (not (assoc al al-alist))
708 (progn
709 (push (list wrote in prefix tag)
710 gnus-cite-loose-attribution-alist)
711 (push (cons al t) al-alist))))))))
712
713 (defun gnus-cite-connect-attributions ()
714 ;; Connect attributions to citations
715
716 ;; No citations have been connected to attribution lines yet. 508 ;; No citations have been connected to attribution lines yet.
717 (setq gnus-cite-loose-prefix-alist (append gnus-cite-prefix-alist nil)) 509 (setq gnus-cite-loose-prefix-alist (append gnus-cite-prefix-alist nil))
718 510
719 ;; Parse current buffer searching for attribution lines. 511 ;; Parse current buffer searching for attribution lines.
512 (goto-char (point-min))
513 (search-forward "\n\n" nil t)
514 (while (re-search-forward gnus-cite-attribution-suffix (point-max) t)
515 (let* ((start (match-beginning 0))
516 (end (match-end 0))
517 (wrote (count-lines (point-min) end))
518 (prefix (gnus-cite-find-prefix wrote))
519 ;; Check previous line for an attribution leader.
520 (tag (progn
521 (beginning-of-line 1)
522 (and (looking-at gnus-supercite-secondary-regexp)
523 (buffer-substring (match-beginning 1)
524 (match-end 1)))))
525 (in (progn
526 (goto-char start)
527 (and (re-search-backward gnus-cite-attribution-prefix
528 (save-excursion
529 (beginning-of-line 0)
530 (point))
531 t)
532 (not (re-search-forward gnus-cite-attribution-suffix
533 start t))
534 (count-lines (point-min) (1+ (point)))))))
535 (if (eq wrote in)
536 (setq in nil))
537 (goto-char end)
538 (setq gnus-cite-loose-attribution-alist
539 (cons (list wrote in prefix tag)
540 gnus-cite-loose-attribution-alist))))
720 ;; Find exact supercite citations. 541 ;; Find exact supercite citations.
721 (gnus-cite-match-attributions 'small nil 542 (gnus-cite-match-attributions 'small nil
722 (lambda (prefix tag) 543 (lambda (prefix tag)
723 (when tag 544 (if tag
724 (concat "\\`" 545 (concat "\\`"
725 (regexp-quote prefix) "[ \t]*" 546 (regexp-quote prefix) "[ \t]*"
726 (regexp-quote tag) ">")))) 547 (regexp-quote tag) ">"))))
727 ;; Find loose supercite citations after attributions. 548 ;; Find loose supercite citations after attributions.
728 (gnus-cite-match-attributions 'small t 549 (gnus-cite-match-attributions 'small t
729 (lambda (prefix tag) 550 (lambda (prefix tag)
730 (when tag 551 (if tag (concat "\\<"
731 (concat "\\<" 552 (regexp-quote tag)
732 (regexp-quote tag) 553 "\\>"))))
733 "\\>"))))
734 ;; Find loose supercite citations anywhere. 554 ;; Find loose supercite citations anywhere.
735 (gnus-cite-match-attributions 'small nil 555 (gnus-cite-match-attributions 'small nil
736 (lambda (prefix tag) 556 (lambda (prefix tag)
737 (when tag 557 (if tag (concat "\\<"
738 (concat "\\<" 558 (regexp-quote tag)
739 (regexp-quote tag) 559 "\\>"))))
740 "\\>"))))
741 ;; Find nested citations after attributions. 560 ;; Find nested citations after attributions.
742 (gnus-cite-match-attributions 'small-if-unique t 561 (gnus-cite-match-attributions 'small-if-unique t
743 (lambda (prefix tag) 562 (lambda (prefix tag)
744 (concat "\\`" (regexp-quote prefix) ".+"))) 563 (concat "\\`" (regexp-quote prefix) ".+")))
745 ;; Find nested citations anywhere. 564 ;; Find nested citations anywhere.
750 (let ((alist gnus-cite-loose-prefix-alist) 569 (let ((alist gnus-cite-loose-prefix-alist)
751 entry) 570 entry)
752 (while alist 571 (while alist
753 (setq entry (car alist) 572 (setq entry (car alist)
754 alist (cdr alist)) 573 alist (cdr alist))
755 (when (< (length (cdr entry)) gnus-cite-minimum-match-count) 574 (if (< (length (cdr entry)) gnus-cite-minimum-match-count)
756 (setq gnus-cite-prefix-alist 575 (setq gnus-cite-prefix-alist
757 (delq entry gnus-cite-prefix-alist) 576 (delq entry gnus-cite-prefix-alist)
758 gnus-cite-loose-prefix-alist 577 gnus-cite-loose-prefix-alist
759 (delq entry gnus-cite-loose-prefix-alist))))) 578 (delq entry gnus-cite-loose-prefix-alist)))))
760 ;; Find flat attributions. 579 ;; Find flat attributions.
761 (gnus-cite-match-attributions 'first t nil) 580 (gnus-cite-match-attributions 'first t nil)
762 ;; Find any attributions (are we getting desperate yet?). 581 ;; Find any attributions (are we getting desperate yet?).
763 (gnus-cite-match-attributions 'first nil nil)) 582 (gnus-cite-match-attributions 'first nil nil))
764 583
775 ;; will be considered. 594 ;; will be considered.
776 ;; 595 ;;
777 ;; If FUN is non-nil, it will be called with the arguments (WROTE 596 ;; If FUN is non-nil, it will be called with the arguments (WROTE
778 ;; PREFIX TAG) and expected to return a regular expression. Only 597 ;; PREFIX TAG) and expected to return a regular expression. Only
779 ;; citations whose prefix matches the regular expression will be 598 ;; citations whose prefix matches the regular expression will be
780 ;; considered. 599 ;; considered.
781 ;; 600 ;;
782 ;; WROTE is the attribution line number. 601 ;; WROTE is the attribution line number.
783 ;; PREFIX is the attribution line prefix. 602 ;; PREFIX is the attribution line prefix.
784 ;; TAG is the Supercite tag on the attribution line. 603 ;; TAG is the Supercite tag on the attribution line.
785 (let ((atts gnus-cite-loose-attribution-alist) 604 (let ((atts gnus-cite-loose-attribution-alist)
786 (case-fold-search t) 605 (case-fold-search t)
795 regexp (if fun (funcall fun prefix tag) "") 614 regexp (if fun (funcall fun prefix tag) "")
796 size (cond ((eq sort 'small) t) 615 size (cond ((eq sort 'small) t)
797 ((eq sort 'first) nil) 616 ((eq sort 'first) nil)
798 (t (< (length (gnus-cite-find-loose prefix)) 2))) 617 (t (< (length (gnus-cite-find-loose prefix)) 2)))
799 limit (if after wrote -1) 618 limit (if after wrote -1)
800 smallest 1000000 619 smallest 1000000
801 best nil) 620 best nil)
802 (let ((cites gnus-cite-loose-prefix-alist) 621 (let ((cites gnus-cite-loose-prefix-alist)
803 cite candidate numbers first compare) 622 cite candidate numbers first compare)
804 (while cites 623 (while cites
805 (setq cite (car cites) 624 (setq cite (car cites)
816 smallest compare)))) 635 smallest compare))))
817 (if (null best) 636 (if (null best)
818 () 637 ()
819 (setq gnus-cite-loose-attribution-alist 638 (setq gnus-cite-loose-attribution-alist
820 (delq att gnus-cite-loose-attribution-alist)) 639 (delq att gnus-cite-loose-attribution-alist))
821 (push (cons wrote (car best)) gnus-cite-attribution-alist) 640 (setq gnus-cite-attribution-alist
822 (when in 641 (cons (cons wrote (car best)) gnus-cite-attribution-alist))
823 (push (cons in (car best)) gnus-cite-attribution-alist)) 642 (if in
824 (when (memq best gnus-cite-loose-prefix-alist) 643 (setq gnus-cite-attribution-alist
825 (let ((loop gnus-cite-prefix-alist) 644 (cons (cons in (car best)) gnus-cite-attribution-alist)))
826 (numbers (cdr best)) 645 (if (memq best gnus-cite-loose-prefix-alist)
827 current) 646 (let ((loop gnus-cite-prefix-alist)
828 (setq gnus-cite-loose-prefix-alist 647 (numbers (cdr best))
829 (delq best gnus-cite-loose-prefix-alist)) 648 current)
830 (while loop 649 (setq gnus-cite-loose-prefix-alist
831 (setq current (car loop) 650 (delq best gnus-cite-loose-prefix-alist))
832 loop (cdr loop)) 651 (while loop
833 (if (eq current best) 652 (setq current (car loop)
834 () 653 loop (cdr loop))
835 (setcdr current (gnus-set-difference (cdr current) numbers)) 654 (if (eq current best)
836 (when (null (cdr current)) 655 ()
837 (setq gnus-cite-loose-prefix-alist 656 (setcdr current (gnus-set-difference (cdr current) numbers))
838 (delq current gnus-cite-loose-prefix-alist) 657 (if (null (cdr current))
839 atts (delq current atts))))))))))) 658 (setq gnus-cite-loose-prefix-alist
659 (delq current gnus-cite-loose-prefix-alist)
660 atts (delq current atts)))))))))))
840 661
841 (defun gnus-cite-find-loose (prefix) 662 (defun gnus-cite-find-loose (prefix)
842 ;; Return a list of loose attribution lines prefixed by PREFIX. 663 ;; Return a list of loose attribution lines prefixed by PREFIX.
843 (let* ((atts gnus-cite-loose-attribution-alist) 664 (let* ((atts gnus-cite-loose-attribution-alist)
844 att line lines) 665 att line lines)
845 (while atts 666 (while atts
846 (setq att (car atts) 667 (setq att (car atts)
847 line (car att) 668 line (car att)
848 atts (cdr atts)) 669 atts (cdr atts))
849 (when (string-equal (gnus-cite-find-prefix line) prefix) 670 (if (string-equal (gnus-cite-find-prefix line) prefix)
850 (push line lines))) 671 (setq lines (cons line lines))))
851 lines)) 672 lines))
852 673
853 (defun gnus-cite-add-face (number prefix face) 674 (defun gnus-cite-add-face (number prefix face)
854 ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line. 675 ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line.
855 (when face 676 (when face
856 (let ((inhibit-point-motion-hooks t) 677 (let ((inhibit-point-motion-hooks t)
857 from to) 678 from to)
858 (goto-line number) 679 (goto-line number)
859 (unless (eobp);; Sometimes things become confused. 680 (unless (eobp) ;; Sometimes things become confused.
860 (forward-char (length prefix)) 681 (forward-char (length prefix))
861 (skip-chars-forward " \t") 682 (skip-chars-forward " \t")
862 (setq from (point)) 683 (setq from (point))
863 (end-of-line 1) 684 (end-of-line 1)
864 (skip-chars-backward " \t") 685 (skip-chars-backward " \t")
880 (cond ((get-text-property (point) 'invisible) 701 (cond ((get-text-property (point) 'invisible)
881 (remove-text-properties (point) (progn (forward-line 1) (point)) 702 (remove-text-properties (point) (progn (forward-line 1) (point))
882 gnus-hidden-properties)) 703 gnus-hidden-properties))
883 ((assq number gnus-cite-attribution-alist)) 704 ((assq number gnus-cite-attribution-alist))
884 (t 705 (t
885 (gnus-add-text-properties 706 (gnus-add-text-properties
886 (point) (progn (forward-line 1) (point)) 707 (point) (progn (forward-line 1) (point))
887 (nconc (list 'article-type 'cite) 708 (nconc (list 'gnus-type 'cite)
888 gnus-hidden-properties)))))))) 709 gnus-hidden-properties))))))))
889 710
890 (defun gnus-cite-find-prefix (line) 711 (defun gnus-cite-find-prefix (line)
891 ;; Return citation prefix for LINE. 712 ;; Return citation prefix for LINE.
892 (let ((alist gnus-cite-prefix-alist) 713 (let ((alist gnus-cite-prefix-alist)
893 (prefix "") 714 (prefix "")
894 entry) 715 entry)
895 (while alist 716 (while alist
896 (setq entry (car alist) 717 (setq entry (car alist)
897 alist (cdr alist)) 718 alist (cdr alist))
898 (when (memq line (cdr entry)) 719 (if (memq line (cdr entry))
899 (setq prefix (car entry)))) 720 (setq prefix (car entry))))
900 prefix)) 721 prefix))
901 722
902 (gnus-add-shutdown 'gnus-cache-close 'gnus) 723 (gnus-add-shutdown 'gnus-cache-close 'gnus)
903 724
904 (defun gnus-cache-close () 725 (defun gnus-cache-close ()