*** empty log message ***
[gnus] / lisp / gnus-sum.el
1 ;;; gnus-sum.el --- summary mode commands for Gnus
2 ;; Copyright (C) 1996 Free Software Foundation, Inc.
3
4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
5 ;; Keywords: news
6
7 ;; This file is part of GNU Emacs.
8
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
12 ;; any later version.
13
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17 ;; GNU General Public License for more details.
18
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
23
24 ;;; Commentary:
25
26 ;;; Code:
27
28 (require 'gnus-load)
29 (require 'gnus-group)
30 (require 'gnus-spec)
31 (require 'gnus-range)
32 (require 'gnus-int)
33 (require 'gnus-undo)
34 (require 'gnus)
35
36
37 (defvar gnus-kill-summary-on-exit t
38   "*If non-nil, kill the summary buffer when you exit from it.
39 If nil, the summary will become a \"*Dead Summary*\" buffer, and
40 it will be killed sometime later.")
41
42 (defvar gnus-fetch-old-headers nil
43   "*Non-nil means that Gnus will try to build threads by grabbing old headers.
44 If an unread article in the group refers to an older, already read (or
45 just marked as read) article, the old article will not normally be
46 displayed in the Summary buffer.  If this variable is non-nil, Gnus
47 will attempt to grab the headers to the old articles, and thereby
48 build complete threads.  If it has the value `some', only enough
49 headers to connect otherwise loose threads will be displayed.
50 This variable can also be a number.  In that case, no more than that
51 number of old headers will be fetched.
52
53 The server has to support NOV for any of this to work.")
54
55 (defvar gnus-summary-make-false-root 'adopt
56   "*nil means that Gnus won't gather loose threads.
57 If the root of a thread has expired or been read in a previous
58 session, the information necessary to build a complete thread has been
59 lost.  Instead of having many small sub-threads from this original thread
60 scattered all over the summary buffer, Gnus can gather them.
61
62 If non-nil, Gnus will try to gather all loose sub-threads from an
63 original thread into one large thread.
64
65 If this variable is non-nil, it should be one of `none', `adopt',
66 `dummy' or `empty'.
67
68 If this variable is `none', Gnus will not make a false root, but just
69 present the sub-threads after another.
70 If this variable is `dummy', Gnus will create a dummy root that will
71 have all the sub-threads as children.
72 If this variable is `adopt', Gnus will make one of the \"children\"
73 the parent and mark all the step-children as such.
74 If this variable is `empty', the \"children\" are printed with empty
75 subject fields.  (Or rather, they will be printed with a string
76 given by the `gnus-summary-same-subject' variable.)")
77
78 (defvar gnus-summary-gather-exclude-subject "^ *$\\|^(none)$"
79   "*A regexp to match subjects to be excluded from loose thread gathering.
80 As loose thread gathering is done on subjects only, that means that
81 there can be many false gatherings performed.  By rooting out certain
82 common subjects, gathering might become saner.")
83
84 (defvar gnus-summary-gather-subject-limit nil
85   "*Maximum length of subject comparisons when gathering loose threads.
86 Use nil to compare full subjects.  Setting this variable to a low
87 number will help gather threads that have been corrupted by
88 newsreaders chopping off subject lines, but it might also mean that
89 unrelated articles that have subject that happen to begin with the
90 same few characters will be incorrectly gathered.
91
92 If this variable is `fuzzy', Gnus will use a fuzzy algorithm when
93 comparing subjects.")
94
95 (defvar gnus-simplify-ignored-prefixes nil
96   "*Regexp, matches for which are removed from subject lines when simplifying fuzzily.")
97
98 (defvar gnus-build-sparse-threads nil
99   "*If non-nil, fill in the gaps in threads.
100 If `some', only fill in the gaps that are needed to tie loose threads
101 together.  If `more', fill in all leaf nodes that Gnus can find.  If
102 non-nil and non-`some', fill in all gaps that Gnus manages to guess.")
103
104 (defvar gnus-summary-thread-gathering-function 'gnus-gather-threads-by-subject
105   "Function used for gathering loose threads.
106 There are two pre-defined functions: `gnus-gather-threads-by-subject',
107 which only takes Subjects into consideration; and
108 `gnus-gather-threads-by-references', which compared the References
109 headers of the articles to find matches.")
110
111 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
112 (defvar gnus-summary-same-subject ""
113   "*String indicating that the current article has the same subject as the previous.
114 This variable will only be used if the value of
115 `gnus-summary-make-false-root' is `empty'.")
116
117 (defvar gnus-summary-goto-unread t
118   "*If non-nil, marking commands will go to the next unread article.
119 If `never', \\<gnus-summary-mode-map>\\[gnus-summary-next-page] will go to the next article,
120 whether it is read or not.")
121
122 (defvar gnus-summary-default-score 0
123   "*Default article score level.
124 If this variable is nil, scoring will be disabled.")
125
126 (defvar gnus-summary-zcore-fuzz 0
127   "*Fuzziness factor for the zcore in the summary buffer.
128 Articles with scores closer than this to `gnus-summary-default-score'
129 will not be marked.")
130
131 (defvar gnus-simplify-subject-fuzzy-regexp nil
132   "*Strings to be removed when doing fuzzy matches.
133 This can either be a regular expression or list of regular expressions
134 that will be removed from subject strings if fuzzy subject
135 simplification is selected.")
136
137 (defvar gnus-show-threads t
138   "*If non-nil, display threads in summary mode.")
139
140 (defvar gnus-thread-hide-subtree nil
141   "*If non-nil, hide all threads initially.
142 If threads are hidden, you have to run the command
143 `gnus-summary-show-thread' by hand or use `gnus-select-article-hook'
144 to expose hidden threads.")
145
146 (defvar gnus-thread-hide-killed t
147   "*If non-nil, hide killed threads automatically.")
148
149 (defvar gnus-thread-ignore-subject nil
150   "*If non-nil, ignore subjects and do all threading based on the Reference header.
151 If nil, which is the default, articles that have different subjects
152 from their parents will start separate threads.")
153
154 (defvar gnus-thread-operation-ignore-subject t
155   "*If non-nil, subjects will be ignored when doing thread commands.
156 This affects commands like `gnus-summary-kill-thread' and
157 `gnus-summary-lower-thread'.
158
159 If this variable is nil, articles in the same thread with different
160 subjects will not be included in the operation in question.  If this
161 variable is `fuzzy', only articles that have subjects that are fuzzily
162 equal will be included.")
163
164 (defvar gnus-thread-indent-level 4
165   "*Number that says how much each sub-thread should be indented.")
166
167 (defvar gnus-auto-extend-newsgroup t
168   "*If non-nil, extend newsgroup forward and backward when requested.")
169
170 (defvar gnus-auto-select-first t
171   "*If nil, don't select the first unread article when entering a group.
172 If this variable is `best', select the highest-scored unread article
173 in the group.  If neither nil nor `best', select the first unread
174 article.
175
176 If you want to prevent automatic selection of the first unread article
177 in some newsgroups, set the variable to nil in
178 `gnus-select-group-hook'.")
179
180 (defvar gnus-auto-select-next t
181   "*If non-nil, offer to go to the next group from the end of the previous.
182 If the value is t and the next newsgroup is empty, Gnus will exit
183 summary mode and go back to group mode.  If the value is neither nil
184 nor t, Gnus will select the following unread newsgroup.  In
185 particular, if the value is the symbol `quietly', the next unread
186 newsgroup will be selected without any confirmation, and if it is
187 `almost-quietly', the next group will be selected without any
188 confirmation if you are located on the last article in the group.
189 Finally, if this variable is `slightly-quietly', the `Z n' command
190 will go to the next group without confirmation.")
191
192 (defvar gnus-auto-select-same nil
193   "*If non-nil, select the next article with the same subject.")
194
195 (defvar gnus-summary-check-current nil
196   "*If non-nil, consider the current article when moving.
197 The \"unread\" movement commands will stay on the same line if the
198 current article is unread.")
199
200 (defvar gnus-auto-center-summary t
201   "*If non-nil, always center the current summary buffer.
202 In particular, if `vertical' do only vertical recentering.  If non-nil
203 and non-`vertical', do both horizontal and vertical recentering.")
204
205 (defvar gnus-show-all-headers nil
206   "*If non-nil, don't hide any headers.")
207
208 (defvar gnus-single-article-buffer t
209   "*If non-nil, display all articles in the same buffer.
210 If nil, each group will get its own article buffer.")
211
212 (defvar gnus-break-pages t
213   "*If non-nil, do page breaking on articles.
214 The page delimiter is specified by the `gnus-page-delimiter'
215 variable.")
216
217 (defvar gnus-show-mime nil
218   "*If non-nil, do mime processing of articles.
219 The articles will simply be fed to the function given by
220 `gnus-show-mime-method'.")
221
222 (defvar gnus-move-split-methods nil
223   "*Variable used to suggest where articles are to be moved to.
224 It uses the same syntax as the `gnus-split-methods' variable.")
225
226 ;; Mark variables suggested by Thomas Michanek
227 ;; <Thomas.Michanek@telelogic.se>.
228 (defvar gnus-unread-mark ? 
229   "*Mark used for unread articles.")
230 (defvar gnus-ticked-mark ?!
231   "*Mark used for ticked articles.")
232 (defvar gnus-dormant-mark ??
233   "*Mark used for dormant articles.")
234 (defvar gnus-del-mark ?r
235   "*Mark used for del'd articles.")
236 (defvar gnus-read-mark ?R
237   "*Mark used for read articles.")
238 (defvar gnus-expirable-mark ?E
239   "*Mark used for expirable articles.")
240 (defvar gnus-killed-mark ?K
241   "*Mark used for killed articles.")
242 (defvar gnus-souped-mark ?F
243   "*Mark used for killed articles.")
244 (defvar gnus-kill-file-mark ?X
245   "*Mark used for articles killed by kill files.")
246 (defvar gnus-low-score-mark ?Y
247   "*Mark used for articles with a low score.")
248 (defvar gnus-catchup-mark ?C
249   "*Mark used for articles that are caught up.")
250 (defvar gnus-replied-mark ?A
251   "*Mark used for articles that have been replied to.")
252 (defvar gnus-cached-mark ?*
253   "*Mark used for articles that are in the cache.")
254 (defvar gnus-saved-mark ?S
255   "*Mark used for articles that have been saved to.")
256 (defvar gnus-ancient-mark ?O
257   "*Mark used for ancient articles.")
258 (defvar gnus-sparse-mark ?Q
259   "*Mark used for sparsely reffed articles.")
260 (defvar gnus-canceled-mark ?G
261   "*Mark used for canceled articles.")
262 (defvar gnus-duplicate-mark ?M
263   "*Mark used for duplicate articles.")
264 (defvar gnus-score-over-mark ?+
265   "*Score mark used for articles with high scores.")
266 (defvar gnus-score-below-mark ?-
267   "*Score mark used for articles with low scores.")
268 (defvar gnus-empty-thread-mark ? 
269   "*There is no thread under the article.")
270 (defvar gnus-not-empty-thread-mark ?=
271   "*There is a thread under the article.")
272
273 (defvar gnus-view-pseudo-asynchronously nil
274   "*If non-nil, Gnus will view pseudo-articles asynchronously.")
275
276 (defvar gnus-view-pseudos nil
277   "*If `automatic', pseudo-articles will be viewed automatically.
278 If `not-confirm', pseudos will be viewed automatically, and the user
279 will not be asked to confirm the command.")
280
281 (defvar gnus-view-pseudos-separately t
282   "*If non-nil, one pseudo-article will be created for each file to be viewed.
283 If nil, all files that use the same viewing command will be given as a
284 list of parameters to that command.")
285
286 (defvar gnus-insert-pseudo-articles t
287   "*If non-nil, insert pseudo-articles when decoding articles.")
288
289 (defvar gnus-summary-dummy-line-format
290   "*  %(:                          :%) %S\n"
291   "*The format specification for the dummy roots in the summary buffer.
292 It works along the same lines as a normal formatting string,
293 with some simple extensions.
294
295 %S  The subject")
296
297 (defvar gnus-summary-mode-line-format "Gnus: %%b [%A] %Z"
298   "*The format specification for the summary mode line.
299 It works along the same lines as a normal formatting string,
300 with some simple extensions:
301
302 %G  Group name
303 %p  Unprefixed group name
304 %A  Current article number
305 %V  Gnus version
306 %U  Number of unread articles in the group
307 %e  Number of unselected articles in the group
308 %Z  A string with unread/unselected article counts
309 %g  Shortish group name
310 %S  Subject of the current article
311 %u  User-defined spec
312 %s  Current score file name
313 %d  Number of dormant articles
314 %r  Number of articles that have been marked as read in this session
315 %E  Number of articles expunged by the score files")
316
317 (defvar gnus-summary-mark-below 0
318   "*Mark all articles with a score below this variable as read.
319 This variable is local to each summary buffer and usually set by the
320 score file.")
321
322 (defvar gnus-article-sort-functions '(gnus-article-sort-by-number)
323   "*List of functions used for sorting articles in the summary buffer.
324 This variable is only used when not using a threaded display.")
325
326 (defvar gnus-thread-sort-functions '(gnus-thread-sort-by-number)
327   "*List of functions used for sorting threads in the summary buffer.
328 By default, threads are sorted by article number.
329
330 Each function takes two threads and return non-nil if the first thread
331 should be sorted before the other.  If you use more than one function,
332 the primary sort function should be the last.  You should probably
333 always include `gnus-thread-sort-by-number' in the list of sorting
334 functions -- preferably first.
335
336 Ready-mady functions include `gnus-thread-sort-by-number',
337 `gnus-thread-sort-by-author', `gnus-thread-sort-by-subject',
338 `gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and
339 `gnus-thread-sort-by-total-score' (see `gnus-thread-score-function').")
340
341 (defvar gnus-thread-score-function '+
342   "*Function used for calculating the total score of a thread.
343
344 The function is called with the scores of the article and each
345 subthread and should then return the score of the thread.
346
347 Some functions you can use are `+', `max', or `min'.")
348
349 (defvar gnus-summary-expunge-below nil
350   "All articles that have a score less than this variable will be expunged.")
351
352 (defvar gnus-thread-expunge-below nil
353   "All threads that have a total score less than this variable will be expunged.
354 See `gnus-thread-score-function' for en explanation of what a
355 \"thread score\" is.")
356
357 (defvar gnus-summary-mode-hook nil
358   "*A hook for Gnus summary mode.
359 This hook is run before any variables are set in the summary buffer.")
360
361 (defvar gnus-summary-exit-hook nil
362   "*A hook called on exit from the summary buffer.")
363
364 (defvar gnus-summary-prepare-hook nil
365   "*A hook called after the summary buffer has been generated.
366 If you want to modify the summary buffer, you can use this hook.")
367
368 (defvar gnus-summary-generate-hook nil
369   "*A hook run just before generating the summary buffer.
370 This hook is commonly used to customize threading variables and the
371 like.")
372
373 (defvar gnus-select-group-hook nil
374   "*A hook called when a newsgroup is selected.
375
376 If you'd like to simplify subjects like the
377 `gnus-summary-next-same-subject' command does, you can use the
378 following hook:
379
380  (setq gnus-select-group-hook
381       (list
382         (lambda ()
383           (mapcar (lambda (header)
384                      (mail-header-set-subject
385                       header
386                       (gnus-simplify-subject
387                        (mail-header-subject header) 're-only)))
388                   gnus-newsgroup-headers))))")
389
390 (defvar gnus-select-article-hook nil
391   "*A hook called when an article is selected.")
392
393 (defvar gnus-visual-mark-article-hook
394   (list 'gnus-highlight-selected-summary)
395   "*Hook run after selecting an article in the summary buffer.
396 It is meant to be used for highlighting the article in some way.  It
397 is not run if `gnus-visual' is nil.")
398
399 (defvar gnus-parse-headers-hook nil
400   "*A hook called before parsing the headers.")
401 (add-hook 'gnus-parse-headers-hook 'gnus-decode-rfc1522)
402
403 (defvar gnus-exit-group-hook nil
404   "*A hook called when exiting (not quitting) summary mode.")
405
406 (defvar gnus-summary-update-hook
407   (list 'gnus-summary-highlight-line)
408   "*A hook called when a summary line is changed.
409 The hook will not be called if `gnus-visual' is nil.
410
411 The default function `gnus-summary-highlight-line' will
412 highlight the line according to the `gnus-summary-highlight'
413 variable.")
414
415 (defvar gnus-mark-article-hook '(gnus-summary-mark-read-and-unread-as-read)
416   "*A hook called when an article is selected for the first time.
417 The hook is intended to mark an article as read (or unread)
418 automatically when it is selected.")
419
420 (defvar gnus-summary-display-table 
421   ;; Change the display table.  Odd characters have a tendency to mess
422   ;; up nicely formatted displays - we make all possible glyphs
423   ;; display only a single character.
424
425   ;; We start from the standard display table, if any.
426   (let ((table (or (copy-sequence standard-display-table)
427                    (make-display-table)))
428         ;; Nix out all the control chars...
429         (i 32))
430     (while (>= (setq i (1- i)) 0)
431       (aset table i [??]))
432     ;; ... but not newline and cr, of course. (cr is necessary for the
433     ;; selective display).
434     (aset table ?\n nil)
435     (aset table ?\r nil)
436     ;; We nix out any glyphs over 126 that are not set already.
437     (let ((i 256))
438       (while (>= (setq i (1- i)) 127)
439         ;; Only modify if the entry is nil.
440         (or (aref table i)
441             (aset table i [??]))))
442     table)
443   "Display table used in summary mode buffers.")
444
445 ;;; Internal variables
446
447 (defvar gnus-original-article nil)
448 (defvar gnus-article-internal-prepare-hook nil)
449
450 (defvar gnus-thread-indent-array nil)
451 (defvar gnus-thread-indent-array-level gnus-thread-indent-level)
452
453 ;; Avoid highlighting in kill files.
454 (defvar gnus-summary-inhibit-highlight nil)
455 (defvar gnus-newsgroup-selected-overlay nil)
456 (defvar gnus-inhibit-limiting nil)
457 (defvar gnus-newsgroup-adaptive-score-file nil)
458 (defvar gnus-current-score-file nil)
459 (defvar gnus-current-move-group nil)
460 (defvar gnus-current-copy-group nil)
461 (defvar gnus-current-crosspost-group nil)
462
463 (defvar gnus-newsgroup-dependencies nil)
464 (defvar gnus-newsgroup-adaptive nil)
465 (defvar gnus-summary-display-article-function nil)
466 (defvar gnus-summary-highlight-line-function nil
467   "Function called after highlighting a summary line.")
468
469 (defvar gnus-summary-line-format-alist
470   `((?N ,(macroexpand '(mail-header-number gnus-tmp-header)) ?d)
471     (?S ,(macroexpand '(mail-header-subject gnus-tmp-header)) ?s)
472     (?s gnus-tmp-subject-or-nil ?s)
473     (?n gnus-tmp-name ?s)
474     (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from)))
475         ?s)
476     (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from))
477             gnus-tmp-from) ?s)
478     (?F gnus-tmp-from ?s)
479     (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s)
480     (?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s)
481     (?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s)
482     (?o (gnus-date-iso8601 gnus-tmp-header) ?s)
483     (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s)
484     (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s)
485     (?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
486     (?L gnus-tmp-lines ?d)
487     (?I gnus-tmp-indentation ?s)
488     (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
489     (?R gnus-tmp-replied ?c)
490     (?\[ gnus-tmp-opening-bracket ?c)
491     (?\] gnus-tmp-closing-bracket ?c)
492     (?\> (make-string gnus-tmp-level ? ) ?s)
493     (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s)
494     (?i gnus-tmp-score ?d)
495     (?z gnus-tmp-score-char ?c)
496     (?l (bbb-grouplens-score gnus-tmp-header) ?s)
497     (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d)
498     (?U gnus-tmp-unread ?c)
499     (?t (gnus-summary-number-of-articles-in-thread
500          (and (boundp 'thread) (car thread)) gnus-tmp-level)
501         ?d)
502     (?e (gnus-summary-number-of-articles-in-thread
503          (and (boundp 'thread) (car thread)) gnus-tmp-level t)
504         ?c)
505     (?u gnus-tmp-user-defined ?s)
506     (?P (gnus-pick-line-number) ?d))
507   "An alist of format specifications that can appear in summary lines,
508 and what variables they correspond with, along with the type of the
509 variable (string, integer, character, etc).")
510
511 (defvar gnus-summary-dummy-line-format-alist
512   `((?S gnus-tmp-subject ?s)
513     (?N gnus-tmp-number ?d)
514     (?u gnus-tmp-user-defined ?s)))
515
516 (defvar gnus-summary-mode-line-format-alist
517   `((?G gnus-tmp-group-name ?s)
518     (?g (gnus-short-group-name gnus-tmp-group-name) ?s)
519     (?p (gnus-group-real-name gnus-tmp-group-name) ?s)
520     (?A gnus-tmp-article-number ?d)
521     (?Z gnus-tmp-unread-and-unselected ?s)
522     (?V gnus-version ?s)
523     (?U gnus-tmp-unread-and-unticked ?d)
524     (?S gnus-tmp-subject ?s)
525     (?e gnus-tmp-unselected ?d)
526     (?u gnus-tmp-user-defined ?s)
527     (?d (length gnus-newsgroup-dormant) ?d)
528     (?t (length gnus-newsgroup-marked) ?d)
529     (?r (length gnus-newsgroup-reads) ?d)
530     (?E gnus-newsgroup-expunged-tally ?d)
531     (?s (gnus-current-score-file-nondirectory) ?s)))
532
533 (defvar gnus-last-search-regexp nil
534   "Default regexp for article search command.")
535
536 (defvar gnus-last-shell-command nil
537   "Default shell command on article.")
538
539 (defvar gnus-newsgroup-begin nil)
540 (defvar gnus-newsgroup-end nil)
541 (defvar gnus-newsgroup-last-rmail nil)
542 (defvar gnus-newsgroup-last-mail nil)
543 (defvar gnus-newsgroup-last-folder nil)
544 (defvar gnus-newsgroup-last-file nil)
545 (defvar gnus-newsgroup-auto-expire nil)
546 (defvar gnus-newsgroup-active nil)
547
548 (defvar gnus-newsgroup-data nil)
549 (defvar gnus-newsgroup-data-reverse nil)
550 (defvar gnus-newsgroup-limit nil)
551 (defvar gnus-newsgroup-limits nil)
552
553 (defvar gnus-newsgroup-unreads nil
554   "List of unread articles in the current newsgroup.")
555
556 (defvar gnus-newsgroup-unselected nil
557   "List of unselected unread articles in the current newsgroup.")
558
559 (defvar gnus-newsgroup-reads nil
560   "Alist of read articles and article marks in the current newsgroup.")
561
562 (defvar gnus-newsgroup-expunged-tally nil)
563
564 (defvar gnus-newsgroup-marked nil
565   "List of ticked articles in the current newsgroup (a subset of unread art).")
566
567 (defvar gnus-newsgroup-killed nil
568   "List of ranges of articles that have been through the scoring process.")
569
570 (defvar gnus-newsgroup-cached nil
571   "List of articles that come from the article cache.")
572
573 (defvar gnus-newsgroup-saved nil
574   "List of articles that have been saved.")
575
576 (defvar gnus-newsgroup-kill-headers nil)
577
578 (defvar gnus-newsgroup-replied nil
579   "List of articles that have been replied to in the current newsgroup.")
580
581 (defvar gnus-newsgroup-expirable nil
582   "List of articles in the current newsgroup that can be expired.")
583
584 (defvar gnus-newsgroup-processable nil
585   "List of articles in the current newsgroup that can be processed.")
586
587 (defvar gnus-newsgroup-bookmarks nil
588   "List of articles in the current newsgroup that have bookmarks.")
589
590 (defvar gnus-newsgroup-dormant nil
591   "List of dormant articles in the current newsgroup.")
592
593 (defvar gnus-newsgroup-scored nil
594   "List of scored articles in the current newsgroup.")
595
596 (defvar gnus-newsgroup-headers nil
597   "List of article headers in the current newsgroup.")
598
599 (defvar gnus-newsgroup-threads nil)
600
601 (defvar gnus-newsgroup-prepared nil
602   "Whether the current group has been prepared properly.")
603
604 (defvar gnus-newsgroup-ancient nil
605   "List of `gnus-fetch-old-headers' articles in the current newsgroup.")
606
607 (defvar gnus-newsgroup-sparse nil)
608
609 (defvar gnus-current-article nil)
610 (defvar gnus-article-current nil)
611 (defvar gnus-current-headers nil)
612 (defvar gnus-have-all-headers nil)
613 (defvar gnus-last-article nil)
614 (defvar gnus-newsgroup-history nil)
615
616 (defconst gnus-summary-local-variables
617   '(gnus-newsgroup-name
618     gnus-newsgroup-begin gnus-newsgroup-end
619     gnus-newsgroup-last-rmail gnus-newsgroup-last-mail
620     gnus-newsgroup-last-folder gnus-newsgroup-last-file
621     gnus-newsgroup-auto-expire gnus-newsgroup-unreads
622     gnus-newsgroup-unselected gnus-newsgroup-marked
623     gnus-newsgroup-reads gnus-newsgroup-saved
624     gnus-newsgroup-replied gnus-newsgroup-expirable
625     gnus-newsgroup-processable gnus-newsgroup-killed
626     gnus-newsgroup-bookmarks gnus-newsgroup-dormant
627     gnus-newsgroup-headers gnus-newsgroup-threads
628     gnus-newsgroup-prepared gnus-summary-highlight-line-function
629     gnus-current-article gnus-current-headers gnus-have-all-headers
630     gnus-last-article gnus-article-internal-prepare-hook
631     gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay
632     gnus-newsgroup-scored gnus-newsgroup-kill-headers
633     gnus-thread-expunge-below
634     gnus-score-alist gnus-current-score-file gnus-summary-expunge-below
635     (gnus-summary-mark-below . global)
636     gnus-newsgroup-active gnus-scores-exclude-files
637     gnus-newsgroup-history gnus-newsgroup-ancient
638     gnus-newsgroup-sparse
639     (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring)
640     gnus-newsgroup-adaptive-score-file (gnus-reffed-article-number . -1)
641     (gnus-newsgroup-expunged-tally . 0)
642     gnus-cache-removable-articles gnus-newsgroup-cached
643     gnus-newsgroup-data gnus-newsgroup-data-reverse
644     gnus-newsgroup-limit gnus-newsgroup-limits)
645   "Variables that are buffer-local to the summary buffers.")
646
647 ;; Byte-compiler warning.
648 (defvar gnus-article-mode-map)
649
650 ;; Subject simplification.
651
652 (defsubst gnus-simplify-subject-re (subject)
653   "Remove \"Re:\" from subject lines."
654   (if (string-match "^[Rr][Ee]: *" subject)
655       (substring subject (match-end 0))
656     subject))
657
658 (defun gnus-simplify-subject (subject &optional re-only)
659   "Remove `Re:' and words in parentheses.
660 If RE-ONLY is non-nil, strip leading `Re:'s only."
661   (let ((case-fold-search t))           ;Ignore case.
662     ;; Remove `Re:', `Re^N:', `Re(n)', and `Re[n]:'.
663     (when (string-match "\\`\\(re\\([[(^][0-9]+[])]?\\)?:[ \t]*\\)+" subject)
664       (setq subject (substring subject (match-end 0))))
665     ;; Remove uninteresting prefixes.
666     (if (and (not re-only)
667              gnus-simplify-ignored-prefixes
668              (string-match gnus-simplify-ignored-prefixes subject))
669         (setq subject (substring subject (match-end 0))))
670     ;; Remove words in parentheses from end.
671     (unless re-only
672       (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject)
673         (setq subject (substring subject 0 (match-beginning 0)))))
674     ;; Return subject string.
675     subject))
676
677 ;; Remove any leading "re:"s, any trailing paren phrases, and simplify
678 ;; all whitespace.
679 ;; Written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
680 (defun gnus-simplify-buffer-fuzzy ()
681   (let ((case-fold-search t))
682     (goto-char (point-min))
683     (while (search-forward "\t" nil t)
684       (replace-match " " t t))
685     (goto-char (point-min))
686     (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *" nil t)
687     (goto-char (match-beginning 0))
688     (while (or
689             (looking-at "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *")
690             (looking-at "^[[].*: .*[]]$"))
691       (goto-char (point-min))
692       (while (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *"
693                                 nil t)
694         (replace-match "" t t))
695       (goto-char (point-min))
696       (while (re-search-forward "^[[].*: .*[]]$" nil t)
697         (goto-char (match-end 0))
698         (delete-char -1)
699         (delete-region
700          (progn (goto-char (match-beginning 0)))
701          (re-search-forward ":"))))
702     (goto-char (point-min))
703     (while (re-search-forward " *[[{(][^()\n]*[]})] *$" nil t)
704       (replace-match "" t t))
705     (goto-char (point-min))
706     (while (re-search-forward "  +" nil t)
707       (replace-match " " t t))
708     (goto-char (point-min))
709     (while (re-search-forward " $" nil t)
710       (replace-match "" t t))
711     (goto-char (point-min))
712     (while (re-search-forward "^ +" nil t)
713       (replace-match "" t t))
714     (goto-char (point-min))
715     (when gnus-simplify-subject-fuzzy-regexp
716       (if (listp gnus-simplify-subject-fuzzy-regexp)
717           (let ((list gnus-simplify-subject-fuzzy-regexp))
718             (while list
719               (goto-char (point-min))
720               (while (re-search-forward (car list) nil t)
721                 (replace-match "" t t))
722               (setq list (cdr list))))
723         (while (re-search-forward gnus-simplify-subject-fuzzy-regexp nil t)
724           (replace-match "" t t))))))
725
726 (defun gnus-simplify-subject-fuzzy (subject)
727   "Siplify a subject string fuzzily."
728   (save-excursion
729     (gnus-set-work-buffer)
730     (let ((case-fold-search t))
731       (insert subject)
732       (inline (gnus-simplify-buffer-fuzzy))
733       (buffer-string))))
734
735 (defsubst gnus-simplify-subject-fully (subject)
736   "Simplify a subject string according to the user's wishes."
737   (cond
738    ((null gnus-summary-gather-subject-limit)
739     (gnus-simplify-subject-re subject))
740    ((eq gnus-summary-gather-subject-limit 'fuzzy)
741     (gnus-simplify-subject-fuzzy subject))
742    ((numberp gnus-summary-gather-subject-limit)
743     (gnus-limit-string (gnus-simplify-subject-re subject)
744                        gnus-summary-gather-subject-limit))
745    (t
746     subject)))
747
748 (defsubst gnus-subject-equal (s1 s2 &optional simple-first)
749   "Check whether two subjects are equal.  If optional argument
750 simple-first is t, first argument is already simplified."
751   (cond
752    ((null simple-first)
753     (equal (gnus-simplify-subject-fully s1)
754            (gnus-simplify-subject-fully s2)))
755    (t
756     (equal s1
757            (gnus-simplify-subject-fully s2)))))
758
759 (defun gnus-offer-save-summaries ()
760   "Offer to save all active summary buffers."
761   (save-excursion
762     (let ((buflist (buffer-list))
763           buffers bufname)
764       ;; Go through all buffers and find all summaries.
765       (while buflist
766         (and (setq bufname (buffer-name (car buflist)))
767              (string-match "Summary" bufname)
768              (save-excursion
769                (set-buffer bufname)
770                ;; We check that this is, indeed, a summary buffer.
771                (and (eq major-mode 'gnus-summary-mode)
772                     ;; Also make sure this isn't bogus.
773                     gnus-newsgroup-prepared))
774              (push bufname buffers))
775         (setq buflist (cdr buflist)))
776       ;; Go through all these summary buffers and offer to save them.
777       (when buffers
778         (map-y-or-n-p
779          "Update summary buffer %s? "
780          (lambda (buf) (set-buffer buf) (gnus-summary-exit))
781          buffers)))))
782
783 (defun gnus-summary-bubble-group ()
784   "Increase the score of the current group.
785 This is a handy function to add to `gnus-summary-exit-hook' to
786 increase the score of each group you read."
787   (gnus-group-add-score gnus-newsgroup-name))
788
789 \f
790 ;;;
791 ;;; Gnus summary mode
792 ;;;
793
794 (put 'gnus-summary-mode 'mode-class 'special)
795
796 (when t
797   ;; Non-orthogonal keys
798
799   (gnus-define-keys gnus-summary-mode-map
800     " " gnus-summary-next-page
801     "\177" gnus-summary-prev-page
802     [delete] gnus-summary-prev-page
803     "\r" gnus-summary-scroll-up
804     "n" gnus-summary-next-unread-article
805     "p" gnus-summary-prev-unread-article
806     "N" gnus-summary-next-article
807     "P" gnus-summary-prev-article
808     "\M-\C-n" gnus-summary-next-same-subject
809     "\M-\C-p" gnus-summary-prev-same-subject
810     "\M-n" gnus-summary-next-unread-subject
811     "\M-p" gnus-summary-prev-unread-subject
812     "." gnus-summary-first-unread-article
813     "," gnus-summary-best-unread-article
814     "\M-s" gnus-summary-search-article-forward
815     "\M-r" gnus-summary-search-article-backward
816     "<" gnus-summary-beginning-of-article
817     ">" gnus-summary-end-of-article
818     "j" gnus-summary-goto-article
819     "^" gnus-summary-refer-parent-article
820     "\M-^" gnus-summary-refer-article
821     "u" gnus-summary-tick-article-forward
822     "!" gnus-summary-tick-article-forward
823     "U" gnus-summary-tick-article-backward
824     "d" gnus-summary-mark-as-read-forward
825     "D" gnus-summary-mark-as-read-backward
826     "E" gnus-summary-mark-as-expirable
827     "\M-u" gnus-summary-clear-mark-forward
828     "\M-U" gnus-summary-clear-mark-backward
829     "k" gnus-summary-kill-same-subject-and-select
830     "\C-k" gnus-summary-kill-same-subject
831     "\M-\C-k" gnus-summary-kill-thread
832     "\M-\C-l" gnus-summary-lower-thread
833     "e" gnus-summary-edit-article
834     "#" gnus-summary-mark-as-processable
835     "\M-#" gnus-summary-unmark-as-processable
836     "\M-\C-t" gnus-summary-toggle-threads
837     "\M-\C-s" gnus-summary-show-thread
838     "\M-\C-h" gnus-summary-hide-thread
839     "\M-\C-f" gnus-summary-next-thread
840     "\M-\C-b" gnus-summary-prev-thread
841     "\M-\C-u" gnus-summary-up-thread
842     "\M-\C-d" gnus-summary-down-thread
843     "&" gnus-summary-execute-command
844     "c" gnus-summary-catchup-and-exit
845     "\C-w" gnus-summary-mark-region-as-read
846     "\C-t" gnus-summary-toggle-truncation
847     "?" gnus-summary-mark-as-dormant
848     "\C-c\M-\C-s" gnus-summary-limit-include-expunged
849     "\C-c\C-s\C-n" gnus-summary-sort-by-number
850     "\C-c\C-s\C-a" gnus-summary-sort-by-author
851     "\C-c\C-s\C-s" gnus-summary-sort-by-subject
852     "\C-c\C-s\C-d" gnus-summary-sort-by-date
853     "\C-c\C-s\C-i" gnus-summary-sort-by-score
854     "=" gnus-summary-expand-window
855     "\C-x\C-s" gnus-summary-reselect-current-group
856     "\M-g" gnus-summary-rescan-group
857     "w" gnus-summary-stop-page-breaking
858     "\C-c\C-r" gnus-summary-caesar-message
859     "\M-t" gnus-summary-toggle-mime
860     "f" gnus-summary-followup
861     "F" gnus-summary-followup-with-original
862     "C" gnus-summary-cancel-article
863     "r" gnus-summary-reply
864     "R" gnus-summary-reply-with-original
865     "\C-c\C-f" gnus-summary-mail-forward
866     "o" gnus-summary-save-article
867     "\C-o" gnus-summary-save-article-mail
868     "|" gnus-summary-pipe-output
869     "\M-k" gnus-summary-edit-local-kill
870     "\M-K" gnus-summary-edit-global-kill
871     "V" gnus-version
872     "\C-c\C-d" gnus-summary-describe-group
873     "q" gnus-summary-exit
874     "Q" gnus-summary-exit-no-update
875     "\C-c\C-i" gnus-info-find-node
876     gnus-mouse-2 gnus-mouse-pick-article
877     "m" gnus-summary-mail-other-window
878     "a" gnus-summary-post-news
879     "x" gnus-summary-limit-to-unread
880     "s" gnus-summary-isearch-article
881     "t" gnus-article-hide-headers
882     "g" gnus-summary-show-article
883     "l" gnus-summary-goto-last-article
884     "\C-c\C-v\C-v" gnus-uu-decode-uu-view
885     "\C-d" gnus-summary-enter-digest-group
886     "\M-\C-d" gnus-summary-read-document
887     "\C-c\C-b" gnus-bug
888     "*" gnus-cache-enter-article
889     "\M-*" gnus-cache-remove-article
890     "\M-&" gnus-summary-universal-argument
891     "\C-l" gnus-recenter
892     "I" gnus-summary-increase-score
893     "L" gnus-summary-lower-score
894
895     "V" gnus-summary-score-map
896     "X" gnus-uu-extract-map
897     "S" gnus-summary-send-map)
898
899   ;; Sort of orthogonal keymap
900   (gnus-define-keys (gnus-summary-mark-map "M" gnus-summary-mode-map)
901     "t" gnus-summary-tick-article-forward
902     "!" gnus-summary-tick-article-forward
903     "d" gnus-summary-mark-as-read-forward
904     "r" gnus-summary-mark-as-read-forward
905     "c" gnus-summary-clear-mark-forward
906     " " gnus-summary-clear-mark-forward
907     "e" gnus-summary-mark-as-expirable
908     "x" gnus-summary-mark-as-expirable
909     "?" gnus-summary-mark-as-dormant
910     "b" gnus-summary-set-bookmark
911     "B" gnus-summary-remove-bookmark
912     "#" gnus-summary-mark-as-processable
913     "\M-#" gnus-summary-unmark-as-processable
914     "S" gnus-summary-limit-include-expunged
915     "C" gnus-summary-catchup
916     "H" gnus-summary-catchup-to-here
917     "\C-c" gnus-summary-catchup-all
918     "k" gnus-summary-kill-same-subject-and-select
919     "K" gnus-summary-kill-same-subject
920     "P" gnus-uu-mark-map)
921
922   (gnus-define-keys (gnus-summary-mscore-map "V" gnus-summary-mode-map)
923     "c" gnus-summary-clear-above
924     "u" gnus-summary-tick-above
925     "m" gnus-summary-mark-above
926     "k" gnus-summary-kill-below)
927
928   (gnus-define-keys (gnus-summary-limit-map "/" gnus-summary-mode-map)
929     "/" gnus-summary-limit-to-subject
930     "n" gnus-summary-limit-to-articles
931     "w" gnus-summary-pop-limit
932     "s" gnus-summary-limit-to-subject
933     "a" gnus-summary-limit-to-author
934     "u" gnus-summary-limit-to-unread
935     "m" gnus-summary-limit-to-marks
936     "v" gnus-summary-limit-to-score
937     "D" gnus-summary-limit-include-dormant
938     "d" gnus-summary-limit-exclude-dormant
939     ;;  "t" gnus-summary-limit-exclude-thread
940     "E" gnus-summary-limit-include-expunged
941     "c" gnus-summary-limit-exclude-childless-dormant
942     "C" gnus-summary-limit-mark-excluded-as-read)
943
944   (gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map)
945     "n" gnus-summary-next-unread-article
946     "p" gnus-summary-prev-unread-article
947     "N" gnus-summary-next-article
948     "P" gnus-summary-prev-article
949     "\C-n" gnus-summary-next-same-subject
950     "\C-p" gnus-summary-prev-same-subject
951     "\M-n" gnus-summary-next-unread-subject
952     "\M-p" gnus-summary-prev-unread-subject
953     "f" gnus-summary-first-unread-article
954     "b" gnus-summary-best-unread-article
955     "j" gnus-summary-goto-article
956     "g" gnus-summary-goto-subject
957     "l" gnus-summary-goto-last-article
958     "p" gnus-summary-pop-article)
959
960   (gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map)
961     "k" gnus-summary-kill-thread
962     "l" gnus-summary-lower-thread
963     "i" gnus-summary-raise-thread
964     "T" gnus-summary-toggle-threads
965     "t" gnus-summary-rethread-current
966     "^" gnus-summary-reparent-thread
967     "s" gnus-summary-show-thread
968     "S" gnus-summary-show-all-threads
969     "h" gnus-summary-hide-thread
970     "H" gnus-summary-hide-all-threads
971     "n" gnus-summary-next-thread
972     "p" gnus-summary-prev-thread
973     "u" gnus-summary-up-thread
974     "o" gnus-summary-top-thread
975     "d" gnus-summary-down-thread
976     "#" gnus-uu-mark-thread
977     "\M-#" gnus-uu-unmark-thread)
978
979   (gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map)
980     "c" gnus-summary-catchup-and-exit
981     "C" gnus-summary-catchup-all-and-exit
982     "E" gnus-summary-exit-no-update
983     "Q" gnus-summary-exit
984     "Z" gnus-summary-exit
985     "n" gnus-summary-catchup-and-goto-next-group
986     "R" gnus-summary-reselect-current-group
987     "G" gnus-summary-rescan-group
988     "N" gnus-summary-next-group
989     "P" gnus-summary-prev-group)
990
991   (gnus-define-keys (gnus-summary-article-map "A" gnus-summary-mode-map)
992     " " gnus-summary-next-page
993     "n" gnus-summary-next-page
994     "\177" gnus-summary-prev-page
995     [delete] gnus-summary-prev-page
996     "p" gnus-summary-prev-page
997     "\r" gnus-summary-scroll-up
998     "<" gnus-summary-beginning-of-article
999     ">" gnus-summary-end-of-article
1000     "b" gnus-summary-beginning-of-article
1001     "e" gnus-summary-end-of-article
1002     "^" gnus-summary-refer-parent-article
1003     "r" gnus-summary-refer-parent-article
1004     "R" gnus-summary-refer-references
1005     "g" gnus-summary-show-article
1006     "s" gnus-summary-isearch-article)
1007
1008   (gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map)
1009     "b" gnus-article-add-buttons
1010     "B" gnus-article-add-buttons-to-head
1011     "o" gnus-article-treat-overstrike
1012     "e" gnus-article-emphasize
1013     "w" gnus-article-fill-cited-article
1014     "c" gnus-article-remove-cr
1015     "L" gnus-article-remove-trailing-blank-lines
1016     "q" gnus-article-de-quoted-unreadable
1017     "f" gnus-article-display-x-face
1018     "l" gnus-summary-stop-page-breaking
1019     "r" gnus-summary-caesar-message
1020     "t" gnus-article-hide-headers
1021     "v" gnus-summary-verbose-headers
1022     "m" gnus-summary-toggle-mime)
1023
1024   (gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
1025     "a" gnus-article-hide
1026     "h" gnus-article-hide-headers
1027     "b" gnus-article-hide-boring-headers
1028     "s" gnus-article-hide-signature
1029     "c" gnus-article-hide-citation
1030     "p" gnus-article-hide-pgp
1031     "P" gnus-article-hide-pem
1032     "\C-c" gnus-article-hide-citation-maybe)
1033
1034   (gnus-define-keys (gnus-summary-wash-highlight-map "H" gnus-summary-wash-map)
1035     "a" gnus-article-highlight
1036     "h" gnus-article-highlight-headers
1037     "c" gnus-article-highlight-citation
1038     "s" gnus-article-highlight-signature)
1039
1040   (gnus-define-keys (gnus-summary-wash-time-map "T" gnus-summary-wash-map)
1041     "z" gnus-article-date-ut
1042     "u" gnus-article-date-ut
1043     "l" gnus-article-date-local
1044     "e" gnus-article-date-lapsed
1045     "o" gnus-article-date-original)
1046
1047   (gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map)
1048     "v" gnus-version
1049     "f" gnus-summary-fetch-faq
1050     "d" gnus-summary-describe-group
1051     "h" gnus-summary-describe-briefly
1052     "i" gnus-info-find-node)
1053
1054   (gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map)
1055     "e" gnus-summary-expire-articles
1056     "\M-\C-e" gnus-summary-expire-articles-now
1057     "\177" gnus-summary-delete-article
1058     [delete] gnus-summary-delete-article
1059     "m" gnus-summary-move-article
1060     "r" gnus-summary-respool-article
1061     "w" gnus-summary-edit-article
1062     "c" gnus-summary-copy-article
1063     "B" gnus-summary-crosspost-article
1064     "q" gnus-summary-respool-query
1065     "i" gnus-summary-import-article)
1066
1067   (gnus-define-keys (gnus-summary-save-map "O" gnus-summary-mode-map)
1068     "o" gnus-summary-save-article
1069     "m" gnus-summary-save-article-mail
1070     "r" gnus-summary-save-article-rmail
1071     "f" gnus-summary-save-article-file
1072     "b" gnus-summary-save-article-body-file
1073     "h" gnus-summary-save-article-folder
1074     "v" gnus-summary-save-article-vm
1075     "p" gnus-summary-pipe-output
1076     "s" gnus-soup-add-article)
1077   )
1078
1079 \f
1080
1081 (defun gnus-summary-mode (&optional group)
1082   "Major mode for reading articles.
1083
1084 All normal editing commands are switched off.
1085 \\<gnus-summary-mode-map>
1086 Each line in this buffer represents one article.  To read an
1087 article, you can, for instance, type `\\[gnus-summary-next-page]'.  To move forwards
1088 and backwards while displaying articles, type `\\[gnus-summary-next-unread-article]' and `\\[gnus-summary-prev-unread-article]',
1089 respectively.
1090
1091 You can also post articles and send mail from this buffer.  To
1092 follow up an article, type `\\[gnus-summary-followup]'.  To mail a reply to the author
1093 of an article, type `\\[gnus-summary-reply]'.
1094
1095 There are approx. one gazillion commands you can execute in this
1096 buffer; read the info pages for more information (`\\[gnus-info-find-node]').
1097
1098 The following commands are available:
1099
1100 \\{gnus-summary-mode-map}"
1101   (interactive)
1102   (when (and menu-bar-mode
1103              (gnus-visual-p 'summary-menu 'menu))
1104     (gnus-summary-make-menu-bar))
1105   (kill-all-local-variables)
1106   (gnus-summary-make-local-variables)
1107   (gnus-make-thread-indent-array)
1108   (gnus-simplify-mode-line)
1109   (setq major-mode 'gnus-summary-mode)
1110   (setq mode-name "Summary")
1111   (make-local-variable 'minor-mode-alist)
1112   (use-local-map gnus-summary-mode-map)
1113   (buffer-disable-undo (current-buffer))
1114   (setq buffer-read-only t)             ;Disable modification
1115   (setq truncate-lines t)
1116   (setq selective-display t)
1117   (setq selective-display-ellipses t)   ;Display `...'
1118   (setq buffer-display-table gnus-summary-display-table)
1119   (setq gnus-newsgroup-name group)
1120   (make-local-variable 'gnus-summary-line-format)
1121   (make-local-variable 'gnus-summary-line-format-spec)
1122   (make-local-variable 'gnus-summary-mark-positions)
1123   (gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy)
1124   (gnus-update-summary-mark-positions)
1125   (gnus-make-local-hook 'post-command-hook)
1126   (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
1127   (run-hooks 'gnus-summary-mode-hook))
1128
1129 (defun gnus-summary-make-local-variables ()
1130   "Make all the local summary buffer variables."
1131   (let ((locals gnus-summary-local-variables)
1132         global local)
1133     (while (setq local (pop locals))
1134       (if (consp local)
1135           (progn
1136             (if (eq (cdr local) 'global)
1137                 ;; Copy the global value of the variable.
1138                 (setq global (symbol-value (car local)))
1139               ;; Use the value from the list.
1140               (setq global (eval (cdr local))))
1141             (make-local-variable (car local))
1142             (set (car local) global))
1143         ;; Simple nil-valued local variable.
1144         (make-local-variable local)
1145         (set local nil)))))
1146
1147 (defun gnus-summary-clear-local-variables ()
1148   (let ((locals gnus-summary-local-variables))
1149     (while locals
1150       (if (consp (car locals))
1151           (and (vectorp (caar locals))
1152                (set (caar locals) nil))
1153         (and (vectorp (car locals))
1154              (set (car locals) nil)))
1155       (setq locals (cdr locals)))))
1156
1157 ;; Summary data functions.
1158
1159 (defmacro gnus-data-number (data)
1160   `(car ,data))
1161
1162 (defmacro gnus-data-set-number (data number)
1163   `(setcar ,data ,number))
1164
1165 (defmacro gnus-data-mark (data)
1166   `(nth 1 ,data))
1167
1168 (defmacro gnus-data-set-mark (data mark)
1169   `(setcar (nthcdr 1 ,data) ,mark))
1170
1171 (defmacro gnus-data-pos (data)
1172   `(nth 2 ,data))
1173
1174 (defmacro gnus-data-set-pos (data pos)
1175   `(setcar (nthcdr 2 ,data) ,pos))
1176
1177 (defmacro gnus-data-header (data)
1178   `(nth 3 ,data))
1179
1180 (defmacro gnus-data-level (data)
1181   `(nth 4 ,data))
1182
1183 (defmacro gnus-data-unread-p (data)
1184   `(= (nth 1 ,data) gnus-unread-mark))
1185
1186 (defmacro gnus-data-read-p (data)
1187   `(/= (nth 1 ,data) gnus-unread-mark))
1188
1189 (defmacro gnus-data-pseudo-p (data)
1190   `(consp (nth 3 ,data)))
1191
1192 (defmacro gnus-data-find (number)
1193   `(assq ,number gnus-newsgroup-data))
1194
1195 (defmacro gnus-data-find-list (number &optional data)
1196   `(let ((bdata ,(or data 'gnus-newsgroup-data)))
1197      (memq (assq ,number bdata)
1198            bdata)))
1199
1200 (defmacro gnus-data-make (number mark pos header level)
1201   `(list ,number ,mark ,pos ,header ,level))
1202
1203 (defun gnus-data-enter (after-article number mark pos header level offset)
1204   (let ((data (gnus-data-find-list after-article)))
1205     (or data (error "No such article: %d" after-article))
1206     (setcdr data (cons (gnus-data-make number mark pos header level)
1207                        (cdr data)))
1208     (setq gnus-newsgroup-data-reverse nil)
1209     (gnus-data-update-list (cddr data) offset)))
1210
1211 (defun gnus-data-enter-list (after-article list &optional offset)
1212   (when list
1213     (let ((data (and after-article (gnus-data-find-list after-article)))
1214           (ilist list))
1215       (or data (not after-article) (error "No such article: %d" after-article))
1216       ;; Find the last element in the list to be spliced into the main
1217       ;; list.
1218       (while (cdr list)
1219         (setq list (cdr list)))
1220       (if (not data)
1221           (progn
1222             (setcdr list gnus-newsgroup-data)
1223             (setq gnus-newsgroup-data ilist)
1224             (and offset (gnus-data-update-list (cdr list) offset)))
1225         (setcdr list (cdr data))
1226         (setcdr data ilist)
1227         (and offset (gnus-data-update-list (cdr data) offset)))
1228       (setq gnus-newsgroup-data-reverse nil))))
1229
1230 (defun gnus-data-remove (article &optional offset)
1231   (let ((data gnus-newsgroup-data))
1232     (if (= (gnus-data-number (car data)) article)
1233         (setq gnus-newsgroup-data (cdr gnus-newsgroup-data)
1234               gnus-newsgroup-data-reverse nil)
1235       (while (cdr data)
1236         (and (= (gnus-data-number (cadr data)) article)
1237              (progn
1238                (setcdr data (cddr data))
1239                (and offset (gnus-data-update-list (cdr data) offset))
1240                (setq data nil
1241                      gnus-newsgroup-data-reverse nil)))
1242         (setq data (cdr data))))))
1243
1244 (defmacro gnus-data-list (backward)
1245   `(if ,backward
1246        (or gnus-newsgroup-data-reverse
1247            (setq gnus-newsgroup-data-reverse
1248                  (reverse gnus-newsgroup-data)))
1249      gnus-newsgroup-data))
1250
1251 (defun gnus-data-update-list (data offset)
1252   "Add OFFSET to the POS of all data entries in DATA."
1253   (while data
1254     (setcar (nthcdr 2 (car data)) (+ offset (nth 2 (car data))))
1255     (setq data (cdr data))))
1256
1257 (defun gnus-data-compute-positions ()
1258   "Compute the positions of all articles."
1259   (let ((data gnus-newsgroup-data)
1260         pos)
1261     (while data
1262       (when (setq pos (text-property-any
1263                        (point-min) (point-max)
1264                        'gnus-number (gnus-data-number (car data))))
1265         (gnus-data-set-pos (car data) (+ pos 3)))
1266       (setq data (cdr data)))))
1267
1268 (defun gnus-summary-article-pseudo-p (article)
1269   "Say whether this article is a pseudo article or not."
1270   (not (vectorp (gnus-data-header (gnus-data-find article)))))
1271
1272 (defun gnus-article-parent-p (number)
1273   "Say whether this article is a parent or not."
1274   (let ((data (gnus-data-find-list number)))
1275     (and (cdr data)                     ; There has to be an article after...
1276          (< (gnus-data-level (car data)) ; And it has to have a higher level.
1277             (gnus-data-level (nth 1 data))))))
1278
1279 (defun gnus-article-children (number)
1280   "Return a list of all children to NUMBER."
1281   (let* ((data (gnus-data-find-list number))
1282          (level (gnus-data-level (car data)))
1283          children)
1284     (setq data (cdr data))
1285     (while (and data            
1286                 (= (gnus-data-level (car data)) (1+ level)))
1287       (push (gnus-data-number (car data)) children)
1288       (setq data (cdr data)))
1289     children))
1290
1291 (defmacro gnus-summary-skip-intangible ()
1292   "If the current article is intangible, then jump to a different article."
1293   '(let ((to (get-text-property (point) 'gnus-intangible)))
1294     (and to (gnus-summary-goto-subject to))))
1295
1296 (defmacro gnus-summary-article-intangible-p ()
1297   "Say whether this article is intangible or not."
1298   '(get-text-property (point) 'gnus-intangible))
1299
1300 ;; Some summary mode macros.
1301
1302 (defmacro gnus-summary-article-number ()
1303   "The article number of the article on the current line.
1304 If there isn's an article number here, then we return the current
1305 article number."
1306   '(progn
1307      (gnus-summary-skip-intangible)
1308      (or (get-text-property (point) 'gnus-number)
1309          (gnus-summary-last-subject))))
1310
1311 (defmacro gnus-summary-article-header (&optional number)
1312   `(gnus-data-header (gnus-data-find
1313                       ,(or number '(gnus-summary-article-number)))))
1314
1315 (defmacro gnus-summary-thread-level (&optional number)
1316   `(if (and (eq gnus-summary-make-false-root 'dummy)
1317             (get-text-property (point) 'gnus-intangible))
1318        0
1319      (gnus-data-level (gnus-data-find
1320                        ,(or number '(gnus-summary-article-number))))))
1321
1322 (defmacro gnus-summary-article-mark (&optional number)
1323   `(gnus-data-mark (gnus-data-find
1324                     ,(or number '(gnus-summary-article-number)))))
1325
1326 (defmacro gnus-summary-article-pos (&optional number)
1327   `(gnus-data-pos (gnus-data-find
1328                    ,(or number '(gnus-summary-article-number)))))
1329
1330 (defalias 'gnus-summary-subject-string 'gnus-summary-article-subject)
1331 (defmacro gnus-summary-article-subject (&optional number)
1332   "Return current subject string or nil if nothing."
1333   `(let ((headers
1334           ,(if number
1335                `(gnus-data-header (assq ,number gnus-newsgroup-data))
1336              '(gnus-data-header (assq (gnus-summary-article-number)
1337                                       gnus-newsgroup-data)))))
1338      (and headers
1339           (vectorp headers)
1340           (mail-header-subject headers))))
1341
1342 (defmacro gnus-summary-article-score (&optional number)
1343   "Return current article score."
1344   `(or (cdr (assq ,(or number '(gnus-summary-article-number))
1345                   gnus-newsgroup-scored))
1346        gnus-summary-default-score 0))
1347
1348 (defun gnus-summary-article-children (&optional number)
1349   (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))))
1350          (level (gnus-data-level (car data)))
1351          l children)
1352     (while (and (setq data (cdr data))
1353                 (> (setq l (gnus-data-level (car data))) level))
1354       (and (= (1+ level) l)
1355            (setq children (cons (gnus-data-number (car data))
1356                                 children))))
1357     (nreverse children)))
1358
1359 (defun gnus-summary-article-parent (&optional number)
1360   (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))
1361                                     (gnus-data-list t)))
1362          (level (gnus-data-level (car data))))
1363     (if (zerop level)
1364         () ; This is a root.
1365       ;; We search until we find an article with a level less than
1366       ;; this one.  That function has to be the parent.
1367       (while (and (setq data (cdr data))
1368                   (not (< (gnus-data-level (car data)) level))))
1369       (and data (gnus-data-number (car data))))))
1370
1371 (defun gnus-unread-mark-p (mark)
1372   "Say whether MARK is the unread mark."
1373   (= mark gnus-unread-mark))
1374
1375 (defun gnus-read-mark-p (mark)
1376   "Say whether MARK is one of the marks that mark as read.
1377 This is all marks except unread, ticked, dormant, and expirable."
1378   (not (or (= mark gnus-unread-mark)
1379            (= mark gnus-ticked-mark)
1380            (= mark gnus-dormant-mark)
1381            (= mark gnus-expirable-mark))))
1382
1383 (defmacro gnus-article-mark (number)
1384   `(cond
1385     ((memq ,number gnus-newsgroup-unreads) gnus-unread-mark)
1386     ((memq ,number gnus-newsgroup-marked) gnus-ticked-mark)
1387     ((memq ,number gnus-newsgroup-dormant) gnus-dormant-mark)
1388     ((memq ,number gnus-newsgroup-expirable) gnus-expirable-mark)
1389     (t (or (cdr (assq ,number gnus-newsgroup-reads))
1390            gnus-ancient-mark))))
1391
1392 ;; Saving hidden threads.
1393
1394 (put 'gnus-save-hidden-threads 'lisp-indent-function 0)
1395 (put 'gnus-save-hidden-threads 'lisp-indent-hook 0)
1396 (put 'gnus-save-hidden-threads 'edebug-form-spec '(body))
1397
1398 (defmacro gnus-save-hidden-threads (&rest forms)
1399   "Save hidden threads, eval FORMS, and restore the hidden threads."
1400   (let ((config (make-symbol "config")))
1401     `(let ((,config (gnus-hidden-threads-configuration)))
1402        (unwind-protect
1403            (progn
1404              ,@forms)
1405          (gnus-restore-hidden-threads-configuration ,config)))))
1406
1407 (defun gnus-hidden-threads-configuration ()
1408   "Return the current hidden threads configuration."
1409   (save-excursion
1410     (let (config)
1411       (goto-char (point-min))
1412       (while (search-forward "\r" nil t)
1413         (push (1- (point)) config))
1414       config)))
1415
1416 (defun gnus-restore-hidden-threads-configuration (config)
1417   "Restore hidden threads configuration from CONFIG."
1418   (let (point buffer-read-only)
1419     (while (setq point (pop config))
1420       (when (and (< point (point-max))
1421                  (goto-char point)
1422                  (= (following-char) ?\n))
1423         (subst-char-in-region point (1+ point) ?\n ?\r)))))
1424
1425 ;; Various summary mode internalish functions.
1426
1427 (defun gnus-mouse-pick-article (e)
1428   (interactive "e")
1429   (mouse-set-point e)
1430   (gnus-summary-next-page nil t))
1431
1432 (defun gnus-summary-setup-buffer (group)
1433   "Initialize summary buffer."
1434   (let ((buffer (concat "*Summary " group "*")))
1435     (if (get-buffer buffer)
1436         (progn
1437           (set-buffer buffer)
1438           (setq gnus-summary-buffer (current-buffer))
1439           (not gnus-newsgroup-prepared))
1440       ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
1441       (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer)))
1442       (gnus-add-current-to-buffer-list)
1443       (gnus-summary-mode group)
1444       (when gnus-carpal
1445         (gnus-carpal-setup-buffer 'summary))
1446       (unless gnus-single-article-buffer
1447         (make-local-variable 'gnus-article-buffer)
1448         (make-local-variable 'gnus-article-current)
1449         (make-local-variable 'gnus-original-article-buffer))
1450       (setq gnus-newsgroup-name group)
1451       t)))
1452
1453 (defun gnus-set-global-variables ()
1454   ;; Set the global equivalents of the summary buffer-local variables
1455   ;; to the latest values they had.  These reflect the summary buffer
1456   ;; that was in action when the last article was fetched.
1457   (when (eq major-mode 'gnus-summary-mode)
1458     (setq gnus-summary-buffer (current-buffer))
1459     (let ((name gnus-newsgroup-name)
1460           (marked gnus-newsgroup-marked)
1461           (unread gnus-newsgroup-unreads)
1462           (headers gnus-current-headers)
1463           (data gnus-newsgroup-data)
1464           (summary gnus-summary-buffer)
1465           (article-buffer gnus-article-buffer)
1466           (original gnus-original-article-buffer)
1467           (gac gnus-article-current)
1468           (reffed gnus-reffed-article-number)
1469           (score-file gnus-current-score-file))
1470       (save-excursion
1471         (set-buffer gnus-group-buffer)
1472         (setq gnus-newsgroup-name name)
1473         (setq gnus-newsgroup-marked marked)
1474         (setq gnus-newsgroup-unreads unread)
1475         (setq gnus-current-headers headers)
1476         (setq gnus-newsgroup-data data)
1477         (setq gnus-article-current gac)
1478         (setq gnus-summary-buffer summary)
1479         (setq gnus-article-buffer article-buffer)
1480         (setq gnus-original-article-buffer original)
1481         (setq gnus-reffed-article-number reffed)
1482         (setq gnus-current-score-file score-file)))))
1483
1484 (defun gnus-summary-last-article-p (&optional article)
1485   "Return whether ARTICLE is the last article in the buffer."
1486   (if (not (setq article (or article (gnus-summary-article-number))))
1487       t ; All non-existant numbers are the last article. :-)
1488     (not (cdr (gnus-data-find-list article)))))
1489
1490 (defun gnus-make-thread-indent-array ()
1491   (let ((n 200))
1492     (unless (and gnus-thread-indent-array
1493                  (= gnus-thread-indent-level gnus-thread-indent-array-level))
1494       (setq gnus-thread-indent-array (make-vector 201 "")
1495             gnus-thread-indent-array-level gnus-thread-indent-level)
1496       (while (>= n 0)
1497         (aset gnus-thread-indent-array n
1498               (make-string (* n gnus-thread-indent-level) ? ))
1499         (setq n (1- n))))))
1500
1501 (defun gnus-update-summary-mark-positions ()
1502   "Compute where the summary marks are to go."
1503   (save-excursion
1504     (when (and gnus-summary-buffer
1505                (get-buffer gnus-summary-buffer)
1506                (buffer-name (get-buffer gnus-summary-buffer)))
1507       (set-buffer gnus-summary-buffer))
1508     (let ((gnus-replied-mark 129)
1509           (gnus-score-below-mark 130)
1510           (gnus-score-over-mark 130)
1511           (thread nil)
1512           (gnus-visual nil)
1513           (spec gnus-summary-line-format-spec)
1514           pos)
1515       (save-excursion
1516         (gnus-set-work-buffer)
1517         (let ((gnus-summary-line-format-spec spec))
1518           (gnus-summary-insert-line
1519            [0 "" "" "" "" "" 0 0 ""]  0 nil 128 t nil "" nil 1)
1520           (goto-char (point-min))
1521           (setq pos (list (cons 'unread (and (search-forward "\200" nil t)
1522                                              (- (point) 2)))))
1523           (goto-char (point-min))
1524           (push (cons 'replied (and (search-forward "\201" nil t) 
1525                                     (- (point) 2)))
1526                 pos)
1527           (goto-char (point-min))
1528           (push (cons 'score (and (search-forward "\202" nil t) (- (point) 2)))
1529                 pos)))
1530       (setq gnus-summary-mark-positions pos))))
1531
1532 (defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number)
1533   "Insert a dummy root in the summary buffer."
1534   (beginning-of-line)
1535   (gnus-add-text-properties
1536    (point) (progn (eval gnus-summary-dummy-line-format-spec) (point))
1537    (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number)))
1538
1539 (defun gnus-summary-insert-line
1540   (gnus-tmp-header gnus-tmp-level gnus-tmp-current gnus-tmp-unread
1541                    gnus-tmp-replied gnus-tmp-expirable gnus-tmp-subject-or-nil
1542                    &optional gnus-tmp-dummy gnus-tmp-score gnus-tmp-process)
1543   (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level))
1544          (gnus-tmp-lines (mail-header-lines gnus-tmp-header))
1545          (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0))
1546          (gnus-tmp-score-char
1547           (if (or (null gnus-summary-default-score)
1548                   (<= (abs (- gnus-tmp-score gnus-summary-default-score))
1549                       gnus-summary-zcore-fuzz)) ? 
1550             (if (< gnus-tmp-score gnus-summary-default-score)
1551                 gnus-score-below-mark gnus-score-over-mark)))
1552          (gnus-tmp-replied (cond (gnus-tmp-process gnus-process-mark)
1553                                  ((memq gnus-tmp-current gnus-newsgroup-cached)
1554                                   gnus-cached-mark)
1555                                  (gnus-tmp-replied gnus-replied-mark)
1556                                  ((memq gnus-tmp-current gnus-newsgroup-saved)
1557                                   gnus-saved-mark)
1558                                  (t gnus-unread-mark)))
1559          (gnus-tmp-from (mail-header-from gnus-tmp-header))
1560          (gnus-tmp-name
1561           (cond
1562            ((string-match "(.+)" gnus-tmp-from)
1563             (substring gnus-tmp-from
1564                        (1+ (match-beginning 0)) (1- (match-end 0))))
1565            ((string-match "<[^>]+> *$" gnus-tmp-from)
1566             (let ((beg (match-beginning 0)))
1567               (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
1568                        (substring gnus-tmp-from (1+ (match-beginning 0))
1569                                   (1- (match-end 0))))
1570                   (substring gnus-tmp-from 0 beg))))
1571            (t gnus-tmp-from)))
1572          (gnus-tmp-subject (mail-header-subject gnus-tmp-header))
1573          (gnus-tmp-number (mail-header-number gnus-tmp-header))
1574          (gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[))
1575          (gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\]))
1576          (buffer-read-only nil))
1577     (when (string= gnus-tmp-name "")
1578       (setq gnus-tmp-name gnus-tmp-from))
1579     (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0))
1580     (gnus-put-text-property
1581      (point)
1582      (progn (eval gnus-summary-line-format-spec) (point))
1583      'gnus-number gnus-tmp-number)
1584     (when (gnus-visual-p 'summary-highlight 'highlight)
1585       (forward-line -1)
1586       (run-hooks 'gnus-summary-update-hook)
1587       (forward-line 1))))
1588
1589 (defun gnus-summary-update-line (&optional dont-update)
1590   ;; Update summary line after change.
1591   (when (and gnus-summary-default-score
1592              (not gnus-summary-inhibit-highlight))
1593     (let* ((gnus-summary-inhibit-highlight t) ; Prevent recursion.
1594            (article (gnus-summary-article-number))
1595            (score (gnus-summary-article-score article)))
1596       (unless dont-update
1597         (if (and gnus-summary-mark-below
1598                  (< (gnus-summary-article-score)
1599                     gnus-summary-mark-below))
1600             ;; This article has a low score, so we mark it as read.
1601             (when (memq article gnus-newsgroup-unreads)
1602               (gnus-summary-mark-article-as-read gnus-low-score-mark))
1603           (when (eq (gnus-summary-article-mark) gnus-low-score-mark)
1604             ;; This article was previously marked as read on account
1605             ;; of a low score, but now it has risen, so we mark it as
1606             ;; unread.
1607             (gnus-summary-mark-article-as-unread gnus-unread-mark)))
1608         (gnus-summary-update-mark
1609          (if (or (null gnus-summary-default-score)
1610                  (<= (abs (- score gnus-summary-default-score))
1611                      gnus-summary-zcore-fuzz)) ? 
1612            (if (< score gnus-summary-default-score)
1613                gnus-score-below-mark gnus-score-over-mark)) 'score))
1614       ;; Do visual highlighting.
1615       (when (gnus-visual-p 'summary-highlight 'highlight)
1616         (run-hooks 'gnus-summary-update-hook)))))
1617
1618 (defvar gnus-tmp-new-adopts nil)
1619
1620 (defun gnus-summary-number-of-articles-in-thread (thread &optional level char)
1621   ;; Sum up all elements (and sub-elements) in a list.
1622   (let* ((number
1623           ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
1624           (cond
1625            ((and (consp thread) (cdr thread))
1626             (apply
1627              '+ 1 (mapcar
1628                    'gnus-summary-number-of-articles-in-thread (cdr thread))))
1629            ((null thread)
1630             1)
1631            ((memq (mail-header-number (car thread)) gnus-newsgroup-limit)
1632             1)
1633            (t 0))))
1634     (when (and level (zerop level) gnus-tmp-new-adopts)
1635       (incf number
1636             (apply '+ (mapcar
1637                        'gnus-summary-number-of-articles-in-thread
1638                        gnus-tmp-new-adopts))))
1639     (if char
1640         (if (> number 1) gnus-not-empty-thread-mark
1641           gnus-empty-thread-mark)
1642       number)))
1643
1644 (defun gnus-summary-set-local-parameters (group)
1645  "Go through the local params of GROUP and set all variable specs in that list."
1646   (let ((params (gnus-group-find-parameter group))
1647         elem)
1648     (while params
1649       (setq elem (car params)
1650             params (cdr params))
1651       (and (consp elem)                 ; Has to be a cons.
1652            (consp (cdr elem))           ; The cdr has to be a list.
1653            (symbolp (car elem))         ; Has to be a symbol in there.
1654            (not (memq (car elem) 
1655                       '(quit-config to-address to-list to-group)))
1656            (progn                       ; So we set it.
1657              (make-local-variable (car elem))
1658              (set (car elem) (eval (nth 1 elem))))))))
1659
1660 (defun gnus-summary-read-group (group &optional show-all no-article
1661                                       kill-buffer no-display)
1662   "Start reading news in newsgroup GROUP.
1663 If SHOW-ALL is non-nil, already read articles are also listed.
1664 If NO-ARTICLE is non-nil, no article is selected initially.
1665 If NO-DISPLAY, don't generate a summary buffer."
1666   (gnus-message 5 "Retrieving newsgroup: %s..." group)
1667   (let* ((new-group (gnus-summary-setup-buffer group))
1668          (quit-config (gnus-group-quit-config group))
1669          (did-select (and new-group (gnus-select-newsgroup group show-all))))
1670     (cond
1671      ;; This summary buffer exists already, so we just select it.
1672      ((not new-group)
1673       (gnus-set-global-variables)
1674       (when kill-buffer
1675         (gnus-kill-or-deaden-summary kill-buffer))
1676       (gnus-configure-windows 'summary 'force)
1677       (gnus-set-mode-line 'summary)
1678       (gnus-summary-position-point)
1679       (message "")
1680       t)
1681      ;; We couldn't select this group.
1682      ((null did-select)
1683       (when (and (eq major-mode 'gnus-summary-mode)
1684                  (not (equal (current-buffer) kill-buffer)))
1685         (kill-buffer (current-buffer))
1686         (if (not quit-config)
1687             (progn
1688               (set-buffer gnus-group-buffer)
1689               (gnus-group-jump-to-group group)
1690               (gnus-group-next-unread-group 1))
1691           (if (not (buffer-name (car quit-config)))
1692               (gnus-configure-windows 'group 'force)
1693             (set-buffer (car quit-config))
1694             (and (eq major-mode 'gnus-summary-mode)
1695                  (gnus-set-global-variables))
1696             (gnus-configure-windows (cdr quit-config)))))
1697       (gnus-message 3 "Can't select group")
1698       nil)
1699      ;; The user did a `C-g' while prompting for number of articles,
1700      ;; so we exit this group.
1701      ((eq did-select 'quit)
1702       (and (eq major-mode 'gnus-summary-mode)
1703            (not (equal (current-buffer) kill-buffer))
1704            (kill-buffer (current-buffer)))
1705       (when kill-buffer
1706         (gnus-kill-or-deaden-summary kill-buffer))
1707       (if (not quit-config)
1708           (progn
1709             (set-buffer gnus-group-buffer)
1710             (gnus-group-jump-to-group group)
1711             (gnus-group-next-unread-group 1)
1712             (gnus-configure-windows 'group 'force))
1713         (if (not (buffer-name (car quit-config)))
1714             (gnus-configure-windows 'group 'force)
1715           (set-buffer (car quit-config))
1716           (and (eq major-mode 'gnus-summary-mode)
1717                (gnus-set-global-variables))
1718           (gnus-configure-windows (cdr quit-config))))
1719       ;; Finally signal the quit.
1720       (signal 'quit nil))
1721      ;; The group was successfully selected.
1722      (t
1723       (gnus-set-global-variables)
1724       ;; Save the active value in effect when the group was entered.
1725       (setq gnus-newsgroup-active
1726             (gnus-copy-sequence
1727              (gnus-active gnus-newsgroup-name)))
1728       ;; You can change the summary buffer in some way with this hook.
1729       (run-hooks 'gnus-select-group-hook)
1730       ;; Set any local variables in the group parameters.
1731       (gnus-summary-set-local-parameters gnus-newsgroup-name)
1732       (gnus-update-format-specifications)
1733       ;; Do score processing.
1734       (when gnus-use-scoring
1735         (gnus-possibly-score-headers))
1736       ;; Check whether to fill in the gaps in the threads.
1737       (when gnus-build-sparse-threads
1738         (gnus-build-sparse-threads))
1739       ;; Find the initial limit.
1740       (if gnus-show-threads
1741           (if show-all
1742               (let ((gnus-newsgroup-dormant nil))
1743                 (gnus-summary-initial-limit show-all))
1744             (gnus-summary-initial-limit show-all))
1745         (setq gnus-newsgroup-limit 
1746               (mapcar 
1747                (lambda (header) (mail-header-number header))
1748                gnus-newsgroup-headers)))
1749       ;; Generate the summary buffer.
1750       (unless no-display
1751         (gnus-summary-prepare))
1752       (when gnus-use-trees
1753         (gnus-tree-open group)
1754         (setq gnus-summary-highlight-line-function
1755               'gnus-tree-highlight-article))
1756       ;; If the summary buffer is empty, but there are some low-scored
1757       ;; articles or some excluded dormants, we include these in the
1758       ;; buffer.
1759       (when (and (zerop (buffer-size))
1760                  (not no-display))
1761         (cond (gnus-newsgroup-dormant
1762                (gnus-summary-limit-include-dormant))
1763               ((and gnus-newsgroup-scored show-all)
1764                (gnus-summary-limit-include-expunged t))))
1765       ;; Function `gnus-apply-kill-file' must be called in this hook.
1766       (run-hooks 'gnus-apply-kill-hook)
1767       (if (and (zerop (buffer-size))
1768                (not no-display))
1769           (progn
1770             ;; This newsgroup is empty.
1771             (gnus-summary-catchup-and-exit nil t) ;Without confirmations.
1772             (gnus-message 6 "No unread news")
1773             (when kill-buffer
1774               (gnus-kill-or-deaden-summary kill-buffer))
1775             ;; Return nil from this function.
1776             nil)
1777         ;; Hide conversation thread subtrees.  We cannot do this in
1778         ;; gnus-summary-prepare-hook since kill processing may not
1779         ;; work with hidden articles.
1780         (and gnus-show-threads
1781              gnus-thread-hide-subtree
1782              (gnus-summary-hide-all-threads))
1783         ;; Show first unread article if requested.
1784         (if (and (not no-article)
1785                  (not no-display)
1786                  gnus-newsgroup-unreads
1787                  gnus-auto-select-first)
1788             (unless (if (eq gnus-auto-select-first 'best)
1789                         (gnus-summary-best-unread-article)
1790                       (gnus-summary-first-unread-article))
1791               (gnus-configure-windows 'summary))
1792           ;; Don't select any articles, just move point to the first
1793           ;; article in the group.
1794           (goto-char (point-min))
1795           (gnus-summary-position-point)
1796           (gnus-set-mode-line 'summary)
1797           (gnus-configure-windows 'summary 'force))
1798         (when kill-buffer
1799           (gnus-kill-or-deaden-summary kill-buffer))
1800         (when (get-buffer-window gnus-group-buffer t)
1801           ;; Gotta use windows, because recenter does wierd stuff if
1802           ;; the current buffer ain't the displayed window.
1803           (let ((owin (selected-window)))
1804             (select-window (get-buffer-window gnus-group-buffer t))
1805             (when (gnus-group-goto-group group)
1806               (recenter))
1807             (select-window owin))))
1808       ;; Mark this buffer as "prepared".
1809       (setq gnus-newsgroup-prepared t)
1810       t))))
1811
1812 (defun gnus-summary-prepare ()
1813   "Generate the summary buffer."
1814   (let ((buffer-read-only nil))
1815     (erase-buffer)
1816     (setq gnus-newsgroup-data nil
1817           gnus-newsgroup-data-reverse nil)
1818     (run-hooks 'gnus-summary-generate-hook)
1819     ;; Generate the buffer, either with threads or without.
1820     (when gnus-newsgroup-headers
1821       (gnus-summary-prepare-threads
1822        (if gnus-show-threads
1823            (gnus-sort-gathered-threads
1824             (funcall gnus-summary-thread-gathering-function
1825                      (gnus-sort-threads
1826                       (gnus-cut-threads (gnus-make-threads)))))
1827          ;; Unthreaded display.
1828          (gnus-sort-articles gnus-newsgroup-headers))))
1829     (setq gnus-newsgroup-data (nreverse gnus-newsgroup-data))
1830     ;; Call hooks for modifying summary buffer.
1831     (goto-char (point-min))
1832     (run-hooks 'gnus-summary-prepare-hook)))
1833
1834 (defsubst gnus-general-simplify-subject (subject)
1835   "Simply subject by the same rules as gnus-gather-threads-by-subject."
1836   (setq subject
1837         (cond
1838          ;; Truncate the subject.
1839          ((numberp gnus-summary-gather-subject-limit)
1840           (setq subject (gnus-simplify-subject-re subject))
1841           (if (> (length subject) gnus-summary-gather-subject-limit)
1842               (substring subject 0 gnus-summary-gather-subject-limit)
1843             subject))
1844          ;; Fuzzily simplify it.
1845          ((eq 'fuzzy gnus-summary-gather-subject-limit)
1846           (gnus-simplify-subject-fuzzy subject))
1847          ;; Just remove the leading "Re:".
1848          (t
1849           (gnus-simplify-subject-re subject))))
1850   
1851   (if (and gnus-summary-gather-exclude-subject
1852            (string-match gnus-summary-gather-exclude-subject subject))
1853       nil                               ; This article shouldn't be gathered
1854     subject))
1855
1856 (defun gnus-summary-simplify-subject-query ()
1857   "Query where the respool algorithm would put this article."
1858   (interactive)
1859   (gnus-set-global-variables)
1860   (gnus-summary-select-article)
1861   (message (gnus-general-simplify-subject (gnus-summary-article-subject))))
1862
1863 (defun gnus-gather-threads-by-subject (threads)
1864   "Gather threads by looking at Subject headers."
1865   (if (not gnus-summary-make-false-root)
1866       threads
1867     (let ((hashtb (gnus-make-hashtable 1023))
1868           (prev threads)
1869           (result threads)
1870           subject hthread whole-subject)
1871       (while threads
1872         (setq subject (gnus-general-simplify-subject
1873                        (setq whole-subject (mail-header-subject 
1874                                             (caar threads)))))
1875         (if subject
1876             (if (setq hthread (gnus-gethash subject hashtb))
1877                 (progn
1878                   ;; We enter a dummy root into the thread, if we
1879                   ;; haven't done that already.
1880                   (unless (stringp (caar hthread))
1881                     (setcar hthread (list whole-subject (car hthread))))
1882                   ;; We add this new gathered thread to this gathered
1883                   ;; thread.
1884                   (setcdr (car hthread)
1885                           (nconc (cdar hthread) (list (car threads))))
1886                   ;; Remove it from the list of threads.
1887                   (setcdr prev (cdr threads))
1888                   (setq threads prev))
1889               ;; Enter this thread into the hash table.
1890               (gnus-sethash subject threads hashtb)))
1891         (setq prev threads)
1892         (setq threads (cdr threads)))
1893       result)))
1894
1895 (defun gnus-gather-threads-by-references (threads)
1896   "Gather threads by looking at References headers."
1897   (let ((idhashtb (gnus-make-hashtable 1023))
1898         (thhashtb (gnus-make-hashtable 1023))
1899         (prev threads)
1900         (result threads)
1901         ids references id gthread gid entered)
1902     (while threads
1903       (when (setq references (mail-header-references (caar threads)))
1904         (setq id (mail-header-id (caar threads)))
1905         (setq ids (gnus-split-references references))
1906         (setq entered nil)
1907         (while ids
1908           (if (not (setq gid (gnus-gethash (car ids) idhashtb)))
1909               (progn
1910                 (gnus-sethash (car ids) id idhashtb)
1911                 (gnus-sethash id threads thhashtb))
1912             (setq gthread (gnus-gethash gid thhashtb))
1913             (unless entered
1914               ;; We enter a dummy root into the thread, if we
1915               ;; haven't done that already.
1916               (unless (stringp (caar gthread))
1917                 (setcar gthread (list (mail-header-subject (caar gthread))
1918                                       (car gthread))))
1919               ;; We add this new gathered thread to this gathered
1920               ;; thread.
1921               (setcdr (car gthread)
1922                       (nconc (cdar gthread) (list (car threads)))))
1923             ;; Add it into the thread hash table.
1924             (gnus-sethash id gthread thhashtb)
1925             (setq entered t)
1926             ;; Remove it from the list of threads.
1927             (setcdr prev (cdr threads))
1928             (setq threads prev))
1929           (setq ids (cdr ids))))
1930       (setq prev threads)
1931       (setq threads (cdr threads)))
1932     result))
1933
1934 (defun gnus-sort-gathered-threads (threads)
1935   "Sort subtreads inside each gathered thread by article number."
1936   (let ((result threads))
1937     (while threads
1938       (when (stringp (caar threads))
1939         (setcdr (car threads)
1940                 (sort (cdar threads) 'gnus-thread-sort-by-number)))
1941       (setq threads (cdr threads)))
1942     result))
1943
1944 (defun gnus-make-threads ()
1945   "Go through the dependency hashtb and find the roots.  Return all threads."
1946   (let (threads)
1947     (mapatoms
1948      (lambda (refs)
1949        (unless (car (symbol-value refs))
1950          ;; These threads do not refer back to any other articles,
1951          ;; so they're roots.
1952          (setq threads (append (cdr (symbol-value refs)) threads))))
1953      gnus-newsgroup-dependencies)
1954     threads))
1955
1956 (defun gnus-build-sparse-threads ()
1957   (let ((headers gnus-newsgroup-headers)
1958         (deps gnus-newsgroup-dependencies)
1959         header references generation relations 
1960         cthread subject child end pthread relation)
1961     ;; First we create an alist of generations/relations, where 
1962     ;; generations is how much we trust the ralation, and the relation
1963     ;; is parent/child.
1964     (gnus-message 7 "Making sparse threads...")
1965     (save-excursion
1966       (nnheader-set-temp-buffer " *gnus sparse threads*")
1967       (while (setq header (pop headers))
1968         (when (and (setq references (mail-header-references header))
1969                    (not (string= references "")))
1970           (insert references)
1971           (setq child (mail-header-id header)
1972                 subject (mail-header-subject header))
1973           (setq generation 0)
1974           (while (search-backward ">" nil t)
1975             (setq end (1+ (point)))
1976             (when (search-backward "<" nil t)
1977               (push (list (incf generation) 
1978                           child (setq child (buffer-substring (point) end))
1979                           subject)
1980                     relations)))
1981           (push (list (1+ generation) child nil subject) relations)
1982           (erase-buffer)))
1983       (kill-buffer (current-buffer)))
1984     ;; Sort over trustworthiness.
1985     (setq relations (sort relations (lambda (r1 r2) (< (car r1) (car r2)))))
1986     (while (setq relation (pop relations))
1987       (when (if (boundp (setq cthread (intern (cadr relation) deps)))
1988                 (unless (car (symbol-value cthread))
1989                   ;; Make this article the parent of these threads.
1990                   (setcar (symbol-value cthread)
1991                           (vector gnus-reffed-article-number 
1992                                   (cadddr relation) 
1993                                   "" ""
1994                                   (cadr relation) 
1995                                   (or (caddr relation) "") 0 0 "")))
1996               (set cthread (list (vector gnus-reffed-article-number
1997                                          (cadddr relation) 
1998                                          "" "" (cadr relation) 
1999                                          (or (caddr relation) "") 0 0 ""))))
2000         (push gnus-reffed-article-number gnus-newsgroup-limit)
2001         (push gnus-reffed-article-number gnus-newsgroup-sparse)
2002         (push (cons gnus-reffed-article-number gnus-sparse-mark)
2003               gnus-newsgroup-reads)
2004         (decf gnus-reffed-article-number)
2005         ;; Make this new thread the child of its parent.
2006         (if (boundp (setq pthread (intern (or (caddr relation) "none") deps)))
2007             (setcdr (symbol-value pthread)
2008                     (nconc (cdr (symbol-value pthread))
2009                            (list (symbol-value cthread))))
2010           (set pthread (list nil (symbol-value cthread))))))
2011     (gnus-message 7 "Making sparse threads...done")))
2012
2013 (defun gnus-build-old-threads ()
2014   ;; Look at all the articles that refer back to old articles, and
2015   ;; fetch the headers for the articles that aren't there.  This will
2016   ;; build complete threads - if the roots haven't been expired by the
2017   ;; server, that is.
2018   (let (id heads)
2019     (mapatoms
2020      (lambda (refs)
2021        (when (not (car (symbol-value refs)))
2022          (setq heads (cdr (symbol-value refs)))
2023          (while heads
2024            (if (memq (mail-header-number (caar heads))
2025                      gnus-newsgroup-dormant)
2026                (setq heads (cdr heads))
2027              (setq id (symbol-name refs))
2028              (while (and (setq id (gnus-build-get-header id))
2029                          (not (car (gnus-gethash
2030                                     id gnus-newsgroup-dependencies)))))
2031              (setq heads nil)))))
2032      gnus-newsgroup-dependencies)))
2033
2034 (defun gnus-build-get-header (id)
2035   ;; Look through the buffer of NOV lines and find the header to
2036   ;; ID.  Enter this line into the dependencies hash table, and return
2037   ;; the id of the parent article (if any).
2038   (let ((deps gnus-newsgroup-dependencies)
2039         found header)
2040     (prog1
2041         (save-excursion
2042           (set-buffer nntp-server-buffer)
2043           (goto-char (point-min))
2044           (while (and (not found) (search-forward id nil t))
2045             (beginning-of-line)
2046             (setq found (looking-at
2047                          (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s"
2048                                  (regexp-quote id))))
2049             (or found (beginning-of-line 2)))
2050           (when found
2051             (beginning-of-line)
2052             (and
2053              (setq header (gnus-nov-parse-line
2054                            (read (current-buffer)) deps))
2055              (gnus-parent-id (mail-header-references header)))))
2056       (when header
2057         (let ((number (mail-header-number header)))
2058           (push number gnus-newsgroup-limit)
2059           (push header gnus-newsgroup-headers)
2060           (if (memq number gnus-newsgroup-unselected)
2061               (progn
2062                 (push number gnus-newsgroup-unreads)
2063                 (setq gnus-newsgroup-unselected
2064                       (delq number gnus-newsgroup-unselected)))
2065             (push number gnus-newsgroup-ancient)))))))
2066
2067 (defun gnus-summary-update-article-line (article header)
2068   "Update the line for ARTICLE using HEADERS."
2069   (let* ((id (mail-header-id header))
2070          (thread (gnus-id-to-thread id)))
2071     (unless thread
2072       (error "Article in no thread"))
2073     ;; Update the thread.
2074     (setcar thread header)
2075     (gnus-summary-goto-subject article)
2076     (let* ((datal (gnus-data-find-list article))
2077            (data (car datal))
2078            (length (when (cdr datal)
2079                      (- (gnus-data-pos data)
2080                         (gnus-data-pos (cadr datal)))))
2081            (buffer-read-only nil)
2082            (level (gnus-summary-thread-level)))
2083       (gnus-delete-line)
2084       (gnus-summary-insert-line
2085        header level nil (gnus-article-mark article)
2086        (memq article gnus-newsgroup-replied)
2087        (memq article gnus-newsgroup-expirable)
2088        (mail-header-subject header)
2089        nil (cdr (assq article gnus-newsgroup-scored))
2090        (memq article gnus-newsgroup-processable))
2091       (when length
2092         (gnus-data-update-list
2093          (cdr datal) (- length (- (gnus-data-pos data) (point))))))))
2094      
2095 (defun gnus-summary-update-article (article &optional iheader)
2096   "Update ARTICLE in the summary buffer."
2097   (set-buffer gnus-summary-buffer)
2098   (let* ((header (or iheader (gnus-summary-article-header article)))
2099          (id (mail-header-id header))
2100          (data (gnus-data-find article))
2101          (thread (gnus-id-to-thread id))
2102          (references (mail-header-references header))
2103          (parent
2104           (gnus-id-to-thread
2105            (or (gnus-parent-id 
2106                 (if (and references
2107                          (not (equal "" references)))
2108                     references))
2109                "none")))
2110          (buffer-read-only nil)
2111          (old (car thread))
2112          (number (mail-header-number header))
2113          pos)
2114     (when thread
2115       ;; !!! Should this be in or not?
2116       (unless iheader
2117         (setcar thread nil))
2118       (when parent
2119         (delq thread parent))
2120       (if (gnus-summary-insert-subject id header iheader)
2121           ;; Set the (possibly) new article number in the data structure.
2122           (gnus-data-set-number data (gnus-id-to-article id))
2123         (setcar thread old)
2124         nil))))
2125
2126 (defun gnus-rebuild-thread (id)
2127   "Rebuild the thread containing ID."
2128   (let ((buffer-read-only nil)
2129         current thread data)
2130     (if (not gnus-show-threads)
2131         (setq thread (list (car (gnus-id-to-thread id))))
2132       ;; Get the thread this article is part of.
2133       (setq thread (gnus-remove-thread id)))
2134     (setq current (save-excursion
2135                     (and (zerop (forward-line -1))
2136                          (gnus-summary-article-number))))
2137     ;; If this is a gathered thread, we have to go some re-gathering.
2138     (when (stringp (car thread))
2139       (let ((subject (car thread))
2140             roots thr)
2141         (setq thread (cdr thread))
2142         (while thread
2143           (unless (memq (setq thr (gnus-id-to-thread
2144                                       (gnus-root-id
2145                                        (mail-header-id (caar thread)))))
2146                         roots)
2147             (push thr roots))
2148           (setq thread (cdr thread)))
2149         ;; We now have all (unique) roots.
2150         (if (= (length roots) 1)
2151             ;; All the loose roots are now one solid root.
2152             (setq thread (car roots))
2153           (setq thread (cons subject (gnus-sort-threads roots))))))
2154     (let (threads)
2155       ;; We then insert this thread into the summary buffer.
2156       (let (gnus-newsgroup-data gnus-newsgroup-threads)
2157         (gnus-summary-prepare-threads (gnus-cut-threads (list thread)))
2158         (setq data (nreverse gnus-newsgroup-data))
2159         (setq threads gnus-newsgroup-threads))
2160       ;; We splice the new data into the data structure.
2161       (gnus-data-enter-list current data)
2162       (gnus-data-compute-positions)
2163       (setq gnus-newsgroup-threads (nconc threads gnus-newsgroup-threads)))))
2164
2165 (defun gnus-number-to-header (number)
2166   "Return the header for article NUMBER."
2167   (let ((headers gnus-newsgroup-headers))
2168     (while (and headers
2169                 (not (= number (mail-header-number (car headers)))))
2170       (pop headers))
2171     (when headers
2172       (car headers))))
2173
2174 (defun gnus-parent-headers (headers &optional generation)
2175   "Return the headers of the GENERATIONeth parent of HEADERS."
2176   (unless generation 
2177     (setq generation 1))
2178   (let (references parent)
2179     (while (and headers (not (zerop generation)))
2180       (setq references (mail-header-references headers))
2181       (when (and references
2182                  (setq parent (gnus-parent-id references))
2183                  (setq headers (car (gnus-id-to-thread parent))))
2184         (decf generation)))
2185     headers))
2186
2187 (defun gnus-id-to-thread (id)
2188   "Return the (sub-)thread where ID appears."
2189   (gnus-gethash id gnus-newsgroup-dependencies))
2190
2191 (defun gnus-id-to-article (id)
2192   "Return the article number of ID."
2193   (let ((thread (gnus-id-to-thread id)))
2194     (when (and thread
2195                (car thread))
2196       (mail-header-number (car thread)))))
2197
2198 (defun gnus-id-to-header (id)
2199   "Return the article headers of ID."
2200   (car (gnus-id-to-thread id)))
2201
2202 (defun gnus-article-displayed-root-p (article)
2203   "Say whether ARTICLE is a root(ish) article."
2204   (let ((level (gnus-summary-thread-level article))
2205         (refs (mail-header-references  (gnus-summary-article-header article)))
2206         particle)
2207     (cond 
2208      ((null level) nil)
2209      ((zerop level) t)
2210      ((null refs) t)
2211      ((null (gnus-parent-id refs)) t)
2212      ((and (= 1 level)
2213            (null (setq particle (gnus-id-to-article
2214                                  (gnus-parent-id refs))))
2215            (null (gnus-summary-thread-level particle)))))))
2216
2217 (defun gnus-root-id (id)
2218   "Return the id of the root of the thread where ID appears."
2219   (let (last-id prev)
2220     (while (and id (setq prev (car (gnus-gethash 
2221                                     id gnus-newsgroup-dependencies))))
2222       (setq last-id id
2223             id (gnus-parent-id (mail-header-references prev))))
2224     last-id))
2225
2226 (defun gnus-remove-thread (id &optional dont-remove)
2227   "Remove the thread that has ID in it."
2228   (let ((dep gnus-newsgroup-dependencies)
2229         headers thread last-id)
2230     ;; First go up in this thread until we find the root.
2231     (setq last-id (gnus-root-id id))
2232     (setq headers (list (car (gnus-id-to-thread last-id))
2233                         (caadr (gnus-id-to-thread last-id))))
2234     ;; We have now found the real root of this thread.  It might have
2235     ;; been gathered into some loose thread, so we have to search
2236     ;; through the threads to find the thread we wanted.
2237     (let ((threads gnus-newsgroup-threads)
2238           sub)
2239       (while threads
2240         (setq sub (car threads))
2241         (if (stringp (car sub))
2242             ;; This is a gathered thread, so we look at the roots
2243             ;; below it to find whether this article is in this
2244             ;; gathered root.
2245             (progn
2246               (setq sub (cdr sub))
2247               (while sub
2248                 (when (member (caar sub) headers)
2249                   (setq thread (car threads)
2250                         threads nil
2251                         sub nil))
2252                 (setq sub (cdr sub))))
2253           ;; It's an ordinary thread, so we check it.
2254           (when (eq (car sub) (car headers))
2255             (setq thread sub
2256                   threads nil)))
2257         (setq threads (cdr threads)))
2258       ;; If this article is in no thread, then it's a root.
2259       (if thread
2260           (unless dont-remove
2261             (setq gnus-newsgroup-threads (delq thread gnus-newsgroup-threads)))
2262         (setq thread (gnus-gethash last-id dep)))
2263       (when thread
2264         (prog1
2265             thread ; We return this thread.
2266           (unless dont-remove
2267             (if (stringp (car thread))
2268                 (progn
2269                   ;; If we use dummy roots, then we have to remove the
2270                   ;; dummy root as well.
2271                   (when (eq gnus-summary-make-false-root 'dummy)
2272                     ;; Uhm.
2273                     )
2274                   (setq thread (cdr thread))
2275                   (while thread
2276                     (gnus-remove-thread-1 (car thread))
2277                     (setq thread (cdr thread))))
2278               (gnus-remove-thread-1 thread))))))))
2279
2280 (defun gnus-remove-thread-1 (thread)
2281   "Remove the thread THREAD recursively."
2282   (let ((number (mail-header-number (car thread)))
2283         pos)
2284     (when (setq pos (text-property-any
2285                      (point-min) (point-max) 'gnus-number number))
2286       (goto-char pos)
2287       (gnus-delete-line)
2288       (gnus-data-remove number))
2289     (setq thread (cdr thread))
2290     (while thread
2291       (gnus-remove-thread-1 (pop thread)))))
2292
2293 (defun gnus-sort-threads (threads)
2294   "Sort THREADS."
2295   (if (not gnus-thread-sort-functions)
2296       threads
2297     (let ((func (if (= 1 (length gnus-thread-sort-functions))
2298                     (car gnus-thread-sort-functions)
2299                   `(lambda (t1 t2)
2300                      ,(gnus-make-sort-function 
2301                        (reverse gnus-thread-sort-functions))))))
2302       (gnus-message 7 "Sorting threads...")
2303       (prog1
2304           (sort threads func)
2305         (gnus-message 7 "Sorting threads...done")))))
2306
2307 (defun gnus-sort-articles (articles)
2308   "Sort ARTICLES."
2309   (when gnus-article-sort-functions
2310     (let ((func (if (= 1 (length gnus-article-sort-functions))
2311                     (car gnus-article-sort-functions)
2312                   `(lambda (t1 t2)
2313                      ,(gnus-make-sort-function 
2314                        (reverse gnus-article-sort-functions))))))
2315       (gnus-message 7 "Sorting articles...")
2316       (prog1
2317           (setq gnus-newsgroup-headers (sort articles func))
2318         (gnus-message 7 "Sorting articles...done")))))
2319
2320 ;; Written by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
2321 (defmacro gnus-thread-header (thread)
2322   ;; Return header of first article in THREAD.
2323   ;; Note that THREAD must never, ever be anything else than a variable -
2324   ;; using some other form will lead to serious barfage.
2325   (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread)))
2326   ;; (8% speedup to gnus-summary-prepare, just for fun :-)
2327   (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" ;
2328         (vector thread) 2))
2329
2330 (defsubst gnus-article-sort-by-number (h1 h2)
2331   "Sort articles by article number."
2332   (< (mail-header-number h1)
2333      (mail-header-number h2)))
2334
2335 (defun gnus-thread-sort-by-number (h1 h2)
2336   "Sort threads by root article number."
2337   (gnus-article-sort-by-number
2338    (gnus-thread-header h1) (gnus-thread-header h2)))
2339
2340 (defsubst gnus-article-sort-by-author (h1 h2)
2341   "Sort articles by root author."
2342   (string-lessp
2343    (let ((extract (funcall
2344                    gnus-extract-address-components
2345                    (mail-header-from h1))))
2346      (or (car extract) (cdr extract)))
2347    (let ((extract (funcall
2348                    gnus-extract-address-components
2349                    (mail-header-from h2))))
2350      (or (car extract) (cdr extract)))))
2351
2352 (defun gnus-thread-sort-by-author (h1 h2)
2353   "Sort threads by root author."
2354   (gnus-article-sort-by-author
2355    (gnus-thread-header h1)  (gnus-thread-header h2)))
2356
2357 (defsubst gnus-article-sort-by-subject (h1 h2)
2358   "Sort articles by root subject."
2359   (string-lessp
2360    (downcase (gnus-simplify-subject-re (mail-header-subject h1)))
2361    (downcase (gnus-simplify-subject-re (mail-header-subject h2)))))
2362
2363 (defun gnus-thread-sort-by-subject (h1 h2)
2364   "Sort threads by root subject."
2365   (gnus-article-sort-by-subject
2366    (gnus-thread-header h1) (gnus-thread-header h2)))
2367
2368 (defsubst gnus-article-sort-by-date (h1 h2)
2369   "Sort articles by root article date."
2370   (string-lessp
2371    (inline (gnus-sortable-date (mail-header-date h1)))
2372    (inline (gnus-sortable-date (mail-header-date h2)))))
2373
2374 (defun gnus-thread-sort-by-date (h1 h2)
2375   "Sort threads by root article date."
2376   (gnus-article-sort-by-date
2377    (gnus-thread-header h1) (gnus-thread-header h2)))
2378
2379 (defsubst gnus-article-sort-by-score (h1 h2)
2380   "Sort articles by root article score.
2381 Unscored articles will be counted as having a score of zero."
2382   (> (or (cdr (assq (mail-header-number h1)
2383                     gnus-newsgroup-scored))
2384          gnus-summary-default-score 0)
2385      (or (cdr (assq (mail-header-number h2)
2386                     gnus-newsgroup-scored))
2387          gnus-summary-default-score 0)))
2388
2389 (defun gnus-thread-sort-by-score (h1 h2)
2390   "Sort threads by root article score."
2391   (gnus-article-sort-by-score
2392    (gnus-thread-header h1) (gnus-thread-header h2)))
2393
2394 (defun gnus-thread-sort-by-total-score (h1 h2)
2395   "Sort threads by the sum of all scores in the thread.
2396 Unscored articles will be counted as having a score of zero."
2397   (> (gnus-thread-total-score h1) (gnus-thread-total-score h2)))
2398
2399 (defun gnus-thread-total-score (thread)
2400   ;;  This function find the total score of THREAD.
2401   (cond ((null thread)
2402          0)
2403         ((consp thread)
2404          (if (stringp (car thread))
2405              (apply gnus-thread-score-function 0
2406                     (mapcar 'gnus-thread-total-score-1 (cdr thread)))
2407            (gnus-thread-total-score-1 thread)))
2408         (t
2409          (gnus-thread-total-score-1 (list thread)))))
2410
2411 (defun gnus-thread-total-score-1 (root)
2412   ;; This function find the total score of the thread below ROOT.
2413   (setq root (car root))
2414   (apply gnus-thread-score-function
2415          (or (append
2416               (mapcar 'gnus-thread-total-score
2417                       (cdr (gnus-gethash (mail-header-id root)
2418                                          gnus-newsgroup-dependencies)))
2419                  (if (> (mail-header-number root) 0)
2420                      (list (or (cdr (assq (mail-header-number root) 
2421                                           gnus-newsgroup-scored))
2422                                gnus-summary-default-score 0))))
2423              (list gnus-summary-default-score)
2424              '(0))))
2425
2426 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
2427 (defvar gnus-tmp-prev-subject nil)
2428 (defvar gnus-tmp-false-parent nil)
2429 (defvar gnus-tmp-root-expunged nil)
2430 (defvar gnus-tmp-dummy-line nil)
2431
2432 (defun gnus-summary-prepare-threads (threads)
2433   "Prepare summary buffer from THREADS and indentation LEVEL.
2434 THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])'
2435 or a straight list of headers."
2436   (gnus-message 7 "Generating summary...")
2437
2438   (setq gnus-newsgroup-threads threads)
2439   (beginning-of-line)
2440
2441   (let ((gnus-tmp-level 0)
2442         (default-score (or gnus-summary-default-score 0))
2443         (gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight))
2444         thread number subject stack state gnus-tmp-gathered beg-match
2445         new-roots gnus-tmp-new-adopts thread-end
2446         gnus-tmp-header gnus-tmp-unread
2447         gnus-tmp-replied gnus-tmp-subject-or-nil
2448         gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score
2449         gnus-tmp-score-char gnus-tmp-from gnus-tmp-name
2450         gnus-tmp-number gnus-tmp-opening-bracket gnus-tmp-closing-bracket)
2451
2452     (setq gnus-tmp-prev-subject nil)
2453
2454     (if (vectorp (car threads))
2455         ;; If this is a straight (sic) list of headers, then a
2456         ;; threaded summary display isn't required, so we just create
2457         ;; an unthreaded one.
2458         (gnus-summary-prepare-unthreaded threads)
2459
2460       ;; Do the threaded display.
2461
2462       (while (or threads stack gnus-tmp-new-adopts new-roots)
2463
2464         (if (and (= gnus-tmp-level 0)
2465                  (not (setq gnus-tmp-dummy-line nil))
2466                  (or (not stack)
2467                      (= (caar stack) 0))
2468                  (not gnus-tmp-false-parent)
2469                  (or gnus-tmp-new-adopts new-roots))
2470             (if gnus-tmp-new-adopts
2471                 (setq gnus-tmp-level (if gnus-tmp-root-expunged 0 1)
2472                       thread (list (car gnus-tmp-new-adopts))
2473                       gnus-tmp-header (caar thread)
2474                       gnus-tmp-new-adopts (cdr gnus-tmp-new-adopts))
2475               (if new-roots
2476                   (setq thread (list (car new-roots))
2477                         gnus-tmp-header (caar thread)
2478                         new-roots (cdr new-roots))))
2479
2480           (if threads
2481               ;; If there are some threads, we do them before the
2482               ;; threads on the stack.
2483               (setq thread threads
2484                     gnus-tmp-header (caar thread))
2485             ;; There were no current threads, so we pop something off
2486             ;; the stack.
2487             (setq state (car stack)
2488                   gnus-tmp-level (car state)
2489                   thread (cdr state)
2490                   stack (cdr stack)
2491                   gnus-tmp-header (caar thread))))
2492
2493         (setq gnus-tmp-false-parent nil)
2494         (setq gnus-tmp-root-expunged nil)
2495         (setq thread-end nil)
2496
2497         (if (stringp gnus-tmp-header)
2498             ;; The header is a dummy root.
2499             (cond
2500              ((eq gnus-summary-make-false-root 'adopt)
2501               ;; We let the first article adopt the rest.
2502               (setq gnus-tmp-new-adopts (nconc gnus-tmp-new-adopts
2503                                                (cddar thread)))
2504               (setq gnus-tmp-gathered
2505                     (nconc (mapcar
2506                             (lambda (h) (mail-header-number (car h)))
2507                             (cddar thread))
2508                            gnus-tmp-gathered))
2509               (setq thread (cons (list (caar thread)
2510                                        (cadar thread))
2511                                  (cdr thread)))
2512               (setq gnus-tmp-level -1
2513                     gnus-tmp-false-parent t))
2514              ((eq gnus-summary-make-false-root 'empty)
2515               ;; We print adopted articles with empty subject fields.
2516               (setq gnus-tmp-gathered
2517                     (nconc (mapcar
2518                             (lambda (h) (mail-header-number (car h)))
2519                             (cddar thread))
2520                            gnus-tmp-gathered))
2521               (setq gnus-tmp-level -1))
2522              ((eq gnus-summary-make-false-root 'dummy)
2523               ;; We remember that we probably want to output a dummy
2524               ;; root.
2525               (setq gnus-tmp-dummy-line gnus-tmp-header)
2526               (setq gnus-tmp-prev-subject gnus-tmp-header))
2527              (t
2528               ;; We do not make a root for the gathered
2529               ;; sub-threads at all.
2530               (setq gnus-tmp-level -1)))
2531
2532           (setq number (mail-header-number gnus-tmp-header)
2533                 subject (mail-header-subject gnus-tmp-header))
2534
2535           (cond
2536            ;; If the thread has changed subject, we might want to make
2537            ;; this subthread into a root.
2538            ((and (null gnus-thread-ignore-subject)
2539                  (not (zerop gnus-tmp-level))
2540                  gnus-tmp-prev-subject
2541                  (not (inline
2542                         (gnus-subject-equal gnus-tmp-prev-subject subject))))
2543             (setq new-roots (nconc new-roots (list (car thread)))
2544                   thread-end t
2545                   gnus-tmp-header nil))
2546            ;; If the article lies outside the current limit,
2547            ;; then we do not display it.
2548            ((and (not (memq number gnus-newsgroup-limit))
2549                  (not gnus-tmp-dummy-line))
2550             (setq gnus-tmp-gathered
2551                   (nconc (mapcar
2552                           (lambda (h) (mail-header-number (car h)))
2553                           (cdar thread))
2554                          gnus-tmp-gathered))
2555             (setq gnus-tmp-new-adopts (if (cdar thread)
2556                                           (append gnus-tmp-new-adopts
2557                                                   (cdar thread))
2558                                         gnus-tmp-new-adopts)
2559                   thread-end t
2560                   gnus-tmp-header nil)
2561             (when (zerop gnus-tmp-level)
2562               (setq gnus-tmp-root-expunged t)))
2563            ;; Perhaps this article is to be marked as read?
2564            ((and gnus-summary-mark-below
2565                  (< (or (cdr (assq number gnus-newsgroup-scored))
2566                         default-score)
2567                     gnus-summary-mark-below)
2568                  ;; Don't touch sparse articles.
2569                  (not (memq number gnus-newsgroup-sparse))
2570                  (not (memq number gnus-newsgroup-ancient)))
2571             (setq gnus-newsgroup-unreads
2572                   (delq number gnus-newsgroup-unreads))
2573             (if gnus-newsgroup-auto-expire
2574                 (push number gnus-newsgroup-expirable)
2575               (push (cons number gnus-low-score-mark)
2576                     gnus-newsgroup-reads))))
2577
2578           (when gnus-tmp-header
2579             ;; We may have an old dummy line to output before this
2580             ;; article.
2581             (when gnus-tmp-dummy-line
2582               (gnus-summary-insert-dummy-line
2583                gnus-tmp-dummy-line (mail-header-number gnus-tmp-header))
2584               (setq gnus-tmp-dummy-line nil))
2585
2586             ;; Compute the mark.
2587             (setq gnus-tmp-unread (gnus-article-mark number))
2588
2589             (push (gnus-data-make number gnus-tmp-unread (1+ (point))
2590                                   gnus-tmp-header gnus-tmp-level)
2591                   gnus-newsgroup-data)
2592
2593             ;; Actually insert the line.
2594             (setq
2595              gnus-tmp-subject-or-nil
2596              (cond
2597               ((and gnus-thread-ignore-subject
2598                     gnus-tmp-prev-subject
2599                     (not (inline (gnus-subject-equal
2600                                   gnus-tmp-prev-subject subject))))
2601                subject)
2602               ((zerop gnus-tmp-level)
2603                (if (and (eq gnus-summary-make-false-root 'empty)
2604                         (memq number gnus-tmp-gathered)
2605                         gnus-tmp-prev-subject
2606                         (inline (gnus-subject-equal
2607                                  gnus-tmp-prev-subject subject)))
2608                    gnus-summary-same-subject
2609                  subject))
2610               (t gnus-summary-same-subject)))
2611             (if (and (eq gnus-summary-make-false-root 'adopt)
2612                      (= gnus-tmp-level 1)
2613                      (memq number gnus-tmp-gathered))
2614                 (setq gnus-tmp-opening-bracket ?\<
2615                       gnus-tmp-closing-bracket ?\>)
2616               (setq gnus-tmp-opening-bracket ?\[
2617                     gnus-tmp-closing-bracket ?\]))
2618             (setq
2619              gnus-tmp-indentation
2620              (aref gnus-thread-indent-array gnus-tmp-level)
2621              gnus-tmp-lines (mail-header-lines gnus-tmp-header)
2622              gnus-tmp-score (or (cdr (assq number gnus-newsgroup-scored))
2623                                 gnus-summary-default-score 0)
2624              gnus-tmp-score-char
2625              (if (or (null gnus-summary-default-score)
2626                      (<= (abs (- gnus-tmp-score gnus-summary-default-score))
2627                          gnus-summary-zcore-fuzz)) ? 
2628                (if (< gnus-tmp-score gnus-summary-default-score)
2629                    gnus-score-below-mark gnus-score-over-mark))
2630              gnus-tmp-replied
2631              (cond ((memq number gnus-newsgroup-processable)
2632                     gnus-process-mark)
2633                    ((memq number gnus-newsgroup-cached)
2634                     gnus-cached-mark)
2635                    ((memq number gnus-newsgroup-replied)
2636                     gnus-replied-mark)
2637                    ((memq number gnus-newsgroup-saved)
2638                     gnus-saved-mark)
2639                    (t gnus-unread-mark))
2640              gnus-tmp-from (mail-header-from gnus-tmp-header)
2641              gnus-tmp-name
2642              (cond
2643               ((string-match "(.+)" gnus-tmp-from)
2644                (substring gnus-tmp-from
2645                           (1+ (match-beginning 0)) (1- (match-end 0))))
2646               ((string-match "<[^>]+> *$" gnus-tmp-from)
2647                (setq beg-match (match-beginning 0))
2648                (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
2649                         (substring gnus-tmp-from (1+ (match-beginning 0))
2650                                    (1- (match-end 0))))
2651                    (substring gnus-tmp-from 0 beg-match)))
2652               (t gnus-tmp-from)))
2653             (when (string= gnus-tmp-name "")
2654               (setq gnus-tmp-name gnus-tmp-from))
2655             (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0))
2656             (gnus-put-text-property
2657              (point)
2658              (progn (eval gnus-summary-line-format-spec) (point))
2659              'gnus-number number)
2660             (when gnus-visual-p
2661               (forward-line -1)
2662               (run-hooks 'gnus-summary-update-hook)
2663               (forward-line 1))
2664
2665             (setq gnus-tmp-prev-subject subject)))
2666
2667         (when (nth 1 thread)
2668           (push (cons (max 0 gnus-tmp-level) (nthcdr 1 thread)) stack))
2669         (incf gnus-tmp-level)
2670         (setq threads (if thread-end nil (cdar thread)))
2671         (unless threads
2672           (setq gnus-tmp-level 0)))))
2673   (gnus-message 7 "Generating summary...done"))
2674
2675 (defun gnus-summary-prepare-unthreaded (headers)
2676   "Generate an unthreaded summary buffer based on HEADERS."
2677   (let (header number mark)
2678
2679     (while headers
2680       ;; We may have to root out some bad articles...
2681       (when (memq (setq number (mail-header-number
2682                                 (setq header (pop headers))))
2683                   gnus-newsgroup-limit)
2684         ;; Mark article as read when it has a low score.
2685         (when (and gnus-summary-mark-below
2686                    (< (or (cdr (assq number gnus-newsgroup-scored))
2687                           gnus-summary-default-score 0)
2688                       gnus-summary-mark-below)
2689                    (not (memq number gnus-newsgroup-ancient)))
2690           (setq gnus-newsgroup-unreads
2691                 (delq number gnus-newsgroup-unreads))
2692           (if gnus-newsgroup-auto-expire
2693               (push number gnus-newsgroup-expirable)
2694             (push (cons number gnus-low-score-mark)
2695                   gnus-newsgroup-reads)))
2696
2697         (setq mark (gnus-article-mark number))
2698         (setq gnus-newsgroup-data
2699               (cons (gnus-data-make number mark (1+ (point)) header 0)
2700                     gnus-newsgroup-data))
2701         (gnus-summary-insert-line
2702          header 0 nil mark (memq number gnus-newsgroup-replied)
2703          (memq number gnus-newsgroup-expirable)
2704          (mail-header-subject header) nil
2705          (cdr (assq number gnus-newsgroup-scored))
2706          (memq number gnus-newsgroup-processable))))))
2707
2708 (defun gnus-select-newsgroup (group &optional read-all)
2709   "Select newsgroup GROUP.
2710 If READ-ALL is non-nil, all articles in the group are selected."
2711   (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
2712          (info (nth 2 entry))
2713          articles fetched-articles cached)
2714
2715     (or (gnus-check-server
2716          (setq gnus-current-select-method (gnus-find-method-for-group group)))
2717         (error "Couldn't open server"))
2718
2719     (or (and entry (not (eq (car entry) t))) ; Either it's active...
2720         (gnus-activate-group group)     ; Or we can activate it...
2721         (progn                          ; Or we bug out.
2722           (when (equal major-mode 'gnus-summary-mode)
2723             (kill-buffer (current-buffer)))
2724           (error "Couldn't request group %s: %s"
2725                  group (gnus-status-message group))))
2726
2727     (unless (gnus-request-group group t)
2728       (when (equal major-mode 'gnus-summary-mode)
2729         (kill-buffer (current-buffer)))
2730       (error "Couldn't request group %s: %s"
2731              group (gnus-status-message group)))      
2732
2733     (setq gnus-newsgroup-name group)
2734     (setq gnus-newsgroup-unselected nil)
2735     (setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group))
2736
2737     ;; Adjust and set lists of article marks.
2738     (when info
2739       (gnus-adjust-marked-articles info))
2740
2741     ;; Kludge to avoid having cached articles nixed out in virtual groups.
2742     (when (gnus-virtual-group-p group)
2743       (setq cached gnus-newsgroup-cached))
2744
2745     (setq gnus-newsgroup-unreads
2746           (gnus-set-difference
2747            (gnus-set-difference gnus-newsgroup-unreads gnus-newsgroup-marked)
2748            gnus-newsgroup-dormant))
2749
2750     (setq gnus-newsgroup-processable nil)
2751
2752     (setq articles (gnus-articles-to-read group read-all))
2753
2754     (cond
2755      ((null articles)
2756       ;;(gnus-message 3 "Couldn't select newsgroup -- no articles to display")
2757       'quit)
2758      ((eq articles 0) nil)
2759      (t
2760       ;; Init the dependencies hash table.
2761       (setq gnus-newsgroup-dependencies
2762             (gnus-make-hashtable (length articles)))
2763       ;; Retrieve the headers and read them in.
2764       (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name)
2765       (setq gnus-newsgroup-headers
2766             (if (eq 'nov
2767                     (setq gnus-headers-retrieved-by
2768                           (gnus-retrieve-headers
2769                            articles gnus-newsgroup-name
2770                            ;; We might want to fetch old headers, but
2771                            ;; not if there is only 1 article.
2772                            (and gnus-fetch-old-headers
2773                                 (or (and
2774                                      (not (eq gnus-fetch-old-headers 'some))
2775                                      (not (numberp gnus-fetch-old-headers)))
2776                                     (> (length articles) 1))))))
2777                 (gnus-get-newsgroup-headers-xover articles)
2778               (gnus-get-newsgroup-headers)))
2779       (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name)
2780
2781       ;; Kludge to avoid having cached articles nixed out in virtual groups.
2782       (when cached
2783         (setq gnus-newsgroup-cached cached))
2784
2785       ;; Suppress duplicates?
2786       (when gnus-suppress-duplicates
2787         (gnus-dup-suppress-articles))
2788
2789       ;; Set the initial limit.
2790       (setq gnus-newsgroup-limit (copy-sequence articles))
2791       ;; Remove canceled articles from the list of unread articles.
2792       (setq gnus-newsgroup-unreads
2793             (gnus-set-sorted-intersection
2794              gnus-newsgroup-unreads
2795              (setq fetched-articles
2796                    (mapcar (lambda (headers) (mail-header-number headers))
2797                            gnus-newsgroup-headers))))
2798       ;; Removed marked articles that do not exist.
2799       (gnus-update-missing-marks
2800        (gnus-sorted-complement fetched-articles articles))
2801       ;; We might want to build some more threads first.
2802       (and gnus-fetch-old-headers
2803            (eq gnus-headers-retrieved-by 'nov)
2804            (gnus-build-old-threads))
2805       ;; Check whether auto-expire is to be done in this group.
2806       (setq gnus-newsgroup-auto-expire
2807             (gnus-group-auto-expirable-p group))
2808       ;; Set up the article buffer now, if necessary.
2809       (unless gnus-single-article-buffer
2810         (gnus-article-setup-buffer))
2811       ;; First and last article in this newsgroup.
2812       (when gnus-newsgroup-headers
2813         (setq gnus-newsgroup-begin
2814               (mail-header-number (car gnus-newsgroup-headers))
2815               gnus-newsgroup-end
2816               (mail-header-number
2817                (gnus-last-element gnus-newsgroup-headers))))
2818       ;; GROUP is successfully selected.
2819       (or gnus-newsgroup-headers t)))))
2820
2821 (defun gnus-articles-to-read (group read-all)
2822   ;; Find out what articles the user wants to read.
2823   (let* ((articles
2824           ;; Select all articles if `read-all' is non-nil, or if there
2825           ;; are no unread articles.
2826           (if (or read-all
2827                   (and (zerop (length gnus-newsgroup-marked))
2828                        (zerop (length gnus-newsgroup-unreads))))
2829               (gnus-uncompress-range (gnus-active group))
2830             (sort (append gnus-newsgroup-dormant gnus-newsgroup-marked
2831                           (copy-sequence gnus-newsgroup-unreads))
2832                   '<)))
2833          (scored-list (gnus-killed-articles gnus-newsgroup-killed articles))
2834          (scored (length scored-list))
2835          (number (length articles))
2836          (marked (+ (length gnus-newsgroup-marked)
2837                     (length gnus-newsgroup-dormant)))
2838          (select
2839           (cond
2840            ((numberp read-all)
2841             read-all)
2842            (t
2843             (condition-case ()
2844                 (cond
2845                  ((and (or (<= scored marked) (= scored number))
2846                        (numberp gnus-large-newsgroup)
2847                        (> number gnus-large-newsgroup))
2848                   (let ((input
2849                          (read-string
2850                           (format
2851                            "How many articles from %s (default %d): "
2852                            gnus-newsgroup-name number))))
2853                     (if (string-match "^[ \t]*$" input) number input)))
2854                  ((and (> scored marked) (< scored number)
2855                        (> (- scored number) 20))
2856                   (let ((input
2857                          (read-string
2858                           (format "%s %s (%d scored, %d total): "
2859                                   "How many articles from"
2860                                   group scored number))))
2861                     (if (string-match "^[ \t]*$" input)
2862                         number input)))
2863                  (t number))
2864               (quit nil))))))
2865     (setq select (if (stringp select) (string-to-number select) select))
2866     (if (or (null select) (zerop select))
2867         select
2868       (if (and (not (zerop scored)) (<= (abs select) scored))
2869           (progn
2870             (setq articles (sort scored-list '<))
2871             (setq number (length articles)))
2872         (setq articles (copy-sequence articles)))
2873
2874       (if (< (abs select) number)
2875           (if (< select 0)
2876               ;; Select the N oldest articles.
2877               (setcdr (nthcdr (1- (abs select)) articles) nil)
2878             ;; Select the N most recent articles.
2879             (setq articles (nthcdr (- number select) articles))))
2880       (setq gnus-newsgroup-unselected
2881             (gnus-sorted-intersection
2882              gnus-newsgroup-unreads
2883              (gnus-sorted-complement gnus-newsgroup-unreads articles)))
2884       articles)))
2885
2886 (defun gnus-killed-articles (killed articles)
2887   (let (out)
2888     (while articles
2889       (if (inline (gnus-member-of-range (car articles) killed))
2890           (setq out (cons (car articles) out)))
2891       (setq articles (cdr articles)))
2892     out))
2893
2894 (defun gnus-uncompress-marks (marks)
2895   "Uncompress the mark ranges in MARKS."
2896   (let ((uncompressed '(score bookmark))
2897         out)
2898     (while marks
2899       (if (memq (caar marks) uncompressed)
2900           (push (car marks) out)
2901         (push (cons (caar marks) (gnus-uncompress-range (cdar marks))) out))
2902       (setq marks (cdr marks)))
2903     out))
2904
2905 (defun gnus-adjust-marked-articles (info)
2906   "Set all article lists and remove all marks that are no longer legal."
2907   (let* ((marked-lists (gnus-info-marks info))
2908          (active (gnus-active (gnus-info-group info)))
2909          (min (car active))
2910          (max (cdr active))
2911          (types gnus-article-mark-lists)
2912          (uncompressed '(score bookmark killed))
2913          marks var articles article mark)
2914
2915     (while marked-lists
2916       (setq marks (pop marked-lists))
2917       (set (setq var (intern (format "gnus-newsgroup-%s"
2918                                      (car (rassq (setq mark (car marks))
2919                                                  types)))))
2920            (if (memq (car marks) uncompressed) (cdr marks)
2921              (gnus-uncompress-range (cdr marks))))
2922
2923       (setq articles (symbol-value var))
2924
2925       ;; All articles have to be subsets of the active articles.
2926       (cond
2927        ;; Adjust "simple" lists.
2928        ((memq mark '(tick dormant expirable reply save))
2929         (while articles
2930           (when (or (< (setq article (pop articles)) min) (> article max))
2931             (set var (delq article (symbol-value var))))))
2932        ;; Adjust assocs.
2933        ((memq mark uncompressed)
2934         (while articles
2935           (when (or (not (consp (setq article (pop articles))))
2936                     (< (car article) min)
2937                     (> (car article) max))
2938             (set var (delq article (symbol-value var))))))))))
2939
2940 (defun gnus-update-missing-marks (missing)
2941   "Go through the list of MISSING articles and remove them mark lists."
2942   (when missing
2943     (let ((types gnus-article-mark-lists)
2944           var m)
2945       ;; Go through all types.
2946       (while types
2947         (setq var (intern (format "gnus-newsgroup-%s" (car (pop types)))))
2948         (when (symbol-value var)
2949           ;; This list has articles.  So we delete all missing articles
2950           ;; from it.
2951           (setq m missing)
2952           (while m
2953             (set var (delq (pop m) (symbol-value var)))))))))
2954
2955 (defun gnus-update-marks ()
2956   "Enter the various lists of marked articles into the newsgroup info list."
2957   (let ((types gnus-article-mark-lists)
2958         (info (gnus-get-info gnus-newsgroup-name))
2959         (uncompressed '(score bookmark killed))
2960         type list newmarked symbol)
2961     (when info
2962       ;; Add all marks lists that are non-nil to the list of marks lists.
2963       (while types
2964         (setq type (pop types))
2965         (when (setq list (symbol-value
2966                           (setq symbol
2967                                 (intern (format "gnus-newsgroup-%s"
2968                                                 (car type))))))
2969           (push (cons (cdr type)
2970                       (if (memq (cdr type) uncompressed) list
2971                         (gnus-compress-sequence 
2972                          (set symbol (sort list '<)) t)))
2973                 newmarked)))
2974
2975       ;; Enter these new marks into the info of the group.
2976       (if (nthcdr 3 info)
2977           (setcar (nthcdr 3 info) newmarked)
2978         ;; Add the marks lists to the end of the info.
2979         (when newmarked
2980           (setcdr (nthcdr 2 info) (list newmarked))))
2981
2982       ;; Cut off the end of the info if there's nothing else there.
2983       (let ((i 5))
2984         (while (and (> i 2)
2985                     (not (nth i info)))
2986           (when (nthcdr (decf i) info)
2987             (setcdr (nthcdr i info) nil)))))))
2988
2989 (defun gnus-set-mode-line (where)
2990   "This function sets the mode line of the article or summary buffers.
2991 If WHERE is `summary', the summary mode line format will be used."
2992   ;; Is this mode line one we keep updated?
2993   (when (memq where gnus-updated-mode-lines)
2994     (let (mode-string)
2995       (save-excursion
2996         ;; We evaluate this in the summary buffer since these
2997         ;; variables are buffer-local to that buffer.
2998         (set-buffer gnus-summary-buffer)
2999         ;; We bind all these variables that are used in the `eval' form
3000         ;; below.
3001         (let* ((mformat (symbol-value
3002                          (intern
3003                           (format "gnus-%s-mode-line-format-spec" where))))
3004                (gnus-tmp-group-name gnus-newsgroup-name)
3005                (gnus-tmp-article-number (or gnus-current-article 0))
3006                (gnus-tmp-unread gnus-newsgroup-unreads)
3007                (gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads))
3008                (gnus-tmp-unselected (length gnus-newsgroup-unselected))
3009                (gnus-tmp-unread-and-unselected
3010                 (cond ((and (zerop gnus-tmp-unread-and-unticked)
3011                             (zerop gnus-tmp-unselected)) "")
3012                       ((zerop gnus-tmp-unselected)
3013                        (format "{%d more}" gnus-tmp-unread-and-unticked))
3014                       (t (format "{%d(+%d) more}"
3015                                  gnus-tmp-unread-and-unticked
3016                                  gnus-tmp-unselected))))
3017                (gnus-tmp-subject
3018                 (if (and gnus-current-headers
3019                          (vectorp gnus-current-headers))
3020                     (gnus-mode-string-quote
3021                      (mail-header-subject gnus-current-headers)) ""))
3022                max-len
3023                gnus-tmp-header);; passed as argument to any user-format-funcs
3024           (setq mode-string (eval mformat))
3025           (setq max-len (max 4 (if gnus-mode-non-string-length
3026                                    (- (window-width)
3027                                       gnus-mode-non-string-length)
3028                                  (length mode-string))))
3029           ;; We might have to chop a bit of the string off...
3030           (when (> (length mode-string) max-len)
3031             (setq mode-string
3032                   (concat (gnus-truncate-string mode-string (- max-len 3))
3033                           "...")))
3034           ;; Pad the mode string a bit.
3035           (setq mode-string (format (format "%%-%ds" max-len) mode-string))))
3036       ;; Update the mode line.
3037       (setq mode-line-buffer-identification 
3038             (gnus-mode-line-buffer-identification
3039              (list mode-string)))
3040       (set-buffer-modified-p t))))
3041
3042 (defun gnus-create-xref-hashtb (from-newsgroup headers unreads)
3043   "Go through the HEADERS list and add all Xrefs to a hash table.
3044 The resulting hash table is returned, or nil if no Xrefs were found."
3045   (let* ((virtual (gnus-virtual-group-p from-newsgroup))
3046          (prefix (if virtual "" (gnus-group-real-prefix from-newsgroup)))
3047          (xref-hashtb (make-vector 63 0))
3048          start group entry number xrefs header)
3049     (while headers
3050       (setq header (pop headers))
3051       (when (and (setq xrefs (mail-header-xref header))
3052                  (not (memq (setq number (mail-header-number header))
3053                             unreads)))
3054         (setq start 0)
3055         (while (string-match "\\([^ ]+\\)[:/]\\([0-9]+\\)" xrefs start)
3056           (setq start (match-end 0))
3057           (setq group (if prefix
3058                           (concat prefix (substring xrefs (match-beginning 1)
3059                                                     (match-end 1)))
3060                         (substring xrefs (match-beginning 1) (match-end 1))))
3061           (setq number
3062                 (string-to-int (substring xrefs (match-beginning 2)
3063                                           (match-end 2))))
3064           (if (setq entry (gnus-gethash group xref-hashtb))
3065               (setcdr entry (cons number (cdr entry)))
3066             (gnus-sethash group (cons number nil) xref-hashtb)))))
3067     (and start xref-hashtb)))
3068
3069 (defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads)
3070   "Look through all the headers and mark the Xrefs as read."
3071   (let ((virtual (gnus-virtual-group-p from-newsgroup))
3072         name entry info xref-hashtb idlist method nth4)
3073     (save-excursion
3074       (set-buffer gnus-group-buffer)
3075       (when (setq xref-hashtb
3076                   (gnus-create-xref-hashtb from-newsgroup headers unreads))
3077         (mapatoms
3078          (lambda (group)
3079            (unless (string= from-newsgroup (setq name (symbol-name group)))
3080              (setq idlist (symbol-value group))
3081              ;; Dead groups are not updated.
3082              (and (prog1
3083                       (setq entry (gnus-gethash name gnus-newsrc-hashtb)
3084                             info (nth 2 entry))
3085                     (if (stringp (setq nth4 (gnus-info-method info)))
3086                         (setq nth4 (gnus-server-to-method nth4))))
3087                   ;; Only do the xrefs if the group has the same
3088                   ;; select method as the group we have just read.
3089                   (or (gnus-methods-equal-p
3090                        nth4 (gnus-find-method-for-group from-newsgroup))
3091                       virtual
3092                       (equal nth4 (setq method (gnus-find-method-for-group
3093                                                 from-newsgroup)))
3094                       (and (equal (car nth4) (car method))
3095                            (equal (nth 1 nth4) (nth 1 method))))
3096                   gnus-use-cross-reference
3097                   (or (not (eq gnus-use-cross-reference t))
3098                       virtual
3099                       ;; Only do cross-references on subscribed
3100                       ;; groups, if that is what is wanted.
3101                       (<= (gnus-info-level info) gnus-level-subscribed))
3102                   (gnus-group-make-articles-read name idlist))))
3103          xref-hashtb)))))
3104
3105 (defun gnus-group-make-articles-read (group articles)
3106   "Update the info of GROUP to say that only ARTICLES are unread."
3107   (let* ((num 0)
3108          (entry (gnus-gethash group gnus-newsrc-hashtb))
3109          (info (nth 2 entry))
3110          (active (gnus-active group))
3111          range)
3112     ;; First peel off all illegal article numbers.
3113     (when active
3114       (let ((ids articles)
3115             id first)
3116         (while (setq id (pop ids))
3117           (when (and first (> id (cdr active)))
3118             ;; We'll end up in this situation in one particular
3119             ;; obscure situation.  If you re-scan a group and get
3120             ;; a new article that is cross-posted to a different
3121             ;; group that has not been re-scanned, you might get
3122             ;; crossposted article that has a higher number than
3123             ;; Gnus believes possible.  So we re-activate this
3124             ;; group as well.  This might mean doing the
3125             ;; crossposting thingy will *increase* the number
3126             ;; of articles in some groups.  Tsk, tsk.
3127             (setq active (or (gnus-activate-group group) active)))
3128           (when (or (> id (cdr active))
3129                     (< id (car active)))
3130             (setq articles (delq id articles))))))
3131     (gnus-undo-register
3132       `(progn
3133          (gnus-info-set-marks ,info ,(gnus-info-marks info))
3134          (gnus-info-set-read ,info ,(gnus-info-read info))
3135          (gnus-group-update-group group t)))
3136     ;; If the read list is nil, we init it.
3137     (and active
3138          (null (gnus-info-read info))
3139          (> (car active) 1)
3140          (gnus-info-set-read info (cons 1 (1- (car active)))))
3141     ;; Then we add the read articles to the range.
3142     (gnus-info-set-read
3143      info
3144      (setq range
3145            (gnus-add-to-range
3146             (gnus-info-read info) (setq articles (sort articles '<)))))
3147     ;; Then we have to re-compute how many unread
3148     ;; articles there are in this group.
3149     (when active
3150       (cond
3151        ((not range)
3152         (setq num (- (1+ (cdr active)) (car active))))
3153        ((not (listp (cdr range)))
3154         (setq num (- (cdr active) (- (1+ (cdr range))
3155                                      (car range)))))
3156        (t
3157         (while range
3158           (if (numberp (car range))
3159               (setq num (1+ num))
3160             (setq num (+ num (- (1+ (cdar range)) (caar range)))))
3161           (setq range (cdr range)))
3162         (setq num (- (cdr active) num))))
3163       ;; Update the number of unread articles.
3164       (setcar entry num)
3165       ;; Update the group buffer.
3166       (gnus-group-update-group group t))))
3167
3168 (defun gnus-methods-equal-p (m1 m2)
3169   (let ((m1 (or m1 gnus-select-method))
3170         (m2 (or m2 gnus-select-method)))
3171     (or (equal m1 m2)
3172         (and (eq (car m1) (car m2))
3173              (or (not (memq 'address (assoc (symbol-name (car m1))
3174                                             gnus-valid-select-methods)))
3175                  (equal (nth 1 m1) (nth 1 m2)))))))
3176
3177 (defsubst gnus-header-value ()
3178   (buffer-substring (match-end 0) (gnus-point-at-eol)))
3179
3180 (defvar gnus-newsgroup-none-id 0)
3181
3182 (defun gnus-get-newsgroup-headers (&optional dependencies force-new)
3183   (let ((cur nntp-server-buffer)
3184         (dependencies
3185          (or dependencies
3186              (save-excursion (set-buffer gnus-summary-buffer)
3187                              gnus-newsgroup-dependencies)))
3188         headers id id-dep ref-dep end ref)
3189     (save-excursion
3190       (set-buffer nntp-server-buffer)
3191       (run-hooks 'gnus-parse-headers-hook)
3192       (let ((case-fold-search t)
3193             in-reply-to header p lines)
3194         (goto-char (point-min))
3195         ;; Search to the beginning of the next header.  Error messages
3196         ;; do not begin with 2 or 3.
3197         (while (re-search-forward "^[23][0-9]+ " nil t)
3198           (setq id nil
3199                 ref nil)
3200           ;; This implementation of this function, with nine
3201           ;; search-forwards instead of the one re-search-forward and
3202           ;; a case (which basically was the old function) is actually
3203           ;; about twice as fast, even though it looks messier.  You
3204           ;; can't have everything, I guess.  Speed and elegance
3205           ;; doesn't always go hand in hand.
3206           (setq
3207            header
3208            (vector
3209             ;; Number.
3210             (prog1
3211                 (read cur)
3212               (end-of-line)
3213               (setq p (point))
3214               (narrow-to-region (point)
3215                                 (or (and (search-forward "\n.\n" nil t)
3216                                          (- (point) 2))
3217                                     (point))))
3218             ;; Subject.
3219             (progn
3220               (goto-char p)
3221               (if (search-forward "\nsubject: " nil t)
3222                   (gnus-header-value) "(none)"))
3223             ;; From.
3224             (progn
3225               (goto-char p)
3226               (if (search-forward "\nfrom: " nil t)
3227                   (gnus-header-value) "(nobody)"))
3228             ;; Date.
3229             (progn
3230               (goto-char p)
3231               (if (search-forward "\ndate: " nil t)
3232                   (gnus-header-value) ""))
3233             ;; Message-ID.
3234             (progn
3235               (goto-char p)
3236               (if (search-forward "\nmessage-id: " nil t)
3237                   (setq id (gnus-header-value))
3238                 ;; If there was no message-id, we just fake one to make
3239                 ;; subsequent routines simpler.
3240                 (setq id (concat "none+"
3241                                  (int-to-string
3242                                   (setq gnus-newsgroup-none-id
3243                                         (1+ gnus-newsgroup-none-id)))))))
3244             ;; References.
3245             (progn
3246               (goto-char p)
3247               (if (search-forward "\nreferences: " nil t)
3248                   (progn
3249                     (setq end (point))
3250                     (prog1
3251                         (gnus-header-value)
3252                       (setq ref
3253                             (buffer-substring
3254                              (progn
3255                                (end-of-line)
3256                                (search-backward ">" end t)
3257                                (1+ (point)))
3258                              (progn
3259                                (search-backward "<" end t)
3260                                (point))))))
3261                 ;; Get the references from the in-reply-to header if there
3262                 ;; were no references and the in-reply-to header looks
3263                 ;; promising.
3264                 (if (and (search-forward "\nin-reply-to: " nil t)
3265                          (setq in-reply-to (gnus-header-value))
3266                          (string-match "<[^>]+>" in-reply-to))
3267                     (setq ref (substring in-reply-to (match-beginning 0)
3268                                          (match-end 0)))
3269                   (setq ref ""))))
3270             ;; Chars.
3271             0
3272             ;; Lines.
3273             (progn
3274               (goto-char p)
3275               (if (search-forward "\nlines: " nil t)
3276                   (if (numberp (setq lines (read cur)))
3277                       lines 0)
3278                 0))
3279             ;; Xref.
3280             (progn
3281               (goto-char p)
3282               (and (search-forward "\nxref: " nil t)
3283                    (gnus-header-value)))))
3284           ;; We do the threading while we read the headers.  The
3285           ;; message-id and the last reference are both entered into
3286           ;; the same hash table.  Some tippy-toeing around has to be
3287           ;; done in case an article has arrived before the article
3288           ;; which it refers to.
3289           (if (boundp (setq id-dep (intern id dependencies)))
3290               (if (and (car (symbol-value id-dep))
3291                        (not force-new))
3292                   ;; An article with this Message-ID has already
3293                   ;; been seen, so we ignore this one, except we add
3294                   ;; any additional Xrefs (in case the two articles
3295                   ;; came from different servers).
3296                   (progn
3297                     (mail-header-set-xref
3298                      (car (symbol-value id-dep))
3299                      (concat (or (mail-header-xref
3300                                   (car (symbol-value id-dep))) "")
3301                              (or (mail-header-xref header) "")))
3302                     (setq header nil))
3303                 (setcar (symbol-value id-dep) header))
3304             (set id-dep (list header)))
3305           (when header
3306             (if (boundp (setq ref-dep (intern ref dependencies)))
3307                 (setcdr (symbol-value ref-dep)
3308                         (nconc (cdr (symbol-value ref-dep))
3309                                (list (symbol-value id-dep))))
3310               (set ref-dep (list nil (symbol-value id-dep))))
3311             (setq headers (cons header headers)))
3312           (goto-char (point-max))
3313           (widen))
3314         (nreverse headers)))))
3315
3316 ;; The following macros and functions were written by Felix Lee
3317 ;; <flee@cse.psu.edu>.
3318
3319 (defmacro gnus-nov-read-integer ()
3320   '(prog1
3321        (if (= (following-char) ?\t)
3322            0
3323          (let ((num (condition-case nil (read buffer) (error nil))))
3324            (if (numberp num) num 0)))
3325      (or (eobp) (forward-char 1))))
3326
3327 (defmacro gnus-nov-skip-field ()
3328   '(search-forward "\t" eol 'move))
3329
3330 (defmacro gnus-nov-field ()
3331   '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol)))
3332
3333 ;; Goes through the xover lines and returns a list of vectors
3334 (defun gnus-get-newsgroup-headers-xover (sequence &optional 
3335                                                   force-new dependencies)
3336   "Parse the news overview data in the server buffer, and return a
3337 list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
3338   ;; Get the Xref when the users reads the articles since most/some
3339   ;; NNTP servers do not include Xrefs when using XOVER.
3340   (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
3341   (let ((cur nntp-server-buffer)
3342         (dependencies (or dependencies gnus-newsgroup-dependencies))
3343         number headers header)
3344     (save-excursion
3345       (set-buffer nntp-server-buffer)
3346       ;; Allow the user to mangle the headers before parsing them.
3347       (run-hooks 'gnus-parse-headers-hook)
3348       (goto-char (point-min))
3349       (while (and sequence (not (eobp)))
3350         (setq number (read cur))
3351         (while (and sequence (< (car sequence) number))
3352           (setq sequence (cdr sequence)))
3353         (and sequence
3354              (eq number (car sequence))
3355              (progn
3356                (setq sequence (cdr sequence))
3357                (if (setq header
3358                          (inline (gnus-nov-parse-line
3359                                   number dependencies force-new)))
3360                    (setq headers (cons header headers)))))
3361         (forward-line 1))
3362       (setq headers (nreverse headers)))
3363     headers))
3364
3365 ;; This function has to be called with point after the article number
3366 ;; on the beginning of the line.
3367 (defun gnus-nov-parse-line (number dependencies &optional force-new)
3368   (let ((none 0)
3369         (eol (gnus-point-at-eol))
3370         (buffer (current-buffer))
3371         header ref id id-dep ref-dep)
3372
3373     ;; overview: [num subject from date id refs chars lines misc]
3374     (narrow-to-region (point) eol)
3375     (or (eobp) (forward-char))
3376
3377     (condition-case nil
3378         (setq header
3379               (vector
3380                number                   ; number
3381                (gnus-nov-field)         ; subject
3382                (gnus-nov-field)         ; from
3383                (gnus-nov-field)         ; date
3384                (setq id (or (gnus-nov-field)
3385                             (concat "none+"
3386                                     (int-to-string
3387                                      (setq none (1+ none)))))) ; id
3388                (progn
3389                  (save-excursion
3390                    (let ((beg (point)))
3391                      (search-forward "\t" eol)
3392                      (if (search-backward ">" beg t)
3393                          (setq ref
3394                                (buffer-substring
3395                                 (1+ (point))
3396                                 (search-backward "<" beg t)))
3397                        (setq ref nil))))
3398                  (gnus-nov-field))      ; refs
3399                (gnus-nov-read-integer)  ; chars
3400                (gnus-nov-read-integer)  ; lines
3401                (if (= (following-char) ?\n)
3402                    nil
3403                  (gnus-nov-field))      ; misc
3404                ))
3405       (error (progn
3406                (gnus-error 4 "Strange nov line")
3407                (setq header nil)
3408                (goto-char eol))))
3409
3410     (widen)
3411
3412     ;; We build the thread tree.
3413     (when header
3414       (if (boundp (setq id-dep (intern id dependencies)))
3415           (if (and (car (symbol-value id-dep))
3416                    (not force-new))
3417               ;; An article with this Message-ID has already been seen,
3418               ;; so we ignore this one, except we add any additional
3419               ;; Xrefs (in case the two articles came from different
3420               ;; servers.
3421               (progn
3422                 (mail-header-set-xref
3423                  (car (symbol-value id-dep))
3424                  (concat (or (mail-header-xref
3425                               (car (symbol-value id-dep))) "")
3426                          (or (mail-header-xref header) "")))
3427                 (setq header nil))
3428             (setcar (symbol-value id-dep) header))
3429         (set id-dep (list header))))
3430     (when header
3431       (if (boundp (setq ref-dep (intern (or ref "none") dependencies)))
3432           (setcdr (symbol-value ref-dep)
3433                   (nconc (cdr (symbol-value ref-dep))
3434                          (list (symbol-value id-dep))))
3435         (set ref-dep (list nil (symbol-value id-dep)))))
3436     header))
3437
3438 (defun gnus-article-get-xrefs ()
3439   "Fill in the Xref value in `gnus-current-headers', if necessary.
3440 This is meant to be called in `gnus-article-internal-prepare-hook'."
3441   (let ((headers (save-excursion (set-buffer gnus-summary-buffer)
3442                                  gnus-current-headers)))
3443     (or (not gnus-use-cross-reference)
3444         (not headers)
3445         (and (mail-header-xref headers)
3446              (not (string= (mail-header-xref headers) "")))
3447         (let ((case-fold-search t)
3448               xref)
3449           (save-restriction
3450             (nnheader-narrow-to-headers)
3451             (goto-char (point-min))
3452             (if (or (and (eq (downcase (following-char)) ?x)
3453                          (looking-at "Xref:"))
3454                     (search-forward "\nXref:" nil t))
3455                 (progn
3456                   (goto-char (1+ (match-end 0)))
3457                   (setq xref (buffer-substring (point)
3458                                                (progn (end-of-line) (point))))
3459                   (mail-header-set-xref headers xref))))))))
3460
3461 (defun gnus-summary-insert-subject (id &optional old-header use-old-header)
3462   "Find article ID and insert the summary line for that article."
3463   (let ((header (if (and old-header use-old-header)
3464                     old-header (gnus-read-header id)))
3465         (number (and (numberp id) id))
3466         pos)
3467     (when header
3468       ;; Rebuild the thread that this article is part of and go to the
3469       ;; article we have fetched.
3470       (when (and (not gnus-show-threads)
3471                  old-header)
3472         (when (setq pos (text-property-any
3473                          (point-min) (point-max) 'gnus-number 
3474                          (mail-header-number old-header)))
3475           (goto-char pos)
3476           (gnus-delete-line)
3477           (gnus-data-remove (mail-header-number old-header))))
3478       (when old-header
3479         (mail-header-set-number header (mail-header-number old-header)))
3480       (setq gnus-newsgroup-sparse
3481             (delq (setq number (mail-header-number header)) 
3482                   gnus-newsgroup-sparse))
3483       (setq gnus-newsgroup-ancient (delq number gnus-newsgroup-ancient))
3484       (gnus-rebuild-thread (mail-header-id header))
3485       (gnus-summary-goto-subject number nil t))
3486     (when (and (numberp number)
3487                (> number 0))
3488       ;; We have to update the boundaries even if we can't fetch the
3489       ;; article if ID is a number -- so that the next `P' or `N'
3490       ;; command will fetch the previous (or next) article even
3491       ;; if the one we tried to fetch this time has been canceled.
3492       (and (> number gnus-newsgroup-end)
3493            (setq gnus-newsgroup-end number))
3494       (and (< number gnus-newsgroup-begin)
3495            (setq gnus-newsgroup-begin number))
3496       (setq gnus-newsgroup-unselected
3497             (delq number gnus-newsgroup-unselected)))
3498     ;; Report back a success?
3499     (and header (mail-header-number header))))
3500
3501 (defun gnus-summary-work-articles (n)
3502   "Return a list of articles to be worked upon.  The prefix argument,
3503 the list of process marked articles, and the current article will be
3504 taken into consideration."
3505   (cond
3506    (n
3507     ;; A numerical prefix has been given.
3508     (let ((backward (< n 0))
3509           (n (abs (prefix-numeric-value n)))
3510           articles article)
3511       (save-excursion
3512         (while
3513             (and (> n 0)
3514                  (push (setq article (gnus-summary-article-number))
3515                        articles)
3516                  (if backward
3517                      (gnus-summary-find-prev nil article)
3518                    (gnus-summary-find-next nil article)))
3519           (decf n)))
3520       (nreverse articles)))
3521    ((and (boundp 'transient-mark-mode)
3522          transient-mark-mode
3523          mark-active)
3524     ;; Work on the region between point and mark.
3525     (let ((max (max (point) (mark)))
3526           articles article)
3527       (save-excursion
3528         (goto-char (min (point) (mark)))
3529         (while
3530             (and
3531              (push (setq article (gnus-summary-article-number)) articles)
3532              (gnus-summary-find-next nil article)
3533              (< (point) max)))
3534         (nreverse articles))))
3535    (gnus-newsgroup-processable
3536     ;; There are process-marked articles present.
3537     (reverse gnus-newsgroup-processable))
3538    (t
3539     ;; Just return the current article.
3540     (list (gnus-summary-article-number)))))
3541
3542 (defun gnus-summary-search-group (&optional backward use-level)
3543   "Search for next unread newsgroup.
3544 If optional argument BACKWARD is non-nil, search backward instead."
3545   (save-excursion
3546     (set-buffer gnus-group-buffer)
3547     (if (gnus-group-search-forward
3548          backward nil (if use-level (gnus-group-group-level) nil))
3549         (gnus-group-group-name))))
3550
3551 (defun gnus-summary-best-group (&optional exclude-group)
3552   "Find the name of the best unread group.
3553 If EXCLUDE-GROUP, do not go to this group."
3554   (save-excursion
3555     (set-buffer gnus-group-buffer)
3556     (save-excursion
3557       (gnus-group-best-unread-group exclude-group))))
3558
3559 (defun gnus-summary-find-next (&optional unread article backward)
3560   (if backward (gnus-summary-find-prev)
3561     (let* ((dummy (gnus-summary-article-intangible-p))
3562            (article (or article (gnus-summary-article-number)))
3563            (arts (gnus-data-find-list article))
3564            result)
3565       (when (and (not dummy)
3566                  (or (not gnus-summary-check-current)
3567                      (not unread)
3568                      (not (gnus-data-unread-p (car arts)))))
3569         (setq arts (cdr arts)))
3570       (when (setq result
3571                   (if unread
3572                       (progn
3573                         (while arts
3574                           (when (gnus-data-unread-p (car arts))
3575                             (setq result (car arts)
3576                                   arts nil))
3577                           (setq arts (cdr arts)))
3578                         result)
3579                     (car arts)))
3580         (goto-char (gnus-data-pos result))
3581         (gnus-data-number result)))))
3582
3583 (defun gnus-summary-find-prev (&optional unread article)
3584   (let* ((eobp (eobp))
3585          (article (or article (gnus-summary-article-number)))
3586          (arts (gnus-data-find-list article (gnus-data-list 'rev)))
3587          result)
3588     (when (and (not eobp)
3589                (or (not gnus-summary-check-current)
3590                    (not unread)
3591                    (not (gnus-data-unread-p (car arts)))))
3592       (setq arts (cdr arts)))
3593     (if (setq result
3594               (if unread
3595                   (progn
3596                     (while arts
3597                       (and (gnus-data-unread-p (car arts))
3598                            (setq result (car arts)
3599                                  arts nil))
3600                       (setq arts (cdr arts)))
3601                     result)
3602                 (car arts)))
3603         (progn
3604           (goto-char (gnus-data-pos result))
3605           (gnus-data-number result)))))
3606
3607 (defun gnus-summary-find-subject (subject &optional unread backward article)
3608   (let* ((simp-subject (gnus-simplify-subject-fully subject))
3609          (article (or article (gnus-summary-article-number)))
3610          (articles (gnus-data-list backward))
3611          (arts (gnus-data-find-list article articles))
3612          result)
3613     (when (or (not gnus-summary-check-current)
3614               (not unread)
3615               (not (gnus-data-unread-p (car arts))))
3616       (setq arts (cdr arts)))
3617     (while arts
3618       (and (or (not unread)
3619                (gnus-data-unread-p (car arts)))
3620            (vectorp (gnus-data-header (car arts)))
3621            (gnus-subject-equal
3622             simp-subject (mail-header-subject (gnus-data-header (car arts))) t)
3623            (setq result (car arts)
3624                  arts nil))
3625       (setq arts (cdr arts)))
3626     (and result
3627          (goto-char (gnus-data-pos result))
3628          (gnus-data-number result))))
3629
3630 (defun gnus-summary-search-forward (&optional unread subject backward)
3631   "Search forward for an article.
3632 If UNREAD, look for unread articles.  If SUBJECT, look for
3633 articles with that subject.  If BACKWARD, search backward instead."
3634   (cond (subject (gnus-summary-find-subject subject unread backward))
3635         (backward (gnus-summary-find-prev unread))
3636         (t (gnus-summary-find-next unread))))
3637
3638 (defun gnus-recenter (&optional n)
3639   "Center point in window and redisplay frame.
3640 Also do horizontal recentering."
3641   (interactive "P")
3642   (when (and gnus-auto-center-summary
3643              (not (eq gnus-auto-center-summary 'vertical)))
3644     (gnus-horizontal-recenter))
3645   (recenter n))
3646
3647 (defun gnus-summary-recenter ()
3648   "Center point in the summary window.
3649 If `gnus-auto-center-summary' is nil, or the article buffer isn't
3650 displayed, no centering will be performed."
3651   ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
3652   ;; Recenter only when requested.  Suggested by popovich@park.cs.columbia.edu.
3653   (let* ((top (cond ((< (window-height) 4) 0)
3654                     ((< (window-height) 7) 1)
3655                     (t 2)))
3656          (height (1- (window-height)))
3657          (bottom (save-excursion (goto-char (point-max))
3658                                  (forward-line (- height))
3659                                  (point)))
3660          (window (get-buffer-window (current-buffer))))
3661     ;; The user has to want it.
3662     (when gnus-auto-center-summary
3663       (when (get-buffer-window gnus-article-buffer)
3664        ;; Only do recentering when the article buffer is displayed,
3665        ;; Set the window start to either `bottom', which is the biggest
3666        ;; possible valid number, or the second line from the top,
3667        ;; whichever is the least.
3668        (set-window-start
3669         window (min bottom (save-excursion 
3670                              (forward-line (- top)) (point)))))
3671       ;; Do horizontal recentering while we're at it.
3672       (when (and (get-buffer-window (current-buffer) t)
3673                  (not (eq gnus-auto-center-summary 'vertical)))
3674         (let ((selected (selected-window)))
3675           (select-window (get-buffer-window (current-buffer) t))
3676           (gnus-summary-position-point)
3677           (gnus-horizontal-recenter)
3678           (select-window selected))))))
3679
3680 (defun gnus-summary-jump-to-group (newsgroup)
3681   "Move point to NEWSGROUP in group mode buffer."
3682   ;; Keep update point of group mode buffer if visible.
3683   (if (eq (current-buffer) (get-buffer gnus-group-buffer))
3684       (save-window-excursion
3685         ;; Take care of tree window mode.
3686         (if (get-buffer-window gnus-group-buffer)
3687             (pop-to-buffer gnus-group-buffer))
3688         (gnus-group-jump-to-group newsgroup))
3689     (save-excursion
3690       ;; Take care of tree window mode.
3691       (if (get-buffer-window gnus-group-buffer)
3692           (pop-to-buffer gnus-group-buffer)
3693         (set-buffer gnus-group-buffer))
3694       (gnus-group-jump-to-group newsgroup))))
3695
3696 ;; This function returns a list of article numbers based on the
3697 ;; difference between the ranges of read articles in this group and
3698 ;; the range of active articles.
3699 (defun gnus-list-of-unread-articles (group)
3700   (let* ((read (gnus-info-read (gnus-get-info group)))
3701          (active (gnus-active group))
3702          (last (cdr active))
3703          first nlast unread)
3704     ;; If none are read, then all are unread.
3705     (if (not read)
3706         (setq first (car active))
3707       ;; If the range of read articles is a single range, then the
3708       ;; first unread article is the article after the last read
3709       ;; article.  Sounds logical, doesn't it?
3710       (if (not (listp (cdr read)))
3711           (setq first (1+ (cdr read)))
3712         ;; `read' is a list of ranges.
3713         (if (/= (setq nlast (or (and (numberp (car read)) (car read))
3714                                 (caar read))) 1)
3715             (setq first 1))
3716         (while read
3717           (if first
3718               (while (< first nlast)
3719                 (setq unread (cons first unread))
3720                 (setq first (1+ first))))
3721           (setq first (1+ (if (atom (car read)) (car read) (cdar read))))
3722           (setq nlast (if (atom (cadr read)) (cadr read) (caadr read)))
3723           (setq read (cdr read)))))
3724     ;; And add the last unread articles.
3725     (while (<= first last)
3726       (setq unread (cons first unread))
3727       (setq first (1+ first)))
3728     ;; Return the list of unread articles.
3729     (nreverse unread)))
3730
3731 (defun gnus-list-of-read-articles (group)
3732   "Return a list of unread, unticked and non-dormant articles."
3733   (let* ((info (gnus-get-info group))
3734          (marked (gnus-info-marks info))
3735          (active (gnus-active group)))
3736     (and info active
3737          (gnus-set-difference
3738           (gnus-sorted-complement
3739            (gnus-uncompress-range active)
3740            (gnus-list-of-unread-articles group))
3741           (append
3742            (gnus-uncompress-range (cdr (assq 'dormant marked)))
3743            (gnus-uncompress-range (cdr (assq 'tick marked))))))))
3744
3745 ;; Various summary commands
3746
3747 (defun gnus-summary-universal-argument (arg)
3748   "Perform any operation on all articles that are process/prefixed."
3749   (interactive "P")
3750   (gnus-set-global-variables)
3751   (let ((articles (gnus-summary-work-articles arg))
3752         func article)
3753     (if (eq
3754          (setq
3755           func
3756           (key-binding
3757            (read-key-sequence
3758             (substitute-command-keys
3759              "\\<gnus-summary-mode-map>\\[gnus-summary-universal-argument]"
3760              ))))
3761          'undefined)
3762         (gnus-error 1 "Undefined key")
3763       (save-excursion
3764         (while articles
3765           (gnus-summary-goto-subject (setq article (pop articles)))
3766           (command-execute func)
3767           (gnus-summary-remove-process-mark article)))))
3768   (gnus-summary-position-point))
3769
3770 (defun gnus-summary-toggle-truncation (&optional arg)
3771   "Toggle truncation of summary lines.
3772 With arg, turn line truncation on iff arg is positive."
3773   (interactive "P")
3774   (setq truncate-lines
3775         (if (null arg) (not truncate-lines)
3776           (> (prefix-numeric-value arg) 0)))
3777   (redraw-display))
3778
3779 (defun gnus-summary-reselect-current-group (&optional all rescan)
3780   "Exit and then reselect the current newsgroup.
3781 The prefix argument ALL means to select all articles."
3782   (interactive "P")
3783   (gnus-set-global-variables)
3784   (when (gnus-ephemeral-group-p gnus-newsgroup-name)
3785     (error "Ephemeral groups can't be reselected"))
3786   (let ((current-subject (gnus-summary-article-number))
3787         (group gnus-newsgroup-name))
3788     (setq gnus-newsgroup-begin nil)
3789     (gnus-summary-exit)
3790     ;; We have to adjust the point of group mode buffer because the
3791     ;; current point was moved to the next unread newsgroup by
3792     ;; exiting.
3793     (gnus-summary-jump-to-group group)
3794     (when rescan
3795       (save-excursion
3796         (gnus-group-get-new-news-this-group 1)))
3797     (gnus-group-read-group all t)
3798     (gnus-summary-goto-subject current-subject nil t)))
3799
3800 (defun gnus-summary-rescan-group (&optional all)
3801   "Exit the newsgroup, ask for new articles, and select the newsgroup."
3802   (interactive "P")
3803   (gnus-summary-reselect-current-group all t))
3804
3805 (defun gnus-summary-update-info ()
3806   (let ((group gnus-newsgroup-name))
3807     (when gnus-newsgroup-kill-headers
3808       (setq gnus-newsgroup-killed
3809             (gnus-compress-sequence
3810              (nconc
3811               (gnus-set-sorted-intersection
3812                (gnus-uncompress-range gnus-newsgroup-killed)
3813                (setq gnus-newsgroup-unselected
3814                      (sort gnus-newsgroup-unselected '<)))
3815               (setq gnus-newsgroup-unreads
3816                     (sort gnus-newsgroup-unreads '<))) t)))
3817     (unless (listp (cdr gnus-newsgroup-killed))
3818       (setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
3819     (let ((headers gnus-newsgroup-headers))
3820       (run-hooks 'gnus-exit-group-hook)
3821       (unless gnus-save-score
3822         (setq gnus-newsgroup-scored nil))
3823       ;; Set the new ranges of read articles.
3824       (gnus-update-read-articles
3825        group (append gnus-newsgroup-unreads gnus-newsgroup-unselected))
3826       ;; Set the current article marks.
3827       (gnus-update-marks)
3828       ;; Do the cross-ref thing.
3829       (when gnus-use-cross-reference
3830         (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads))
3831       ;; Do adaptive scoring, and possibly save score files.
3832       (when gnus-newsgroup-adaptive
3833         (gnus-score-adaptive))
3834       (when gnus-use-scoring
3835         (gnus-score-save))
3836       ;; Do not switch windows but change the buffer to work.
3837       (set-buffer gnus-group-buffer)
3838       (or (gnus-ephemeral-group-p gnus-newsgroup-name)
3839           (gnus-group-update-group group)))))
3840
3841 (defun gnus-summary-exit (&optional temporary)
3842   "Exit reading current newsgroup, and then return to group selection mode.
3843 gnus-exit-group-hook is called with no arguments if that value is non-nil."
3844   (interactive)
3845   (gnus-set-global-variables)
3846   (gnus-kill-save-kill-buffer)
3847   (let* ((group gnus-newsgroup-name)
3848          (quit-config (gnus-group-quit-config gnus-newsgroup-name))
3849          (mode major-mode)
3850          (buf (current-buffer)))
3851     (run-hooks 'gnus-summary-prepare-exit-hook)
3852     ;; If we have several article buffers, we kill them at exit.
3853     (unless gnus-single-article-buffer
3854       (gnus-kill-buffer gnus-original-article-buffer)
3855       (setq gnus-article-current nil))
3856     (when gnus-use-cache
3857       (gnus-cache-possibly-remove-articles)
3858       (gnus-cache-save-buffers))
3859     (gnus-async-prefetch-remove-group group)
3860     (when gnus-suppress-duplicates
3861       (gnus-dup-enter-articles))
3862     (when gnus-use-trees
3863       (gnus-tree-close group))
3864     ;; Make all changes in this group permanent.
3865     (unless quit-config
3866       (gnus-summary-update-info))
3867     (gnus-close-group group)
3868     ;; Make sure where I was, and go to next newsgroup.
3869     (set-buffer gnus-group-buffer)
3870     (unless quit-config
3871       (gnus-group-jump-to-group group))
3872     (run-hooks 'gnus-summary-exit-hook)
3873     (unless quit-config
3874       (gnus-group-next-unread-group 1))
3875     (if temporary
3876         nil                             ;Nothing to do.
3877       ;; If we have several article buffers, we kill them at exit.
3878       (unless gnus-single-article-buffer
3879         (gnus-kill-buffer gnus-article-buffer)
3880         (gnus-kill-buffer gnus-original-article-buffer)
3881         (setq gnus-article-current nil))
3882       (set-buffer buf)
3883       (if (not gnus-kill-summary-on-exit)
3884           (gnus-deaden-summary)
3885         ;; We set all buffer-local variables to nil.  It is unclear why
3886         ;; this is needed, but if we don't, buffer-local variables are
3887         ;; not garbage-collected, it seems.  This would the lead to en
3888         ;; ever-growing Emacs.
3889         (gnus-summary-clear-local-variables)
3890         (when (get-buffer gnus-article-buffer)
3891           (bury-buffer gnus-article-buffer))
3892         ;; We clear the global counterparts of the buffer-local
3893         ;; variables as well, just to be on the safe side.
3894         (gnus-configure-windows 'group 'force)
3895         (gnus-summary-clear-local-variables)
3896         ;; Return to group mode buffer.
3897         (if (eq mode 'gnus-summary-mode)
3898             (gnus-kill-buffer buf)))
3899       (setq gnus-current-select-method gnus-select-method)
3900       (pop-to-buffer gnus-group-buffer)
3901       ;; Clear the current group name.
3902       (if (not quit-config)
3903           (progn
3904             (gnus-group-jump-to-group group)
3905             (gnus-group-next-unread-group 1)
3906             (gnus-configure-windows 'group 'force))
3907         (if (not (buffer-name (car quit-config)))
3908             (gnus-configure-windows 'group 'force)
3909           (set-buffer (car quit-config))
3910           (and (eq major-mode 'gnus-summary-mode)
3911                (gnus-set-global-variables))
3912           (gnus-configure-windows (cdr quit-config))))
3913       (unless quit-config
3914         (setq gnus-newsgroup-name nil)))))
3915
3916 (defalias 'gnus-summary-quit 'gnus-summary-exit-no-update)
3917 (defun gnus-summary-exit-no-update (&optional no-questions)
3918   "Quit reading current newsgroup without updating read article info."
3919   (interactive)
3920   (gnus-set-global-variables)
3921   (let* ((group gnus-newsgroup-name)
3922          (quit-config (gnus-group-quit-config group)))
3923     (when (or no-questions
3924               gnus-expert-user
3925               (gnus-y-or-n-p "Do you really wanna quit reading this group? "))
3926       ;; If we have several article buffers, we kill them at exit.
3927       (unless gnus-single-article-buffer
3928         (gnus-kill-buffer gnus-article-buffer)
3929         (gnus-kill-buffer gnus-original-article-buffer)
3930         (setq gnus-article-current nil))
3931       (if (not gnus-kill-summary-on-exit)
3932           (gnus-deaden-summary)
3933         (gnus-close-group group)
3934         (gnus-summary-clear-local-variables)
3935         (set-buffer gnus-group-buffer)
3936         (gnus-summary-clear-local-variables)
3937         (when (get-buffer gnus-summary-buffer)
3938           (kill-buffer gnus-summary-buffer)))
3939       (unless gnus-single-article-buffer
3940         (setq gnus-article-current nil))
3941       (when gnus-use-trees
3942         (gnus-tree-close group))
3943       (gnus-async-prefetch-remove-group group)
3944       (when (get-buffer gnus-article-buffer)
3945         (bury-buffer gnus-article-buffer))
3946       ;; Return to the group buffer.
3947       (gnus-configure-windows 'group 'force)
3948       ;; Clear the current group name.
3949       (setq gnus-newsgroup-name nil)
3950       (when (equal (gnus-group-group-name) group)
3951         (gnus-group-next-unread-group 1))
3952       (when quit-config
3953         (if (not (buffer-name (car quit-config)))
3954             (gnus-configure-windows 'group 'force)
3955           (set-buffer (car quit-config))
3956           (when (eq major-mode 'gnus-summary-mode)
3957             (gnus-set-global-variables))
3958           (gnus-configure-windows (cdr quit-config)))))))
3959
3960 ;;; Dead summaries.
3961
3962 (defvar gnus-dead-summary-mode-map nil)
3963
3964 (if gnus-dead-summary-mode-map
3965     nil
3966   (setq gnus-dead-summary-mode-map (make-keymap))
3967   (suppress-keymap gnus-dead-summary-mode-map)
3968   (substitute-key-definition
3969    'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-mode-map)
3970   (let ((keys '("\C-d" "\r" "\177")))
3971     (while keys
3972       (define-key gnus-dead-summary-mode-map
3973         (pop keys) 'gnus-summary-wake-up-the-dead))))
3974
3975 (defvar gnus-dead-summary-mode nil
3976   "Minor mode for Gnus summary buffers.")
3977
3978 (defun gnus-dead-summary-mode (&optional arg)
3979   "Minor mode for Gnus summary buffers."
3980   (interactive "P")
3981   (when (eq major-mode 'gnus-summary-mode)
3982     (make-local-variable 'gnus-dead-summary-mode)
3983     (setq gnus-dead-summary-mode
3984           (if (null arg) (not gnus-dead-summary-mode)
3985             (> (prefix-numeric-value arg) 0)))
3986     (when gnus-dead-summary-mode
3987       (unless (assq 'gnus-dead-summary-mode minor-mode-alist)
3988         (push '(gnus-dead-summary-mode " Dead") minor-mode-alist))
3989       (unless (assq 'gnus-dead-summary-mode minor-mode-map-alist)
3990         (push (cons 'gnus-dead-summary-mode gnus-dead-summary-mode-map)
3991               minor-mode-map-alist)))))
3992
3993 (defun gnus-deaden-summary ()
3994   "Make the current summary buffer into a dead summary buffer."
3995   ;; Kill any previous dead summary buffer.
3996   (when (and gnus-dead-summary
3997              (buffer-name gnus-dead-summary))
3998     (save-excursion
3999       (set-buffer gnus-dead-summary)
4000       (when gnus-dead-summary-mode
4001         (kill-buffer (current-buffer)))))
4002   ;; Make this the current dead summary.
4003   (setq gnus-dead-summary (current-buffer))
4004   (gnus-dead-summary-mode 1)
4005   (let ((name (buffer-name)))
4006     (when (string-match "Summary" name)
4007       (rename-buffer
4008        (concat (substring name 0 (match-beginning 0)) "Dead "
4009                (substring name (match-beginning 0))) t))))
4010
4011 (defun gnus-kill-or-deaden-summary (buffer)
4012   "Kill or deaden the summary BUFFER."
4013   (when (and (buffer-name buffer)
4014              (not gnus-single-article-buffer))
4015     (save-excursion
4016       (set-buffer buffer)
4017       (gnus-kill-buffer gnus-article-buffer)
4018       (gnus-kill-buffer gnus-original-article-buffer)))
4019   (cond (gnus-kill-summary-on-exit
4020          (when (and gnus-use-trees
4021                     (and (get-buffer buffer)
4022                          (buffer-name (get-buffer buffer))))
4023            (save-excursion
4024              (set-buffer (get-buffer buffer))
4025              (gnus-tree-close gnus-newsgroup-name)))
4026          (gnus-kill-buffer buffer))
4027         ((and (get-buffer buffer)
4028               (buffer-name (get-buffer buffer)))
4029          (save-excursion
4030            (set-buffer buffer)
4031            (gnus-deaden-summary)))))
4032
4033 (defun gnus-summary-wake-up-the-dead (&rest args)
4034   "Wake up the dead summary buffer."
4035   (interactive)
4036   (gnus-dead-summary-mode -1)
4037   (let ((name (buffer-name)))
4038     (when (string-match "Dead " name)
4039       (rename-buffer
4040        (concat (substring name 0 (match-beginning 0))
4041                (substring name (match-end 0))) t)))
4042   (gnus-message 3 "This dead summary is now alive again"))
4043
4044 ;; Suggested by Andrew Eskilsson <pi92ae@pt.hk-r.se>.
4045 (defun gnus-summary-fetch-faq (&optional faq-dir)
4046   "Fetch the FAQ for the current group.
4047 If FAQ-DIR (the prefix), prompt for a directory to search for the faq
4048 in."
4049   (interactive
4050    (list
4051     (if current-prefix-arg
4052         (completing-read
4053          "Faq dir: " (and (listp gnus-group-faq-directory)
4054                           gnus-group-faq-directory)))))
4055   (let (gnus-faq-buffer)
4056     (and (setq gnus-faq-buffer
4057                (gnus-group-fetch-faq gnus-newsgroup-name faq-dir))
4058          (gnus-configure-windows 'summary-faq))))
4059
4060 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
4061 (defun gnus-summary-describe-group (&optional force)
4062   "Describe the current newsgroup."
4063   (interactive "P")
4064   (gnus-group-describe-group force gnus-newsgroup-name))
4065
4066 (defun gnus-summary-describe-briefly ()
4067   "Describe summary mode commands briefly."
4068   (interactive)
4069   (gnus-message 6
4070                 (substitute-command-keys "\\<gnus-summary-mode-map>\\[gnus-summary-next-page]:Select  \\[gnus-summary-next-unread-article]:Forward  \\[gnus-summary-prev-unread-article]:Backward  \\[gnus-summary-exit]:Exit  \\[gnus-info-find-node]:Run Info  \\[gnus-summary-describe-briefly]:This help")))
4071
4072 ;; Walking around group mode buffer from summary mode.
4073
4074 (defun gnus-summary-next-group (&optional no-article target-group backward)
4075   "Exit current newsgroup and then select next unread newsgroup.
4076 If prefix argument NO-ARTICLE is non-nil, no article is selected
4077 initially.  If NEXT-GROUP, go to this group.  If BACKWARD, go to
4078 previous group instead."
4079   (interactive "P")
4080   (gnus-set-global-variables)
4081   (let ((current-group gnus-newsgroup-name)
4082         (current-buffer (current-buffer))
4083         entered)
4084     ;; First we semi-exit this group to update Xrefs and all variables.
4085     ;; We can't do a real exit, because the window conf must remain
4086     ;; the same in case the user is prompted for info, and we don't
4087     ;; want the window conf to change before that...
4088     (gnus-summary-exit t)
4089     (while (not entered)
4090       ;; Then we find what group we are supposed to enter.
4091       (set-buffer gnus-group-buffer)
4092       (gnus-group-jump-to-group current-group)
4093       (setq target-group
4094             (or target-group
4095                 (if (eq gnus-keep-same-level 'best)
4096                     (gnus-summary-best-group gnus-newsgroup-name)
4097                   (gnus-summary-search-group backward gnus-keep-same-level))))
4098       (if (not target-group)
4099           ;; There are no further groups, so we return to the group
4100           ;; buffer.
4101           (progn
4102             (gnus-message 5 "Returning to the group buffer")
4103             (setq entered t)
4104             (set-buffer current-buffer)
4105             (gnus-summary-exit))
4106         ;; We try to enter the target group.
4107         (gnus-group-jump-to-group target-group)
4108         (let ((unreads (gnus-group-group-unread)))
4109           (if (and (or (eq t unreads)
4110                        (and unreads (not (zerop unreads))))
4111                    (gnus-summary-read-group
4112                     target-group nil no-article current-buffer))
4113               (setq entered t)
4114             (setq current-group target-group
4115                   target-group nil)))))))
4116
4117 (defun gnus-summary-prev-group (&optional no-article)
4118   "Exit current newsgroup and then select previous unread newsgroup.
4119 If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
4120   (interactive "P")
4121   (gnus-summary-next-group no-article nil t))
4122
4123 ;; Walking around summary lines.
4124
4125 (defun gnus-summary-first-subject (&optional unread)
4126   "Go to the first unread subject.
4127 If UNREAD is non-nil, go to the first unread article.
4128 Returns the article selected or nil if there are no unread articles."
4129   (interactive "P")
4130   (prog1
4131       (cond
4132        ;; Empty summary.
4133        ((null gnus-newsgroup-data)
4134         (gnus-message 3 "No articles in the group")
4135         nil)
4136        ;; Pick the first article.
4137        ((not unread)
4138         (goto-char (gnus-data-pos (car gnus-newsgroup-data)))
4139         (gnus-data-number (car gnus-newsgroup-data)))
4140        ;; No unread articles.
4141        ((null gnus-newsgroup-unreads)
4142         (gnus-message 3 "No more unread articles")
4143         nil)
4144        ;; Find the first unread article.
4145        (t
4146         (let ((data gnus-newsgroup-data))
4147           (while (and data
4148                       (not (gnus-data-unread-p (car data))))
4149             (setq data (cdr data)))
4150           (if data
4151               (progn
4152                 (goto-char (gnus-data-pos (car data)))
4153                 (gnus-data-number (car data)))))))
4154     (gnus-summary-position-point)))
4155
4156 (defun gnus-summary-next-subject (n &optional unread dont-display)
4157   "Go to next N'th summary line.
4158 If N is negative, go to the previous N'th subject line.
4159 If UNREAD is non-nil, only unread articles are selected.
4160 The difference between N and the actual number of steps taken is
4161 returned."
4162   (interactive "p")
4163   (let ((backward (< n 0))
4164         (n (abs n)))
4165     (while (and (> n 0)
4166                 (if backward
4167                     (gnus-summary-find-prev unread)
4168                   (gnus-summary-find-next unread)))
4169       (setq n (1- n)))
4170     (if (/= 0 n) (gnus-message 7 "No more%s articles"
4171                                (if unread " unread" "")))
4172     (unless dont-display
4173       (gnus-summary-recenter)
4174       (gnus-summary-position-point))
4175     n))
4176
4177 (defun gnus-summary-next-unread-subject (n)
4178   "Go to next N'th unread summary line."
4179   (interactive "p")
4180   (gnus-summary-next-subject n t))
4181
4182 (defun gnus-summary-prev-subject (n &optional unread)
4183   "Go to previous N'th summary line.
4184 If optional argument UNREAD is non-nil, only unread article is selected."
4185   (interactive "p")
4186   (gnus-summary-next-subject (- n) unread))
4187
4188 (defun gnus-summary-prev-unread-subject (n)
4189   "Go to previous N'th unread summary line."
4190   (interactive "p")
4191   (gnus-summary-next-subject (- n) t))
4192
4193 (defun gnus-summary-goto-subject (article &optional force silent)
4194   "Go the subject line of ARTICLE.
4195 If FORCE, also allow jumping to articles not currently shown."
4196   (let ((b (point))
4197         (data (gnus-data-find article)))
4198     ;; We read in the article if we have to.
4199     (and (not data)
4200          force
4201          (gnus-summary-insert-subject article (and (vectorp force) force) t)
4202          (setq data (gnus-data-find article)))
4203     (goto-char b)
4204     (if (not data)
4205         (progn
4206           (unless silent
4207             (gnus-message 3 "Can't find article %d" article))
4208           nil)
4209       (goto-char (gnus-data-pos data))
4210       article)))
4211
4212 ;; Walking around summary lines with displaying articles.
4213
4214 (defun gnus-summary-expand-window (&optional arg)
4215   "Make the summary buffer take up the entire Emacs frame.
4216 Given a prefix, will force an `article' buffer configuration."
4217   (interactive "P")
4218   (gnus-set-global-variables)
4219   (if arg
4220       (gnus-configure-windows 'article 'force)
4221     (gnus-configure-windows 'summary 'force)))
4222
4223 (defun gnus-summary-display-article (article &optional all-header)
4224   "Display ARTICLE in article buffer."
4225   (gnus-set-global-variables)
4226   (if (null article)
4227       nil
4228     (prog1
4229         (if gnus-summary-display-article-function
4230             (funcall gnus-summary-display-article-function article all-header)
4231           (gnus-article-prepare article all-header))
4232       (run-hooks 'gnus-select-article-hook)
4233       (unless (zerop gnus-current-article)
4234         (gnus-summary-goto-subject gnus-current-article))
4235       (gnus-summary-recenter)
4236       (when gnus-use-trees
4237         (gnus-possibly-generate-tree article)
4238         (gnus-highlight-selected-tree article))
4239       ;; Successfully display article.
4240       (gnus-article-set-window-start
4241        (cdr (assq article gnus-newsgroup-bookmarks))))))
4242
4243 (defun gnus-summary-select-article (&optional all-headers force pseudo article)
4244   "Select the current article.
4245 If ALL-HEADERS is non-nil, show all header fields.  If FORCE is
4246 non-nil, the article will be re-fetched even if it already present in
4247 the article buffer.  If PSEUDO is non-nil, pseudo-articles will also
4248 be displayed."
4249   ;; Make sure we are in the summary buffer to work around bbdb bug.
4250   (unless (eq major-mode 'gnus-summary-mode)
4251     (set-buffer gnus-summary-buffer))
4252   (let ((article (or article (gnus-summary-article-number)))
4253         (all-headers (not (not all-headers))) ;Must be T or NIL.
4254         gnus-summary-display-article-function
4255         did)
4256     (and (not pseudo)
4257          (gnus-summary-article-pseudo-p article)
4258          (error "This is a pseudo-article."))
4259     (prog1
4260         (save-excursion
4261           (set-buffer gnus-summary-buffer)
4262           (if (or (and gnus-single-article-buffer
4263                        (or (null gnus-current-article)
4264                            (null gnus-article-current)
4265                            (null (get-buffer gnus-article-buffer))
4266                            (not (eq article (cdr gnus-article-current)))
4267                            (not (equal (car gnus-article-current)
4268                                        gnus-newsgroup-name))))
4269                   (and (not gnus-single-article-buffer)
4270                        (or (null gnus-current-article)
4271                            (not (eq gnus-current-article article))))
4272                   force)
4273               ;; The requested article is different from the current article.
4274               (prog1
4275                   (gnus-summary-display-article article all-headers)
4276                 (setq did article))
4277             (if (or all-headers gnus-show-all-headers)
4278                 (gnus-article-show-all-headers))
4279             'old))
4280       (if did
4281           (gnus-article-set-window-start
4282            (cdr (assq article gnus-newsgroup-bookmarks)))))))
4283
4284 (defun gnus-summary-set-current-mark (&optional current-mark)
4285   "Obsolete function."
4286   nil)
4287
4288 (defun gnus-summary-next-article (&optional unread subject backward push)
4289   "Select the next article.
4290 If UNREAD, only unread articles are selected.
4291 If SUBJECT, only articles with SUBJECT are selected.
4292 If BACKWARD, the previous article is selected instead of the next."
4293   (interactive "P")
4294   (gnus-set-global-variables)
4295   (cond
4296    ;; Is there such an article?
4297    ((and (gnus-summary-search-forward unread subject backward)
4298          (or (gnus-summary-display-article (gnus-summary-article-number))
4299              (eq (gnus-summary-article-mark) gnus-canceled-mark)))
4300     (gnus-summary-position-point))
4301    ;; If not, we try the first unread, if that is wanted.
4302    ((and subject
4303          gnus-auto-select-same
4304          ;; Make sure that we don't select the current article.
4305          (not (eq (gnus-summary-article-number)
4306                   (save-excursion
4307                     (gnus-summary-first-subject t)
4308                     (gnus-summary-article-number))))
4309          (gnus-summary-first-unread-article))
4310     (gnus-summary-position-point)
4311     (gnus-message 6 "Wrapped"))
4312    ;; Try to get next/previous article not displayed in this group.
4313    ((and gnus-auto-extend-newsgroup
4314          (not unread) (not subject))
4315     (gnus-summary-goto-article
4316      (if backward (1- gnus-newsgroup-begin) (1+ gnus-newsgroup-end))
4317      nil t))
4318    ;; Go to next/previous group.
4319    (t
4320     (or (gnus-ephemeral-group-p gnus-newsgroup-name)
4321         (gnus-summary-jump-to-group gnus-newsgroup-name))
4322     (let ((cmd last-command-char)
4323           (group
4324            (if (eq gnus-keep-same-level 'best)
4325                (gnus-summary-best-group gnus-newsgroup-name)
4326              (gnus-summary-search-group backward gnus-keep-same-level))))
4327       ;; For some reason, the group window gets selected.  We change
4328       ;; it back.
4329       (select-window (get-buffer-window (current-buffer)))
4330       ;; Select next unread newsgroup automagically.
4331       (cond
4332        ((or (not gnus-auto-select-next)
4333             (not cmd))
4334         (gnus-message 7 "No more%s articles" (if unread " unread" "")))
4335        ((or (eq gnus-auto-select-next 'quietly)
4336             (and (eq gnus-auto-select-next 'slightly-quietly)
4337                  push)
4338             (and (eq gnus-auto-select-next 'almost-quietly)
4339                  (gnus-summary-last-article-p)))
4340         ;; Select quietly.
4341         (if (gnus-ephemeral-group-p gnus-newsgroup-name)
4342             (gnus-summary-exit)
4343           (gnus-message 7 "No more%s articles (%s)..."
4344                         (if unread " unread" "")
4345                         (if group (concat "selecting " group)
4346                           "exiting"))
4347           (gnus-summary-next-group nil group backward)))
4348        (t
4349         (gnus-summary-walk-group-buffer
4350          gnus-newsgroup-name cmd unread backward)))))))
4351
4352 (defun gnus-summary-walk-group-buffer (from-group cmd unread backward)
4353   (let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1))
4354                       (?\C-p (gnus-group-prev-unread-group 1))))
4355         (cursor-in-echo-area t)
4356         keve key group ended)
4357     (save-excursion
4358       (set-buffer gnus-group-buffer)
4359       (gnus-summary-jump-to-group from-group)
4360       (setq group
4361             (if (eq gnus-keep-same-level 'best)
4362                 (gnus-summary-best-group gnus-newsgroup-name)
4363               (gnus-summary-search-group backward gnus-keep-same-level))))
4364     (while (not ended)
4365       (gnus-message
4366        5 "No more%s articles%s" (if unread " unread" "")
4367        (if (and group
4368                 (not (gnus-ephemeral-group-p gnus-newsgroup-name)))
4369            (format " (Type %s for %s [%s])"
4370                    (single-key-description cmd) group
4371                    (car (gnus-gethash group gnus-newsrc-hashtb)))
4372          (format " (Type %s to exit %s)"
4373                  (single-key-description cmd)
4374                  gnus-newsgroup-name)))
4375       ;; Confirm auto selection.
4376       (setq key (car (setq keve (gnus-read-event-char))))
4377       (setq ended t)
4378       (cond
4379        ((assq key keystrokes)
4380         (let ((obuf (current-buffer)))
4381           (switch-to-buffer gnus-group-buffer)
4382           (and group
4383                (gnus-group-jump-to-group group))
4384           (eval (cadr (assq key keystrokes)))
4385           (setq group (gnus-group-group-name))
4386           (switch-to-buffer obuf))
4387         (setq ended nil))
4388        ((equal key cmd)
4389         (if (or (not group)
4390                 (gnus-ephemeral-group-p gnus-newsgroup-name))
4391             (gnus-summary-exit)
4392           (gnus-summary-next-group nil group backward)))
4393        (t
4394         (push (cdr keve) unread-command-events))))))
4395
4396 (defun gnus-summary-next-unread-article ()
4397   "Select unread article after current one."
4398   (interactive)
4399   (gnus-summary-next-article t (and gnus-auto-select-same
4400                                     (gnus-summary-article-subject))))
4401
4402 (defun gnus-summary-prev-article (&optional unread subject)
4403   "Select the article after the current one.
4404 If UNREAD is non-nil, only unread articles are selected."
4405   (interactive "P")
4406   (gnus-summary-next-article unread subject t))
4407
4408 (defun gnus-summary-prev-unread-article ()
4409   "Select unread article before current one."
4410   (interactive)
4411   (gnus-summary-prev-article t (and gnus-auto-select-same
4412                                     (gnus-summary-article-subject))))
4413
4414 (defun gnus-summary-next-page (&optional lines circular)
4415   "Show next page of the selected article.
4416 If at the end of the current article, select the next article.
4417 LINES says how many lines should be scrolled up.
4418
4419 If CIRCULAR is non-nil, go to the start of the article instead of
4420 selecting the next article when reaching the end of the current
4421 article."
4422   (interactive "P")
4423   (setq gnus-summary-buffer (current-buffer))
4424   (gnus-set-global-variables)
4425   (let ((article (gnus-summary-article-number))
4426         (endp nil))
4427     (gnus-configure-windows 'article)
4428     (if (eq (cdr (assq article gnus-newsgroup-reads)) gnus-canceled-mark)
4429         (if (and (eq gnus-summary-goto-unread 'never)
4430                  (not (gnus-summary-last-article-p article)))
4431             (gnus-summary-next-article)
4432           (gnus-summary-next-unread-article))
4433       (if (or (null gnus-current-article)
4434               (null gnus-article-current)
4435               (/= article (cdr gnus-article-current))
4436               (not (equal (car gnus-article-current) gnus-newsgroup-name)))
4437           ;; Selected subject is different from current article's.
4438           (gnus-summary-display-article article)
4439         (gnus-eval-in-buffer-window gnus-article-buffer
4440           (setq endp (gnus-article-next-page lines)))
4441         (if endp
4442             (cond (circular
4443                    (gnus-summary-beginning-of-article))
4444                   (lines
4445                    (gnus-message 3 "End of message"))
4446                   ((null lines)
4447                    (if (and (eq gnus-summary-goto-unread 'never)
4448                             (not (gnus-summary-last-article-p article)))
4449                        (gnus-summary-next-article)
4450                      (gnus-summary-next-unread-article)))))))
4451     (gnus-summary-recenter)
4452     (gnus-summary-position-point)))
4453
4454 (defun gnus-summary-prev-page (&optional lines)
4455   "Show previous page of selected article.
4456 Argument LINES specifies lines to be scrolled down."
4457   (interactive "P")
4458   (gnus-set-global-variables)
4459   (let ((article (gnus-summary-article-number)))
4460     (gnus-configure-windows 'article)
4461     (if (or (null gnus-current-article)
4462             (null gnus-article-current)
4463             (/= article (cdr gnus-article-current))
4464             (not (equal (car gnus-article-current) gnus-newsgroup-name)))
4465         ;; Selected subject is different from current article's.
4466         (gnus-summary-display-article article)
4467       (gnus-summary-recenter)
4468       (gnus-eval-in-buffer-window gnus-article-buffer
4469         (gnus-article-prev-page lines))))
4470   (gnus-summary-position-point))
4471
4472 (defun gnus-summary-scroll-up (lines)
4473   "Scroll up (or down) one line current article.
4474 Argument LINES specifies lines to be scrolled up (or down if negative)."
4475   (interactive "p")
4476   (gnus-set-global-variables)
4477   (gnus-configure-windows 'article)
4478   (gnus-summary-show-thread)
4479   (when (eq (gnus-summary-select-article nil nil 'pseudo) 'old)
4480     (gnus-eval-in-buffer-window gnus-article-buffer
4481       (cond ((> lines 0)
4482              (if (gnus-article-next-page lines)
4483                  (gnus-message 3 "End of message")))
4484             ((< lines 0)
4485              (gnus-article-prev-page (- lines))))))
4486   (gnus-summary-recenter)
4487   (gnus-summary-position-point))
4488
4489 (defun gnus-summary-next-same-subject ()
4490   "Select next article which has the same subject as current one."
4491   (interactive)
4492   (gnus-set-global-variables)
4493   (gnus-summary-next-article nil (gnus-summary-article-subject)))
4494
4495 (defun gnus-summary-prev-same-subject ()
4496   "Select previous article which has the same subject as current one."
4497   (interactive)
4498   (gnus-set-global-variables)
4499   (gnus-summary-prev-article nil (gnus-summary-article-subject)))
4500
4501 (defun gnus-summary-next-unread-same-subject ()
4502   "Select next unread article which has the same subject as current one."
4503   (interactive)
4504   (gnus-set-global-variables)
4505   (gnus-summary-next-article t (gnus-summary-article-subject)))
4506
4507 (defun gnus-summary-prev-unread-same-subject ()
4508   "Select previous unread article which has the same subject as current one."
4509   (interactive)
4510   (gnus-set-global-variables)
4511   (gnus-summary-prev-article t (gnus-summary-article-subject)))
4512
4513 (defun gnus-summary-first-unread-article ()
4514   "Select the first unread article.
4515 Return nil if there are no unread articles."
4516   (interactive)
4517   (gnus-set-global-variables)
4518   (prog1
4519       (when (gnus-summary-first-subject t)
4520         (gnus-summary-show-thread)
4521         (gnus-summary-first-subject t)
4522         (gnus-summary-display-article (gnus-summary-article-number)))
4523     (gnus-summary-position-point)))
4524
4525 (defun gnus-summary-best-unread-article ()
4526   "Select the unread article with the highest score."
4527   (interactive)
4528   (gnus-set-global-variables)
4529   (let ((best -1000000)
4530         (data gnus-newsgroup-data)
4531         article score)
4532     (while data
4533       (and (gnus-data-unread-p (car data))
4534            (> (setq score
4535                     (gnus-summary-article-score (gnus-data-number (car data))))
4536               best)
4537            (setq best score
4538                  article (gnus-data-number (car data))))
4539       (setq data (cdr data)))
4540     (prog1
4541         (if article
4542             (gnus-summary-goto-article article)
4543           (error "No unread articles"))
4544       (gnus-summary-position-point))))
4545
4546 (defun gnus-summary-last-subject ()
4547   "Go to the last displayed subject line in the group."
4548   (let ((article (gnus-data-number (car (gnus-data-list t)))))
4549     (when article
4550       (gnus-summary-goto-subject article))))
4551
4552 (defun gnus-summary-goto-article (article &optional all-headers force)
4553   "Fetch ARTICLE and display it if it exists.
4554 If ALL-HEADERS is non-nil, no header lines are hidden."
4555   (interactive
4556    (list
4557     (string-to-int
4558      (completing-read
4559       "Article number: "
4560       (mapcar (lambda (number) (list (int-to-string number)))
4561               gnus-newsgroup-limit)))
4562     current-prefix-arg
4563     t))
4564   (prog1
4565       (if (gnus-summary-goto-subject article force)
4566           (gnus-summary-display-article article all-headers)
4567         (gnus-message 4 "Couldn't go to article %s" article) nil)
4568     (gnus-summary-position-point)))
4569
4570 (defun gnus-summary-goto-last-article ()
4571   "Go to the previously read article."
4572   (interactive)
4573   (prog1
4574       (and gnus-last-article
4575            (gnus-summary-goto-article gnus-last-article))
4576     (gnus-summary-position-point)))
4577
4578 (defun gnus-summary-pop-article (number)
4579   "Pop one article off the history and go to the previous.
4580 NUMBER articles will be popped off."
4581   (interactive "p")
4582   (let (to)
4583     (setq gnus-newsgroup-history
4584           (cdr (setq to (nthcdr number gnus-newsgroup-history))))
4585     (if to
4586         (gnus-summary-goto-article (car to))
4587       (error "Article history empty")))
4588   (gnus-summary-position-point))
4589
4590 ;; Summary commands and functions for limiting the summary buffer.
4591
4592 (defun gnus-summary-limit-to-articles (n)
4593   "Limit the summary buffer to the next N articles.
4594 If not given a prefix, use the process marked articles instead."
4595   (interactive "P")
4596   (gnus-set-global-variables)
4597   (prog1
4598       (let ((articles (gnus-summary-work-articles n)))
4599         (setq gnus-newsgroup-processable nil)
4600         (gnus-summary-limit articles))
4601     (gnus-summary-position-point)))
4602
4603 (defun gnus-summary-pop-limit (&optional total)
4604   "Restore the previous limit.
4605 If given a prefix, remove all limits."
4606   (interactive "P")
4607   (gnus-set-global-variables)
4608   (when total 
4609     (setq gnus-newsgroup-limits
4610           (list (mapcar (lambda (h) (mail-header-number h))
4611                         gnus-newsgroup-headers))))
4612   (unless gnus-newsgroup-limits
4613     (error "No limit to pop"))
4614   (prog1
4615       (gnus-summary-limit nil 'pop)
4616     (gnus-summary-position-point)))
4617
4618 (defun gnus-summary-limit-to-subject (subject &optional header)
4619   "Limit the summary buffer to articles that have subjects that match a regexp."
4620   (interactive "sRegexp: ")
4621   (unless header
4622     (setq header "subject"))
4623   (when (not (equal "" subject))
4624     (prog1
4625         (let ((articles (gnus-summary-find-matching
4626                          (or header "subject") subject 'all)))
4627           (or articles (error "Found no matches for \"%s\"" subject))
4628           (gnus-summary-limit articles))
4629       (gnus-summary-position-point))))
4630
4631 (defun gnus-summary-limit-to-author (from)
4632   "Limit the summary buffer to articles that have authors that match a regexp."
4633   (interactive "sRegexp: ")
4634   (gnus-summary-limit-to-subject from "from"))
4635
4636 (defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
4637 (make-obsolete
4638  'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
4639
4640 (defun gnus-summary-limit-to-unread (&optional all)
4641   "Limit the summary buffer to articles that are not marked as read.
4642 If ALL is non-nil, limit strictly to unread articles."
4643   (interactive "P")
4644   (if all
4645       (gnus-summary-limit-to-marks (char-to-string gnus-unread-mark))
4646     (gnus-summary-limit-to-marks
4647      ;; Concat all the marks that say that an article is read and have
4648      ;; those removed.
4649      (list gnus-del-mark gnus-read-mark gnus-ancient-mark
4650            gnus-killed-mark gnus-kill-file-mark
4651            gnus-low-score-mark gnus-expirable-mark
4652            gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark
4653            gnus-duplicate-mark)
4654      'reverse)))
4655
4656 (defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks)
4657 (make-obsolete 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks)
4658
4659 (defun gnus-summary-limit-to-marks (marks &optional reverse)
4660   "Limit the summary buffer to articles that are marked with MARKS (e.g. \"DK\").
4661 If REVERSE, limit the summary buffer to articles that are not marked
4662 with MARKS.  MARKS can either be a string of marks or a list of marks.
4663 Returns how many articles were removed."
4664   (interactive "sMarks: ")
4665   (gnus-set-global-variables)
4666   (prog1
4667       (let ((data gnus-newsgroup-data)
4668             (marks (if (listp marks) marks
4669                      (append marks nil))) ; Transform to list.
4670             articles)
4671         (while data
4672           (and (if reverse (not (memq (gnus-data-mark (car data)) marks))
4673                  (memq (gnus-data-mark (car data)) marks))
4674                (setq articles (cons (gnus-data-number (car data)) articles)))
4675           (setq data (cdr data)))
4676         (gnus-summary-limit articles))
4677     (gnus-summary-position-point)))
4678
4679 (defun gnus-summary-limit-to-score (&optional score)
4680   "Limit to articles with score at or above SCORE."
4681   (interactive "P")
4682   (gnus-set-global-variables)
4683   (setq score (if score
4684                   (prefix-numeric-value score)
4685                 (or gnus-summary-default-score 0)))
4686   (let ((data gnus-newsgroup-data)
4687         articles)
4688     (while data
4689       (when (>= (gnus-summary-article-score (gnus-data-number (car data)))
4690                 score)
4691         (push (gnus-data-number (car data)) articles))
4692       (setq data (cdr data)))
4693     (prog1
4694         (gnus-summary-limit articles)
4695       (gnus-summary-position-point))))
4696
4697 (defun gnus-summary-limit-include-dormant ()
4698   "Display all the hidden articles that are marked as dormant."
4699   (interactive)
4700   (gnus-set-global-variables)
4701   (or gnus-newsgroup-dormant
4702       (error "There are no dormant articles in this group"))
4703   (prog1
4704       (gnus-summary-limit (append gnus-newsgroup-dormant gnus-newsgroup-limit))
4705     (gnus-summary-position-point)))
4706
4707 (defun gnus-summary-limit-exclude-dormant ()
4708   "Hide all dormant articles."
4709   (interactive)
4710   (gnus-set-global-variables)
4711   (prog1
4712       (gnus-summary-limit-to-marks (list gnus-dormant-mark) 'reverse)
4713     (gnus-summary-position-point)))
4714
4715 (defun gnus-summary-limit-exclude-childless-dormant ()
4716   "Hide all dormant articles that have no children."
4717   (interactive)
4718   (gnus-set-global-variables)
4719   (let ((data (gnus-data-list t))
4720         articles d children)
4721     ;; Find all articles that are either not dormant or have
4722     ;; children.
4723     (while (setq d (pop data))
4724       (when (or (not (= (gnus-data-mark d) gnus-dormant-mark))
4725                 (and (setq children 
4726                            (gnus-article-children (gnus-data-number d)))
4727                      (let (found)
4728                        (while children
4729                          (when (memq (car children) articles)
4730                            (setq children nil
4731                                  found t))
4732                          (pop children))
4733                        found)))
4734         (push (gnus-data-number d) articles)))
4735     ;; Do the limiting.
4736     (prog1
4737         (gnus-summary-limit articles)
4738       (gnus-summary-position-point))))
4739
4740 (defun gnus-summary-limit-mark-excluded-as-read (&optional all)
4741   "Mark all unread excluded articles as read.
4742 If ALL, mark even excluded ticked and dormants as read."
4743   (interactive "P")
4744   (let ((articles (gnus-sorted-complement
4745                    (sort
4746                     (mapcar (lambda (h) (mail-header-number h))
4747                             gnus-newsgroup-headers)
4748                     '<)
4749                    (sort gnus-newsgroup-limit '<)))
4750         article)
4751     (setq gnus-newsgroup-unreads nil)
4752     (if all
4753         (setq gnus-newsgroup-dormant nil
4754               gnus-newsgroup-marked nil
4755               gnus-newsgroup-reads
4756               (nconc
4757                (mapcar (lambda (n) (cons n gnus-catchup-mark)) articles)
4758                gnus-newsgroup-reads))
4759       (while (setq article (pop articles))
4760         (unless (or (memq article gnus-newsgroup-dormant)
4761                     (memq article gnus-newsgroup-marked))
4762           (push (cons article gnus-catchup-mark) gnus-newsgroup-reads))))))
4763
4764 (defun gnus-summary-limit (articles &optional pop)
4765   (if pop
4766       ;; We pop the previous limit off the stack and use that.
4767       (setq articles (car gnus-newsgroup-limits)
4768             gnus-newsgroup-limits (cdr gnus-newsgroup-limits))
4769     ;; We use the new limit, so we push the old limit on the stack.
4770     (setq gnus-newsgroup-limits
4771           (cons gnus-newsgroup-limit gnus-newsgroup-limits)))
4772   ;; Set the limit.
4773   (setq gnus-newsgroup-limit articles)
4774   (let ((total (length gnus-newsgroup-data))
4775         (data (gnus-data-find-list (gnus-summary-article-number)))
4776         (gnus-summary-mark-below nil)   ; Inhibit this.
4777         found)
4778     ;; This will do all the work of generating the new summary buffer
4779     ;; according to the new limit.
4780     (gnus-summary-prepare)
4781     ;; Hide any threads, possibly.
4782     (and gnus-show-threads
4783          gnus-thread-hide-subtree
4784          (gnus-summary-hide-all-threads))
4785     ;; Try to return to the article you were at, or one in the
4786     ;; neighborhood.
4787     (when data
4788       ;; We try to find some article after the current one.
4789       (while data
4790         (when (gnus-summary-goto-subject (gnus-data-number (car data)) nil t)
4791           (setq data nil
4792                 found t))
4793         (setq data (cdr data))))
4794     (unless found
4795       ;; If there is no data, that means that we were after the last
4796       ;; article.  The same goes when we can't find any articles
4797       ;; after the current one.
4798       (goto-char (point-max))
4799       (gnus-summary-find-prev))
4800     ;; We return how many articles were removed from the summary
4801     ;; buffer as a result of the new limit.
4802     (- total (length gnus-newsgroup-data))))
4803
4804 (defsubst gnus-invisible-cut-children (threads)
4805   (let ((num 0))
4806     (while threads
4807       (when (memq (mail-header-number (caar threads)) gnus-newsgroup-limit)
4808         (incf num))
4809       (pop threads))
4810     (< num 2)))
4811
4812 (defsubst gnus-cut-thread (thread)
4813   "Go forwards in the thread until we find an article that we want to display."
4814   (when (or (eq gnus-fetch-old-headers 'some)
4815             (eq gnus-build-sparse-threads 'some)
4816             (eq gnus-build-sparse-threads 'more))
4817     ;; Deal with old-fetched headers and sparse threads.
4818     (while (and
4819             thread
4820             (or
4821              (memq (mail-header-number (car thread)) gnus-newsgroup-sparse)
4822              (memq (mail-header-number (car thread)) gnus-newsgroup-ancient))
4823             (or (<= (length (cdr thread)) 1)
4824                 (gnus-invisible-cut-children (cdr thread))))
4825       (setq thread (cadr thread))))
4826   thread)
4827
4828 (defun gnus-cut-threads (threads)
4829   "Cut off all uninteresting articles from the beginning of threads."
4830   (when (or (eq gnus-fetch-old-headers 'some)
4831             (eq gnus-build-sparse-threads 'some)
4832             (eq gnus-build-sparse-threads 'more))
4833     (let ((th threads))
4834       (while th
4835         (setcar th (gnus-cut-thread (car th)))
4836         (setq th (cdr th)))))
4837   ;; Remove nixed out threads.
4838   (delq nil threads))
4839
4840 (defun gnus-summary-initial-limit (&optional show-if-empty)
4841   "Figure out what the initial limit is supposed to be on group entry.
4842 This entails weeding out unwanted dormants, low-scored articles,
4843 fetch-old-headers verbiage, and so on."
4844   ;; Most groups have nothing to remove.
4845   (if (or gnus-inhibit-limiting
4846           (and (null gnus-newsgroup-dormant)
4847                (not (eq gnus-fetch-old-headers 'some))
4848                (null gnus-summary-expunge-below)
4849                (not (eq gnus-build-sparse-threads 'some))
4850                (not (eq gnus-build-sparse-threads 'more))
4851                (null gnus-thread-expunge-below)
4852                (not gnus-use-nocem)))
4853       () ; Do nothing.
4854     (push gnus-newsgroup-limit gnus-newsgroup-limits)
4855     (setq gnus-newsgroup-limit nil)
4856     (mapatoms
4857      (lambda (node)
4858        (unless (car (symbol-value node))
4859          ;; These threads have no parents -- they are roots.
4860          (let ((nodes (cdr (symbol-value node)))
4861                thread)
4862            (while nodes
4863              (if (and gnus-thread-expunge-below
4864                       (< (gnus-thread-total-score (car nodes))
4865                          gnus-thread-expunge-below))
4866                  (gnus-expunge-thread (pop nodes))
4867                (setq thread (pop nodes))
4868                (gnus-summary-limit-children thread))))))
4869      gnus-newsgroup-dependencies)
4870     ;; If this limitation resulted in an empty group, we might
4871     ;; pop the previous limit and use it instead.
4872     (when (and (not gnus-newsgroup-limit)
4873                show-if-empty)
4874       (setq gnus-newsgroup-limit (pop gnus-newsgroup-limits)))
4875     gnus-newsgroup-limit))
4876
4877 (defun gnus-summary-limit-children (thread)
4878   "Return 1 if this subthread is visible and 0 if it is not."
4879   ;; First we get the number of visible children to this thread.  This
4880   ;; is done by recursing down the thread using this function, so this
4881   ;; will really go down to a leaf article first, before slowly
4882   ;; working its way up towards the root.
4883   (when thread
4884     (let ((children
4885            (if (cdr thread)
4886                (apply '+ (mapcar 'gnus-summary-limit-children
4887                                  (cdr thread)))
4888              0))
4889           (number (mail-header-number (car thread)))
4890           score)
4891       (if (or
4892            ;; If this article is dormant and has absolutely no visible
4893            ;; children, then this article isn't visible.
4894            (and (memq number gnus-newsgroup-dormant)
4895                 (= children 0))
4896            ;; If this is "fetch-old-headered" and there is only one
4897            ;; visible child (or less), then we don't want this article.
4898            (and (eq gnus-fetch-old-headers 'some)
4899                 (memq number gnus-newsgroup-ancient)
4900                 (zerop children))
4901            ;; If this is a sparsely inserted article with no children,
4902            ;; we don't want it.
4903            (and (eq gnus-build-sparse-threads 'some)
4904                 (memq number gnus-newsgroup-sparse)
4905                 (zerop children))
4906            ;; If we use expunging, and this article is really
4907            ;; low-scored, then we don't want this article.
4908            (when (and gnus-summary-expunge-below
4909                       (< (setq score
4910                                (or (cdr (assq number gnus-newsgroup-scored))
4911                                    gnus-summary-default-score))
4912                          gnus-summary-expunge-below))
4913              ;; We increase the expunge-tally here, but that has
4914              ;; nothing to do with the limits, really.
4915              (incf gnus-newsgroup-expunged-tally)
4916              ;; We also mark as read here, if that's wanted.
4917              (when (and gnus-summary-mark-below
4918                         (< score gnus-summary-mark-below))
4919                (setq gnus-newsgroup-unreads
4920                      (delq number gnus-newsgroup-unreads))
4921                (if gnus-newsgroup-auto-expire
4922                    (push number gnus-newsgroup-expirable)
4923                  (push (cons number gnus-low-score-mark)
4924                        gnus-newsgroup-reads)))
4925              t)
4926            (and gnus-use-nocem
4927                 (gnus-nocem-unwanted-article-p (mail-header-id (car thread)))))
4928           ;; Nope, invisible article.
4929           0
4930         ;; Ok, this article is to be visible, so we add it to the limit
4931         ;; and return 1.
4932         (setq gnus-newsgroup-limit (cons number gnus-newsgroup-limit))
4933         1))))
4934
4935 (defun gnus-expunge-thread (thread)
4936   "Mark all articles in THREAD as read."
4937   (let* ((number (mail-header-number (car thread))))
4938     (incf gnus-newsgroup-expunged-tally)
4939     ;; We also mark as read here, if that's wanted.
4940     (setq gnus-newsgroup-unreads
4941           (delq number gnus-newsgroup-unreads))
4942     (if gnus-newsgroup-auto-expire
4943         (push number gnus-newsgroup-expirable)
4944       (push (cons number gnus-low-score-mark)
4945             gnus-newsgroup-reads)))
4946   ;; Go recursively through all subthreads.
4947   (mapcar 'gnus-expunge-thread (cdr thread)))
4948
4949 ;; Summary article oriented commands
4950
4951 (defun gnus-summary-refer-parent-article (n)
4952   "Refer parent article N times.
4953 The difference between N and the number of articles fetched is returned."
4954   (interactive "p")
4955   (gnus-set-global-variables)
4956   (while
4957       (and
4958        (> n 0)
4959        (let* ((header (gnus-summary-article-header))
4960               (ref
4961                ;; If we try to find the parent of the currently
4962                ;; displayed article, then we take a look at the actual
4963                ;; References header, since this is slightly more
4964                ;; reliable than the References field we got from the
4965                ;; server.
4966                (if (and (eq (mail-header-number header)
4967                             (cdr gnus-article-current))
4968                         (equal gnus-newsgroup-name
4969                                (car gnus-article-current)))
4970                    (save-excursion
4971                      (set-buffer gnus-original-article-buffer)
4972                      (nnheader-narrow-to-headers)
4973                      (prog1
4974                          (message-fetch-field "references")
4975                        (widen)))
4976                  ;; It's not the current article, so we take a bet on
4977                  ;; the value we got from the server.
4978                  (mail-header-references header))))
4979          (if (setq ref (or ref (mail-header-references header)))
4980              (or (gnus-summary-refer-article (gnus-parent-id ref))
4981                  (gnus-message 1 "Couldn't find parent"))
4982            (gnus-message 1 "No references in article %d"
4983                          (gnus-summary-article-number))
4984            nil)))
4985     (setq n (1- n)))
4986   (gnus-summary-position-point)
4987   n)
4988
4989 (defun gnus-summary-refer-references ()
4990   "Fetch all articles mentioned in the References header.
4991 Return how many articles were fetched."
4992   (interactive)
4993   (gnus-set-global-variables)
4994   (let ((ref (mail-header-references (gnus-summary-article-header)))
4995         (current (gnus-summary-article-number))
4996         (n 0))
4997     ;; For each Message-ID in the References header...
4998     (while (string-match "<[^>]*>" ref)
4999       (incf n)
5000       ;; ... fetch that article.
5001       (gnus-summary-refer-article
5002        (prog1 (match-string 0 ref)
5003          (setq ref (substring ref (match-end 0))))))
5004     (gnus-summary-goto-subject current)
5005     (gnus-summary-position-point)
5006     n))
5007
5008 (defun gnus-summary-refer-article (message-id)
5009   "Fetch an article specified by MESSAGE-ID."
5010   (interactive "sMessage-ID: ")
5011   (when (and (stringp message-id)
5012              (not (zerop (length message-id))))
5013     ;; Construct the correct Message-ID if necessary.
5014     ;; Suggested by tale@pawl.rpi.edu.
5015     (unless (string-match "^<" message-id)
5016       (setq message-id (concat "<" message-id)))
5017     (unless (string-match ">$" message-id)
5018       (setq message-id (concat message-id ">")))
5019     (let* ((header (gnus-id-to-header message-id))
5020            (sparse (and header
5021                         (memq (mail-header-number header)
5022                               gnus-newsgroup-sparse))))
5023       (if header
5024           (prog1
5025               ;; The article is present in the buffer, to we just go to it.
5026               (gnus-summary-goto-article 
5027                (mail-header-number header) nil header)
5028             (when sparse
5029               (gnus-summary-update-article (mail-header-number header))))
5030         ;; We fetch the article
5031         (let ((gnus-override-method 
5032                (and (gnus-news-group-p gnus-newsgroup-name)
5033                     gnus-refer-article-method))
5034               number)
5035           ;; Start the special refer-article method, if necessary.
5036           (when (and gnus-refer-article-method
5037                      (gnus-news-group-p gnus-newsgroup-name))
5038             (gnus-check-server gnus-refer-article-method))
5039           ;; Fetch the header, and display the article.
5040           (if (setq number (gnus-summary-insert-subject message-id))
5041               (gnus-summary-select-article nil nil nil number)
5042             (gnus-message 3 "Couldn't fetch article %s" message-id)))))))
5043
5044 (defun gnus-summary-enter-digest-group (&optional force)
5045   "Enter an nndoc group based on the current article.
5046 If FORCE, force a digest interpretation.  If not, try
5047 to guess what the document format is."
5048   (interactive "P")
5049   (gnus-set-global-variables)
5050   (gnus-summary-select-article)
5051   (let ((name (format "%s-%d"
5052                       (gnus-group-prefixed-name
5053                        gnus-newsgroup-name (list 'nndoc ""))
5054                       gnus-current-article))
5055         (ogroup gnus-newsgroup-name)
5056         (case-fold-search t)
5057         (buf (current-buffer))
5058         dig)
5059     (save-excursion
5060       (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*"))
5061       (insert-buffer-substring gnus-original-article-buffer)
5062       (narrow-to-region
5063        (goto-char (point-min))
5064        (or (search-forward "\n\n" nil t) (point)))
5065       (goto-char (point-min))
5066       (delete-matching-lines "^\\(Path\\):\\|^From ")
5067       (widen))
5068     (unwind-protect
5069         (if (gnus-group-read-ephemeral-group
5070              name `(nndoc ,name (nndoc-address
5071                                  ,(get-buffer dig))
5072                           (nndoc-article-type ,(if force 'digest 'guess))) t)
5073             ;; Make all postings to this group go to the parent group.
5074             (nconc (gnus-info-params (gnus-get-info name))
5075                    (list (cons 'to-group ogroup)))
5076           ;; Couldn't select this doc group.
5077           (switch-to-buffer buf)
5078           (gnus-set-global-variables)
5079           (gnus-configure-windows 'summary)
5080           (gnus-message 3 "Article couldn't be entered?"))
5081       (kill-buffer dig))))
5082
5083 (defun gnus-summary-read-document (n)
5084   "Open a new group based on the current article(s).
5085 Obeys the standard process/prefix convention."
5086   (interactive "P")
5087   (let ((articles (gnus-summary-work-articles n))
5088         (ogroup gnus-newsgroup-name)
5089         article group egroup groups vgroup)
5090     (while (setq article (pop articles))
5091       (setq group (format "%s-%d" gnus-newsgroup-name gnus-current-article))
5092       (gnus-summary-remove-process-mark article)
5093       (when (gnus-summary-display-article article)
5094         (save-excursion
5095           (nnheader-temp-write nil
5096             (insert-buffer-substring gnus-original-article-buffer)
5097             ;; Remove some headers that may lead nndoc to make
5098             ;; the wrong guess.
5099             (message-narrow-to-head)
5100             (goto-char (point-min))
5101             (delete-matching-lines "^\\(Path\\):\\|^From ")
5102             (widen)
5103             (if (setq egroup
5104                       (gnus-group-read-ephemeral-group
5105                        group `(nndoc ,group (nndoc-address ,(current-buffer))
5106                                      (nndoc-article-type guess))
5107                        t nil t))
5108                 (progn
5109                   ;; Make all postings to this group go to the parent group.
5110                   (nconc (gnus-info-params (gnus-get-info egroup))
5111                          (list (cons 'to-group ogroup)))
5112                   (push egroup groups))
5113               ;; Couldn't select this doc group.
5114               (gnus-error 3 "Article couldn't be entered"))))))
5115     ;; Now we have selected all the documents.
5116     (cond
5117      ((not groups)
5118       (error "None of the articles could be interpreted as documents"))
5119      ((gnus-group-read-ephemeral-group
5120        (setq vgroup (format "%s-%s" gnus-newsgroup-name (current-time-string)))
5121        `(nnvirtual ,vgroup (nnvirtual-component-groups ,groups))
5122        t))
5123      (t
5124       (error "Couldn't select virtual nndoc group")))))
5125       
5126 (defun gnus-summary-isearch-article (&optional regexp-p)
5127   "Do incremental search forward on the current article.
5128 If REGEXP-P (the prefix) is non-nil, do regexp isearch."
5129   (interactive "P")
5130   (gnus-set-global-variables)
5131   (gnus-summary-select-article)
5132   (gnus-configure-windows 'article)
5133   (gnus-eval-in-buffer-window gnus-article-buffer
5134     ;;(goto-char (point-min))
5135     (isearch-forward regexp-p)))
5136
5137 (defun gnus-summary-search-article-forward (regexp &optional backward)
5138   "Search for an article containing REGEXP forward.
5139 If BACKWARD, search backward instead."
5140   (interactive
5141    (list (read-string
5142           (format "Search article %s (regexp%s): "
5143                   (if current-prefix-arg "backward" "forward")
5144                   (if gnus-last-search-regexp
5145                       (concat ", default " gnus-last-search-regexp)
5146                     "")))
5147          current-prefix-arg))
5148   (gnus-set-global-variables)
5149   (if (string-equal regexp "")
5150       (setq regexp (or gnus-last-search-regexp ""))
5151     (setq gnus-last-search-regexp regexp))
5152   (if (gnus-summary-search-article regexp backward)
5153       (gnus-summary-show-thread)
5154     (error "Search failed: \"%s\"" regexp)))
5155
5156 (defun gnus-summary-search-article-backward (regexp)
5157   "Search for an article containing REGEXP backward."
5158   (interactive
5159    (list (read-string
5160           (format "Search article backward (regexp%s): "
5161                   (if gnus-last-search-regexp
5162                       (concat ", default " gnus-last-search-regexp)
5163                     "")))))
5164   (gnus-summary-search-article-forward regexp 'backward))
5165
5166 (defun gnus-summary-search-article (regexp &optional backward)
5167   "Search for an article containing REGEXP.
5168 Optional argument BACKWARD means do search for backward.
5169 `gnus-select-article-hook' is not called during the search."
5170   (let ((gnus-select-article-hook nil)  ;Disable hook.
5171         (gnus-article-display-hook nil)
5172         (gnus-mark-article-hook nil)    ;Inhibit marking as read.
5173         (gnus-use-article-prefetch nil)
5174         (re-search
5175          (if backward
5176              're-search-backward 're-search-forward))
5177         (sum (current-buffer))
5178         (found nil))
5179     (gnus-save-hidden-threads
5180       (gnus-summary-select-article)
5181       (set-buffer gnus-article-buffer)
5182       (when backward
5183         (forward-line -1))
5184       (while (not found)
5185         (gnus-message 7 "Searching article: %d..." (cdr gnus-article-current))
5186         (if (if backward
5187                 (re-search-backward regexp nil t)
5188               (re-search-forward regexp nil t))
5189             ;; We found the regexp.
5190             (progn
5191               (setq found 'found)
5192               (beginning-of-line)
5193               (set-window-start
5194                (get-buffer-window (current-buffer))
5195                (point))
5196               (forward-line 1)
5197               (set-buffer sum))
5198           ;; We didn't find it, so we go to the next article.
5199           (set-buffer sum)
5200           (if (not (if backward (gnus-summary-find-prev)
5201                      (gnus-summary-find-next)))
5202               ;; No more articles.
5203               (setq found t)
5204             ;; Select the next article and adjust point.
5205             (gnus-summary-select-article)
5206             (set-buffer gnus-article-buffer)
5207             (widen)
5208             (goto-char (if backward (point-max) (point-min))))))
5209       (gnus-message 7 ""))
5210     ;; Return whether we found the regexp.
5211     (when (eq found 'found)
5212       (gnus-summary-show-thread)
5213       (gnus-summary-goto-subject gnus-current-article)
5214       (gnus-summary-position-point)
5215       t)))
5216
5217 (defun gnus-summary-find-matching (header regexp &optional backward unread
5218                                           not-case-fold)
5219   "Return a list of all articles that match REGEXP on HEADER.
5220 The search stars on the current article and goes forwards unless
5221 BACKWARD is non-nil.  If BACKWARD is `all', do all articles.
5222 If UNREAD is non-nil, only unread articles will
5223 be taken into consideration.  If NOT-CASE-FOLD, case won't be folded
5224 in the comparisons."
5225   (let ((data (if (eq backward 'all) gnus-newsgroup-data
5226                 (gnus-data-find-list
5227                  (gnus-summary-article-number) (gnus-data-list backward))))
5228         (func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))
5229         (case-fold-search (not not-case-fold))
5230         articles d)
5231     (or (fboundp (intern (concat "mail-header-" header)))
5232         (error "%s is not a valid header" header))
5233     (while data
5234       (setq d (car data))
5235       (and (or (not unread)             ; We want all articles...
5236                (gnus-data-unread-p d))  ; Or just unreads.
5237            (vectorp (gnus-data-header d)) ; It's not a pseudo.
5238            (string-match regexp (funcall func (gnus-data-header d))) ; Match.
5239            (setq articles (cons (gnus-data-number d) articles))) ; Success!
5240       (setq data (cdr data)))
5241     (nreverse articles)))
5242
5243 (defun gnus-summary-execute-command (header regexp command &optional backward)
5244   "Search forward for an article whose HEADER matches REGEXP and execute COMMAND.
5245 If HEADER is an empty string (or nil), the match is done on the entire
5246 article.  If BACKWARD (the prefix) is non-nil, search backward instead."
5247   (interactive
5248    (list (let ((completion-ignore-case t))
5249            (completing-read
5250             "Header name: "
5251             (mapcar (lambda (string) (list string))
5252                     '("Number" "Subject" "From" "Lines" "Date"
5253                       "Message-ID" "Xref" "References" "Body"))
5254             nil 'require-match))
5255          (read-string "Regexp: ")
5256          (read-key-sequence "Command: ")
5257          current-prefix-arg))
5258   (when (equal header "Body")
5259     (setq header ""))
5260   (gnus-set-global-variables)
5261   ;; Hidden thread subtrees must be searched as well.
5262   (gnus-summary-show-all-threads)
5263   ;; We don't want to change current point nor window configuration.
5264   (save-excursion
5265     (save-window-excursion
5266       (gnus-message 6 "Executing %s..." (key-description command))
5267       ;; We'd like to execute COMMAND interactively so as to give arguments.
5268       (gnus-execute header regexp
5269                     `(lambda () (call-interactively ',(key-binding command)))
5270                     backward)
5271       (gnus-message 6 "Executing %s...done" (key-description command)))))
5272
5273 (defun gnus-summary-beginning-of-article ()
5274   "Scroll the article back to the beginning."
5275   (interactive)
5276   (gnus-set-global-variables)
5277   (gnus-summary-select-article)
5278   (gnus-configure-windows 'article)
5279   (gnus-eval-in-buffer-window gnus-article-buffer
5280     (widen)
5281     (goto-char (point-min))
5282     (and gnus-break-pages (gnus-narrow-to-page))))
5283
5284 (defun gnus-summary-end-of-article ()
5285   "Scroll to the end of the article."
5286   (interactive)
5287   (gnus-set-global-variables)
5288   (gnus-summary-select-article)
5289   (gnus-configure-windows 'article)
5290   (gnus-eval-in-buffer-window gnus-article-buffer
5291     (widen)
5292     (goto-char (point-max))
5293     (recenter -3)
5294     (and gnus-break-pages (gnus-narrow-to-page))))
5295
5296 (defun gnus-summary-show-article (&optional arg)
5297   "Force re-fetching of the current article.
5298 If ARG (the prefix) is non-nil, show the raw article without any
5299 article massaging functions being run."
5300   (interactive "P")
5301   (gnus-set-global-variables)
5302   (if (not arg)
5303       ;; Select the article the normal way.
5304       (gnus-summary-select-article nil 'force)
5305     ;; Bind the article treatment functions to nil.
5306     (let ((gnus-have-all-headers t)
5307           gnus-article-display-hook
5308           gnus-article-prepare-hook
5309           gnus-break-pages
5310           gnus-visual)
5311       (gnus-summary-select-article nil 'force)))
5312   (gnus-summary-goto-subject gnus-current-article)
5313 ;  (gnus-configure-windows 'article)
5314   (gnus-summary-position-point))
5315
5316 (defun gnus-summary-verbose-headers (&optional arg)
5317   "Toggle permanent full header display.
5318 If ARG is a positive number, turn header display on.
5319 If ARG is a negative number, turn header display off."
5320   (interactive "P")
5321   (gnus-set-global-variables)
5322   (gnus-summary-toggle-header arg)
5323   (setq gnus-show-all-headers
5324         (cond ((or (not (numberp arg))
5325                    (zerop arg))
5326                (not gnus-show-all-headers))
5327               ((natnump arg)
5328                t))))
5329
5330 (defun gnus-summary-toggle-header (&optional arg)
5331   "Show the headers if they are hidden, or hide them if they are shown.
5332 If ARG is a positive number, show the entire header.
5333 If ARG is a negative number, hide the unwanted header lines."
5334   (interactive "P")
5335   (gnus-set-global-variables)
5336   (save-excursion
5337     (set-buffer gnus-article-buffer)
5338     (let* ((buffer-read-only nil)
5339            (inhibit-point-motion-hooks t)
5340            (hidden (text-property-any
5341                     (goto-char (point-min)) (search-forward "\n\n")
5342                     'invisible t))
5343            e)
5344       (goto-char (point-min))
5345       (when (search-forward "\n\n" nil t)
5346         (delete-region (point-min) (1- (point))))
5347       (goto-char (point-min))
5348       (save-excursion
5349         (set-buffer gnus-original-article-buffer)
5350         (goto-char (point-min))
5351         (setq e (1- (or (search-forward "\n\n" nil t) (point-max)))))
5352       (insert-buffer-substring gnus-original-article-buffer 1 e)
5353       (let ((article-inhibit-hiding t))
5354         (run-hooks 'gnus-article-display-hook))
5355       (if (or (not hidden) (and (numberp arg) (< arg 0)))
5356           (gnus-article-hide-headers)))))
5357
5358 (defun gnus-summary-show-all-headers ()
5359   "Make all header lines visible."
5360   (interactive)
5361   (gnus-set-global-variables)
5362   (gnus-article-show-all-headers))
5363
5364 (defun gnus-summary-toggle-mime (&optional arg)
5365   "Toggle MIME processing.
5366 If ARG is a positive number, turn MIME processing on."
5367   (interactive "P")
5368   (gnus-set-global-variables)
5369   (setq gnus-show-mime
5370         (if (null arg) (not gnus-show-mime)
5371           (> (prefix-numeric-value arg) 0)))
5372   (gnus-summary-select-article t 'force))
5373
5374 (defun gnus-summary-caesar-message (&optional arg)
5375   "Caesar rotate the current article by 13.
5376 The numerical prefix specifies how manu places to rotate each letter
5377 forward."
5378   (interactive "P")
5379   (gnus-set-global-variables)
5380   (gnus-summary-select-article)
5381   (let ((mail-header-separator ""))
5382     (gnus-eval-in-buffer-window gnus-article-buffer
5383       (save-restriction
5384         (widen)
5385         (let ((start (window-start))
5386               buffer-read-only)
5387           (message-caesar-buffer-body arg)
5388           (set-window-start (get-buffer-window (current-buffer)) start))))))
5389
5390 (defun gnus-summary-stop-page-breaking ()
5391   "Stop page breaking in the current article."
5392   (interactive)
5393   (gnus-set-global-variables)
5394   (gnus-summary-select-article)
5395   (gnus-eval-in-buffer-window gnus-article-buffer
5396     (widen)))
5397
5398 (defun gnus-summary-move-article (&optional n to-newsgroup select-method action)
5399   "Move the current article to a different newsgroup.
5400 If N is a positive number, move the N next articles.
5401 If N is a negative number, move the N previous articles.
5402 If N is nil and any articles have been marked with the process mark,
5403 move those articles instead.
5404 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to.
5405 If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but
5406 re-spool using this method.
5407
5408 For this function to work, both the current newsgroup and the
5409 newsgroup that you want to move to have to support the `request-move'
5410 and `request-accept' functions."
5411   (interactive "P")
5412   (unless action (setq action 'move))
5413   (gnus-set-global-variables)
5414   ;; Check whether the source group supports the required functions.
5415   (cond ((and (eq action 'move)
5416               (not (gnus-check-backend-function
5417                     'request-move-article gnus-newsgroup-name)))
5418          (error "The current group does not support article moving"))
5419         ((and (eq action 'crosspost)
5420               (not (gnus-check-backend-function
5421                     'request-replace-article gnus-newsgroup-name)))
5422          (error "The current group does not support article editing")))
5423   (let ((articles (gnus-summary-work-articles n))
5424         (prefix (gnus-group-real-prefix gnus-newsgroup-name))
5425         (names '((move "Move" "Moving")
5426                  (copy "Copy" "Copying")
5427                  (crosspost "Crosspost" "Crossposting")))
5428         (copy-buf (save-excursion
5429                     (nnheader-set-temp-buffer " *copy article*")))
5430         art-group to-method new-xref article to-groups)
5431     (unless (assq action names)
5432       (error "Unknown action %s" action))
5433     ;; Read the newsgroup name.
5434     (when (and (not to-newsgroup)
5435                (not select-method))
5436       (setq to-newsgroup
5437             (gnus-read-move-group-name
5438              (cadr (assq action names))
5439              (symbol-value (intern (format "gnus-current-%s-group" action)))
5440              articles prefix))
5441       (set (intern (format "gnus-current-%s-group" action)) to-newsgroup))
5442     (setq to-method (or select-method 
5443                         (gnus-group-name-to-method to-newsgroup)))
5444     ;; Check the method we are to move this article to...
5445     (or (gnus-check-backend-function 'request-accept-article (car to-method))
5446         (error "%s does not support article copying" (car to-method)))
5447     (or (gnus-check-server to-method)
5448         (error "Can't open server %s" (car to-method)))
5449     (gnus-message 6 "%s to %s: %s..."
5450                   (caddr (assq action names))
5451                   (or (car select-method) to-newsgroup) articles)
5452     (while articles
5453       (setq article (pop articles))
5454       (setq
5455        art-group
5456        (cond
5457         ;; Move the article.
5458         ((eq action 'move)
5459          (gnus-request-move-article
5460           article                       ; Article to move
5461           gnus-newsgroup-name           ; From newsgrouo
5462           (nth 1 (gnus-find-method-for-group
5463                   gnus-newsgroup-name)) ; Server
5464           (list 'gnus-request-accept-article
5465                 to-newsgroup (list 'quote select-method)
5466                 (not articles))         ; Accept form
5467           (not articles)))              ; Only save nov last time
5468         ;; Copy the article.
5469         ((eq action 'copy)
5470          (save-excursion
5471            (set-buffer copy-buf)
5472            (gnus-request-article-this-buffer article gnus-newsgroup-name)
5473            (gnus-request-accept-article
5474             to-newsgroup select-method (not articles))))
5475         ;; Crosspost the article.
5476         ((eq action 'crosspost)
5477          (let ((xref (mail-header-xref (gnus-summary-article-header article))))
5478            (setq new-xref (concat gnus-newsgroup-name ":" article))
5479            (if (and xref (not (string= xref "")))
5480                (progn
5481                  (when (string-match "^Xref: " xref)
5482                    (setq xref (substring xref (match-end 0))))
5483                  (setq new-xref (concat xref " " new-xref)))
5484              (setq new-xref (concat (system-name) " " new-xref)))
5485            (save-excursion
5486              (set-buffer copy-buf)
5487              (gnus-request-article-this-buffer article gnus-newsgroup-name)
5488              (nnheader-replace-header "xref" new-xref)
5489              (gnus-request-accept-article
5490               to-newsgroup select-method (not articles)))))))
5491       (if (not art-group)
5492           (gnus-message 1 "Couldn't %s article %s"
5493                         (cadr (assq action names)) article)
5494         (let* ((entry
5495                 (or
5496                  (gnus-gethash (car art-group) gnus-newsrc-hashtb)
5497                  (gnus-gethash
5498                   (gnus-group-prefixed-name
5499                    (car art-group)
5500                    (or select-method 
5501                        (gnus-find-method-for-group to-newsgroup)))
5502                   gnus-newsrc-hashtb)))
5503                (info (nth 2 entry))
5504                (to-group (gnus-info-group info)))
5505           ;; Update the group that has been moved to.
5506           (when (and info
5507                      (memq action '(move copy)))
5508             (unless (member to-group to-groups)
5509               (push to-group to-groups))
5510
5511             (unless (memq article gnus-newsgroup-unreads)
5512               (gnus-info-set-read
5513                info (gnus-add-to-range (gnus-info-read info)
5514                                        (list (cdr art-group)))))
5515
5516             ;; Copy any marks over to the new group.
5517             (let ((marks gnus-article-mark-lists)
5518                   (to-article (cdr art-group)))
5519
5520               ;; See whether the article is to be put in the cache.
5521               (when gnus-use-cache
5522                 (gnus-cache-possibly-enter-article
5523                  to-group to-article
5524                  (let ((header (copy-sequence
5525                                 (gnus-summary-article-header article))))
5526                    (mail-header-set-number header to-article)
5527                    header)
5528                  (memq article gnus-newsgroup-marked)
5529                  (memq article gnus-newsgroup-dormant)
5530                  (memq article gnus-newsgroup-unreads)))
5531
5532               (while marks
5533                 (when (memq article (symbol-value
5534                                      (intern (format "gnus-newsgroup-%s"
5535                                                      (caar marks)))))
5536                   ;; If the other group is the same as this group,
5537                   ;; then we have to add the mark to the list.
5538                   (when (equal to-group gnus-newsgroup-name)
5539                     (set (intern (format "gnus-newsgroup-%s" (caar marks)))
5540                          (cons to-article
5541                                (symbol-value
5542                                 (intern (format "gnus-newsgroup-%s"
5543                                                 (caar marks)))))))
5544                   ;; Copy mark to other group.
5545                   (gnus-add-marked-articles
5546                    to-group (cdar marks) (list to-article) info))
5547                 (setq marks (cdr marks)))))
5548
5549           ;; Update the Xref header in this article to point to
5550           ;; the new crossposted article we have just created.
5551           (when (eq action 'crosspost)
5552             (save-excursion
5553               (set-buffer copy-buf)
5554               (gnus-request-article-this-buffer article gnus-newsgroup-name)
5555               (nnheader-replace-header
5556                "xref" (concat new-xref " " (gnus-group-prefixed-name
5557                                             (car art-group) to-method)
5558                               ":" (cdr art-group)))
5559               (gnus-request-replace-article
5560                article gnus-newsgroup-name (current-buffer)))))
5561
5562         (gnus-summary-goto-subject article)
5563         (when (eq action 'move)
5564           (gnus-summary-mark-article article gnus-canceled-mark)))
5565       (gnus-summary-remove-process-mark article))
5566     ;; Re-activate all groups that have been moved to.
5567     (while to-groups
5568       (gnus-activate-group (pop to-groups)))
5569     
5570     (gnus-kill-buffer copy-buf)
5571     (gnus-summary-position-point)
5572     (gnus-set-mode-line 'summary)))
5573
5574 (defun gnus-summary-copy-article (&optional n to-newsgroup select-method)
5575   "Move the current article to a different newsgroup.
5576 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to.
5577 If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but
5578 re-spool using this method."
5579   (interactive "P")
5580   (gnus-summary-move-article n nil select-method 'copy))
5581
5582 (defun gnus-summary-crosspost-article (&optional n)
5583   "Crosspost the current article to some other group."
5584   (interactive "P")
5585   (gnus-summary-move-article n nil nil 'crosspost))
5586
5587 (defvar gnus-summary-respool-default-method nil
5588   "Default method for respooling an article.  
5589 If nil, use to the current newsgroup method.")
5590
5591 (defun gnus-summary-respool-article (&optional n method)
5592   "Respool the current article.
5593 The article will be squeezed through the mail spooling process again,
5594 which means that it will be put in some mail newsgroup or other
5595 depending on `nnmail-split-methods'.
5596 If N is a positive number, respool the N next articles.
5597 If N is a negative number, respool the N previous articles.
5598 If N is nil and any articles have been marked with the process mark,
5599 respool those articles instead.
5600
5601 Respooling can be done both from mail groups and \"real\" newsgroups.
5602 In the former case, the articles in question will be moved from the
5603 current group into whatever groups they are destined to.  In the
5604 latter case, they will be copied into the relevant groups."
5605   (interactive 
5606    (list current-prefix-arg
5607          (let* ((methods (gnus-methods-using 'respool))
5608                 (methname
5609                  (symbol-name (or gnus-summary-respool-default-method
5610                                   (car (gnus-find-method-for-group
5611                                         gnus-newsgroup-name)))))
5612                 (method
5613                  (gnus-completing-read 
5614                   methname "What backend do you want to use when respooling?"
5615                   methods nil t nil 'gnus-method-history))
5616                 ms)
5617            (cond
5618             ((zerop (length (setq ms (gnus-servers-using-backend method))))
5619              (list (intern method) ""))
5620             ((= 1 (length ms))
5621              (car ms))
5622             (t
5623              (cdr (completing-read 
5624                    "Server name: "
5625                    (mapcar (lambda (m) (cons (cadr m) m)) ms) nil t)))))))
5626   (gnus-set-global-variables)
5627   (unless method
5628     (error "No method given for respooling"))
5629   (if (assoc (symbol-name
5630               (car (gnus-find-method-for-group gnus-newsgroup-name)))
5631              (gnus-methods-using 'respool))
5632       (gnus-summary-move-article n nil method)
5633     (gnus-summary-copy-article n nil method)))
5634
5635 (defun gnus-summary-import-article (file)
5636   "Import a random file into a mail newsgroup."
5637   (interactive "fImport file: ")
5638   (gnus-set-global-variables)
5639   (let ((group gnus-newsgroup-name)
5640         (now (current-time))
5641         atts lines)
5642     (or (gnus-check-backend-function 'request-accept-article group)
5643         (error "%s does not support article importing" group))
5644     (or (file-readable-p file)
5645         (not (file-regular-p file))
5646         (error "Can't read %s" file))
5647     (save-excursion
5648       (set-buffer (get-buffer-create " *import file*"))
5649       (buffer-disable-undo (current-buffer))
5650       (erase-buffer)
5651       (insert-file-contents file)
5652       (goto-char (point-min))
5653       (unless (nnheader-article-p)
5654         ;; This doesn't look like an article, so we fudge some headers.
5655         (setq atts (file-attributes file)
5656               lines (count-lines (point-min) (point-max)))
5657         (insert "From: " (read-string "From: ") "\n"
5658                 "Subject: " (read-string "Subject: ") "\n"
5659                 "Date: " (timezone-make-date-arpa-standard
5660                           (current-time-string (nth 5 atts))
5661                           (current-time-zone now)
5662                           (current-time-zone now)) "\n"
5663                 "Message-ID: " (message-make-message-id) "\n"
5664                 "Lines: " (int-to-string lines) "\n"
5665                 "Chars: " (int-to-string (nth 7 atts)) "\n\n"))
5666       (gnus-request-accept-article group nil t)
5667       (kill-buffer (current-buffer)))))
5668
5669 (defun gnus-summary-expire-articles (&optional now)
5670   "Expire all articles that are marked as expirable in the current group."
5671   (interactive)
5672   (gnus-set-global-variables)
5673   (when (gnus-check-backend-function
5674          'request-expire-articles gnus-newsgroup-name)
5675     ;; This backend supports expiry.
5676     (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name))
5677            (expirable (if total
5678                           (gnus-list-of-read-articles gnus-newsgroup-name)
5679                         (setq gnus-newsgroup-expirable
5680                               (sort gnus-newsgroup-expirable '<))))
5681            (expiry-wait (if now 'immediate
5682                           (gnus-group-find-parameter
5683                            gnus-newsgroup-name 'expiry-wait)))
5684            es)
5685       (when expirable
5686         ;; There are expirable articles in this group, so we run them
5687         ;; through the expiry process.
5688         (gnus-message 6 "Expiring articles...")
5689         ;; The list of articles that weren't expired is returned.
5690         (if expiry-wait
5691             (let ((nnmail-expiry-wait-function nil)
5692                   (nnmail-expiry-wait expiry-wait))
5693               (setq es (gnus-request-expire-articles
5694                         expirable gnus-newsgroup-name)))
5695           (setq es (gnus-request-expire-articles
5696                     expirable gnus-newsgroup-name)))
5697         (unless total
5698           (setq gnus-newsgroup-expirable es))
5699         ;; We go through the old list of expirable, and mark all
5700         ;; really expired articles as nonexistent.
5701         (unless (eq es expirable)       ;If nothing was expired, we don't mark.
5702           (let ((gnus-use-cache nil))
5703             (while expirable
5704               (unless (memq (car expirable) es)
5705                 (when (gnus-data-find (car expirable))
5706                   (gnus-summary-mark-article
5707                    (car expirable) gnus-canceled-mark)))
5708               (setq expirable (cdr expirable)))))
5709         (gnus-message 6 "Expiring articles...done")))))
5710
5711 (defun gnus-summary-expire-articles-now ()
5712   "Expunge all expirable articles in the current group.
5713 This means that *all* articles that are marked as expirable will be
5714 deleted forever, right now."
5715   (interactive)
5716   (gnus-set-global-variables)
5717   (or gnus-expert-user
5718       (gnus-y-or-n-p
5719        "Are you really, really, really sure you want to delete all these messages? ")
5720       (error "Phew!"))
5721   (gnus-summary-expire-articles t))
5722
5723 ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
5724 (defun gnus-summary-delete-article (&optional n)
5725   "Delete the N next (mail) articles.
5726 This command actually deletes articles.  This is not a marking
5727 command.  The article will disappear forever from your life, never to
5728 return.
5729 If N is negative, delete backwards.
5730 If N is nil and articles have been marked with the process mark,
5731 delete these instead."
5732   (interactive "P")
5733   (gnus-set-global-variables)
5734   (or (gnus-check-backend-function 'request-expire-articles
5735                                    gnus-newsgroup-name)
5736       (error "The current newsgroup does not support article deletion."))
5737   ;; Compute the list of articles to delete.
5738   (let ((articles (gnus-summary-work-articles n))
5739         not-deleted)
5740     (if (and gnus-novice-user
5741              (not (gnus-y-or-n-p
5742                    (format "Do you really want to delete %s forever? "
5743                            (if (> (length articles) 1) 
5744                                (format "these %s articles" (length articles))
5745                              "this article")))))
5746         ()
5747       ;; Delete the articles.
5748       (setq not-deleted (gnus-request-expire-articles
5749                          articles gnus-newsgroup-name 'force))
5750       (while articles
5751         (gnus-summary-remove-process-mark (car articles))
5752         ;; The backend might not have been able to delete the article
5753         ;; after all.
5754         (or (memq (car articles) not-deleted)
5755             (gnus-summary-mark-article (car articles) gnus-canceled-mark))
5756         (setq articles (cdr articles))))
5757     (gnus-summary-position-point)
5758     (gnus-set-mode-line 'summary)
5759     not-deleted))
5760
5761 (defun gnus-summary-edit-article (&optional force)
5762   "Edit the current article.
5763 This will have permanent effect only in mail groups.
5764 If FORCE is non-nil, allow editing of articles even in read-only
5765 groups." 
5766   (interactive "P")
5767   (save-excursion
5768     (set-buffer gnus-summary-buffer)
5769     (gnus-set-global-variables)
5770     (when (and (not force)
5771                (gnus-group-read-only-p))
5772       (error "The current newsgroup does not support article editing."))
5773     ;; Select article if needed.
5774     (unless (eq (gnus-summary-article-number)
5775                 gnus-current-article)
5776       (gnus-summary-select-article t))
5777     (gnus-article-edit-article
5778      `(lambda ()
5779         (gnus-summary-edit-article-done
5780          ,(or (mail-header-references gnus-current-headers) "")
5781          ,(gnus-group-read-only-p) ,gnus-summary-buffer)))))
5782
5783 (defalias 'gnus-summary-edit-article-postpone 'gnus-article-edit-exit)
5784
5785 (defun gnus-summary-edit-article-done (references read-only buffer)
5786   "Make edits to the current article permanent."
5787   (interactive)
5788   ;; Replace the article.
5789   (if (and (not read-only)
5790            (not (gnus-request-replace-article
5791                  (cdr gnus-article-current) (car gnus-article-current)
5792                  (current-buffer))))
5793       (error "Couldn't replace article.")
5794     ;; Update the summary buffer.
5795     (if (equal (message-tokenize-header references " ")
5796                (message-tokenize-header
5797                 (or (message-fetch-field "references") "") " "))
5798         ;; We only have to update this line.
5799         (save-excursion
5800           (save-restriction
5801             (message-narrow-to-head)
5802             (let ((header (nnheader-parse-head t)))
5803               (set-buffer buffer)
5804               (mail-header-set-number header (cdr gnus-article-current))
5805               (gnus-summary-update-article-line
5806                (cdr gnus-article-current) header))))
5807       ;; Update threads.
5808       (set-buffer buffer)
5809       (gnus-summary-update-article (cdr gnus-article-current)))
5810     ;; Prettify the article buffer again.
5811     (save-excursion
5812       (set-buffer gnus-article-buffer)
5813       (run-hooks 'gnus-article-display-hook))
5814     ;; Prettify the summary buffer line.
5815     (when (gnus-visual-p 'summary-highlight 'highlight)
5816       (run-hooks 'gnus-visual-mark-article-hook))))
5817
5818 (defun gnus-summary-edit-wash (key)
5819   "Perform editing command in the article buffer."
5820   (interactive 
5821    (list
5822     (progn
5823       (message "%s" (concat (this-command-keys) "- "))
5824       (read-char))))
5825   (message "")
5826   (gnus-summary-edit-article)
5827   (execute-kbd-macro (concat (this-command-keys) key))
5828   (gnus-article-edit-done))
5829
5830 ;;; Respooling
5831
5832 (defun gnus-summary-respool-query ()
5833   "Query where the respool algorithm would put this article."
5834   (interactive)
5835   (gnus-set-global-variables)
5836   (gnus-summary-select-article)
5837   (save-excursion
5838     (set-buffer gnus-article-buffer)
5839     (save-restriction
5840       (goto-char (point-min))
5841       (search-forward "\n\n")
5842       (narrow-to-region (point-min) (point))
5843       (pp-eval-expression
5844        (list 'quote (mapcar 'car (nnmail-article-group 'identity)))))))
5845
5846 ;; Summary marking commands.
5847
5848 (defun gnus-summary-kill-same-subject-and-select (&optional unmark)
5849   "Mark articles which has the same subject as read, and then select the next.
5850 If UNMARK is positive, remove any kind of mark.
5851 If UNMARK is negative, tick articles."
5852   (interactive "P")
5853   (gnus-set-global-variables)
5854   (if unmark
5855       (setq unmark (prefix-numeric-value unmark)))
5856   (let ((count
5857          (gnus-summary-mark-same-subject
5858           (gnus-summary-article-subject) unmark)))
5859     ;; Select next unread article.  If auto-select-same mode, should
5860     ;; select the first unread article.
5861     (gnus-summary-next-article t (and gnus-auto-select-same
5862                                       (gnus-summary-article-subject)))
5863     (gnus-message 7 "%d article%s marked as %s"
5864                   count (if (= count 1) " is" "s are")
5865                   (if unmark "unread" "read"))))
5866
5867 (defun gnus-summary-kill-same-subject (&optional unmark)
5868   "Mark articles which has the same subject as read.
5869 If UNMARK is positive, remove any kind of mark.
5870 If UNMARK is negative, tick articles."
5871   (interactive "P")
5872   (gnus-set-global-variables)
5873   (if unmark
5874       (setq unmark (prefix-numeric-value unmark)))
5875   (let ((count
5876          (gnus-summary-mark-same-subject
5877           (gnus-summary-article-subject) unmark)))
5878     ;; If marked as read, go to next unread subject.
5879     (if (null unmark)
5880         ;; Go to next unread subject.
5881         (gnus-summary-next-subject 1 t))
5882     (gnus-message 7 "%d articles are marked as %s"
5883                   count (if unmark "unread" "read"))))
5884
5885 (defun gnus-summary-mark-same-subject (subject &optional unmark)
5886   "Mark articles with same SUBJECT as read, and return marked number.
5887 If optional argument UNMARK is positive, remove any kinds of marks.
5888 If optional argument UNMARK is negative, mark articles as unread instead."
5889   (let ((count 1))
5890     (save-excursion
5891       (cond
5892        ((null unmark)                   ; Mark as read.
5893         (while (and
5894                 (progn
5895                   (gnus-summary-mark-article-as-read gnus-killed-mark)
5896                   (gnus-summary-show-thread) t)
5897                 (gnus-summary-find-subject subject))
5898           (setq count (1+ count))))
5899        ((> unmark 0)                    ; Tick.
5900         (while (and
5901                 (progn
5902                   (gnus-summary-mark-article-as-unread gnus-ticked-mark)
5903                   (gnus-summary-show-thread) t)
5904                 (gnus-summary-find-subject subject))
5905           (setq count (1+ count))))
5906        (t                               ; Mark as unread.
5907         (while (and
5908                 (progn
5909                   (gnus-summary-mark-article-as-unread gnus-unread-mark)
5910                   (gnus-summary-show-thread) t)
5911                 (gnus-summary-find-subject subject))
5912           (setq count (1+ count)))))
5913       (gnus-set-mode-line 'summary)
5914       ;; Return the number of marked articles.
5915       count)))
5916
5917 (defun gnus-summary-mark-as-processable (n &optional unmark)
5918   "Set the process mark on the next N articles.
5919 If N is negative, mark backward instead.  If UNMARK is non-nil, remove
5920 the process mark instead.  The difference between N and the actual
5921 number of articles marked is returned."
5922   (interactive "p")
5923   (gnus-set-global-variables)
5924   (let ((backward (< n 0))
5925         (n (abs n)))
5926     (while (and
5927             (> n 0)
5928             (if unmark
5929                 (gnus-summary-remove-process-mark
5930                  (gnus-summary-article-number))
5931               (gnus-summary-set-process-mark (gnus-summary-article-number)))
5932             (zerop (gnus-summary-next-subject (if backward -1 1) nil t)))
5933       (setq n (1- n)))
5934     (if (/= 0 n) (gnus-message 7 "No more articles"))
5935     (gnus-summary-recenter)
5936     (gnus-summary-position-point)
5937     n))
5938
5939 (defun gnus-summary-unmark-as-processable (n)
5940   "Remove the process mark from the next N articles.
5941 If N is negative, mark backward instead.  The difference between N and
5942 the actual number of articles marked is returned."
5943   (interactive "p")
5944   (gnus-set-global-variables)
5945   (gnus-summary-mark-as-processable n t))
5946
5947 (defun gnus-summary-unmark-all-processable ()
5948   "Remove the process mark from all articles."
5949   (interactive)
5950   (gnus-set-global-variables)
5951   (save-excursion
5952     (while gnus-newsgroup-processable
5953       (gnus-summary-remove-process-mark (car gnus-newsgroup-processable))))
5954   (gnus-summary-position-point))
5955
5956 (defun gnus-summary-mark-as-expirable (n)
5957   "Mark N articles forward as expirable.
5958 If N is negative, mark backward instead.  The difference between N and
5959 the actual number of articles marked is returned."
5960   (interactive "p")
5961   (gnus-set-global-variables)
5962   (gnus-summary-mark-forward n gnus-expirable-mark))
5963
5964 (defun gnus-summary-mark-article-as-replied (article)
5965   "Mark ARTICLE replied and update the summary line."
5966   (setq gnus-newsgroup-replied (cons article gnus-newsgroup-replied))
5967   (let ((buffer-read-only nil))
5968     (when (gnus-summary-goto-subject article)
5969       (gnus-summary-update-secondary-mark article))))
5970
5971 (defun gnus-summary-set-bookmark (article)
5972   "Set a bookmark in current article."
5973   (interactive (list (gnus-summary-article-number)))
5974   (gnus-set-global-variables)
5975   (if (or (not (get-buffer gnus-article-buffer))
5976           (not gnus-current-article)
5977           (not gnus-article-current)
5978           (not (equal gnus-newsgroup-name (car gnus-article-current))))
5979       (error "No current article selected"))
5980   ;; Remove old bookmark, if one exists.
5981   (let ((old (assq article gnus-newsgroup-bookmarks)))
5982     (if old (setq gnus-newsgroup-bookmarks
5983                   (delq old gnus-newsgroup-bookmarks))))
5984   ;; Set the new bookmark, which is on the form
5985   ;; (article-number . line-number-in-body).
5986   (setq gnus-newsgroup-bookmarks
5987         (cons
5988          (cons article
5989                (save-excursion
5990                  (set-buffer gnus-article-buffer)
5991                  (count-lines
5992                   (min (point)
5993                        (save-excursion
5994                          (goto-char (point-min))
5995                          (search-forward "\n\n" nil t)
5996                          (point)))
5997                   (point))))
5998          gnus-newsgroup-bookmarks))
5999   (gnus-message 6 "A bookmark has been added to the current article."))
6000
6001 (defun gnus-summary-remove-bookmark (article)
6002   "Remove the bookmark from the current article."
6003   (interactive (list (gnus-summary-article-number)))
6004   (gnus-set-global-variables)
6005   ;; Remove old bookmark, if one exists.
6006   (let ((old (assq article gnus-newsgroup-bookmarks)))
6007     (if old
6008         (progn
6009           (setq gnus-newsgroup-bookmarks
6010                 (delq old gnus-newsgroup-bookmarks))
6011           (gnus-message 6 "Removed bookmark."))
6012       (gnus-message 6 "No bookmark in current article."))))
6013
6014 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
6015 (defun gnus-summary-mark-as-dormant (n)
6016   "Mark N articles forward as dormant.
6017 If N is negative, mark backward instead.  The difference between N and
6018 the actual number of articles marked is returned."
6019   (interactive "p")
6020   (gnus-set-global-variables)
6021   (gnus-summary-mark-forward n gnus-dormant-mark))
6022
6023 (defun gnus-summary-set-process-mark (article)
6024   "Set the process mark on ARTICLE and update the summary line."
6025   (setq gnus-newsgroup-processable
6026         (cons article
6027               (delq article gnus-newsgroup-processable)))
6028   (when (gnus-summary-goto-subject article)
6029     (gnus-summary-show-thread)
6030     (gnus-summary-update-secondary-mark article)))
6031
6032 (defun gnus-summary-remove-process-mark (article)
6033   "Remove the process mark from ARTICLE and update the summary line."
6034   (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable))
6035   (when (gnus-summary-goto-subject article)
6036     (gnus-summary-show-thread)
6037     (gnus-summary-update-secondary-mark article)))
6038
6039 (defun gnus-summary-set-saved-mark (article)
6040   "Set the process mark on ARTICLE and update the summary line."
6041   (push article gnus-newsgroup-saved)
6042   (when (gnus-summary-goto-subject article)
6043     (gnus-summary-update-secondary-mark article)))
6044
6045 (defun gnus-summary-mark-forward (n &optional mark no-expire)
6046   "Mark N articles as read forwards.
6047 If N is negative, mark backwards instead.  Mark with MARK, ?r by default.
6048 The difference between N and the actual number of articles marked is
6049 returned."
6050   (interactive "p")
6051   (gnus-set-global-variables)
6052   (let ((backward (< n 0))
6053         (gnus-summary-goto-unread
6054          (and gnus-summary-goto-unread
6055               (not (eq gnus-summary-goto-unread 'never))
6056               (not (memq mark (list gnus-unread-mark
6057                                     gnus-ticked-mark gnus-dormant-mark)))))
6058         (n (abs n))
6059         (mark (or mark gnus-del-mark)))
6060     (while (and (> n 0)
6061                 (gnus-summary-mark-article nil mark no-expire)
6062                 (zerop (gnus-summary-next-subject
6063                         (if backward -1 1)
6064                         (and gnus-summary-goto-unread
6065                              (not (eq gnus-summary-goto-unread 'never)))
6066                         t)))
6067       (setq n (1- n)))
6068     (if (/= 0 n) (gnus-message 7 "No more %sarticles" (if mark "" "unread ")))
6069     (gnus-summary-recenter)
6070     (gnus-summary-position-point)
6071     (gnus-set-mode-line 'summary)
6072     n))
6073
6074 (defun gnus-summary-mark-article-as-read (mark)
6075   "Mark the current article quickly as read with MARK."
6076   (let ((article (gnus-summary-article-number)))
6077     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
6078     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
6079     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
6080     (setq gnus-newsgroup-reads
6081           (cons (cons article mark) gnus-newsgroup-reads))
6082     ;; Possibly remove from cache, if that is used.
6083     (and gnus-use-cache (gnus-cache-enter-remove-article article))
6084     ;; Allow the backend to change the mark.
6085     (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
6086     ;; Check for auto-expiry.
6087     (when (and gnus-newsgroup-auto-expire
6088                (or (= mark gnus-killed-mark) (= mark gnus-del-mark)
6089                    (= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
6090                    (= mark gnus-ancient-mark)
6091                    (= mark gnus-read-mark) (= mark gnus-souped-mark)
6092                    (= mark gnus-duplicate-mark)))
6093       (setq mark gnus-expirable-mark)
6094       (push article gnus-newsgroup-expirable))
6095     ;; Set the mark in the buffer.
6096     (gnus-summary-update-mark mark 'unread)
6097     t))
6098
6099 (defun gnus-summary-mark-article-as-unread (mark)
6100   "Mark the current article quickly as unread with MARK."
6101   (let ((article (gnus-summary-article-number)))
6102     (if (< article 0)
6103         (gnus-error 1 "Unmarkable article")
6104       (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
6105       (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
6106       (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
6107       (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads))
6108       (cond ((= mark gnus-ticked-mark)
6109              (push article gnus-newsgroup-marked))
6110             ((= mark gnus-dormant-mark)
6111              (push article gnus-newsgroup-dormant))
6112             (t
6113              (push article gnus-newsgroup-unreads)))
6114       (setq gnus-newsgroup-reads
6115             (delq (assq article gnus-newsgroup-reads)
6116                   gnus-newsgroup-reads))
6117
6118       ;; See whether the article is to be put in the cache.
6119       (and gnus-use-cache
6120            (vectorp (gnus-summary-article-header article))
6121            (save-excursion
6122              (gnus-cache-possibly-enter-article
6123               gnus-newsgroup-name article
6124               (gnus-summary-article-header article)
6125               (= mark gnus-ticked-mark)
6126               (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
6127
6128       ;; Fix the mark.
6129       (gnus-summary-update-mark mark 'unread))
6130     t))
6131
6132 (defun gnus-summary-mark-article (&optional article mark no-expire)
6133   "Mark ARTICLE with MARK.  MARK can be any character.
6134 Four MARK strings are reserved: `? ' (unread), `?!' (ticked),
6135 `??' (dormant) and `?E' (expirable).
6136 If MARK is nil, then the default character `?D' is used.
6137 If ARTICLE is nil, then the article on the current line will be
6138 marked."
6139   ;; The mark might be a string.
6140   (and (stringp mark)
6141        (setq mark (aref mark 0)))
6142   ;; If no mark is given, then we check auto-expiring.
6143   (and (not no-expire)
6144        gnus-newsgroup-auto-expire
6145        (or (not mark)
6146            (and (numberp mark)
6147                 (or (= mark gnus-killed-mark) (= mark gnus-del-mark)
6148                     (= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
6149                     (= mark gnus-read-mark) (= mark gnus-souped-mark)
6150                     (= mark gnus-duplicate-mark))))
6151        (setq mark gnus-expirable-mark))
6152   (let* ((mark (or mark gnus-del-mark))
6153          (article (or article (gnus-summary-article-number))))
6154     (or article (error "No article on current line"))
6155     (if (or (= mark gnus-unread-mark)
6156             (= mark gnus-ticked-mark)
6157             (= mark gnus-dormant-mark))
6158         (gnus-mark-article-as-unread article mark)
6159       (gnus-mark-article-as-read article mark))
6160
6161     ;; See whether the article is to be put in the cache.
6162     (and gnus-use-cache
6163          (not (= mark gnus-canceled-mark))
6164          (vectorp (gnus-summary-article-header article))
6165          (save-excursion
6166            (gnus-cache-possibly-enter-article
6167             gnus-newsgroup-name article
6168             (gnus-summary-article-header article)
6169             (= mark gnus-ticked-mark)
6170             (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
6171
6172     (if (gnus-summary-goto-subject article nil t)
6173         (let ((buffer-read-only nil))
6174           (gnus-summary-show-thread)
6175           ;; Fix the mark.
6176           (gnus-summary-update-mark mark 'unread)
6177           t))))
6178
6179 (defun gnus-summary-update-secondary-mark (article)
6180   "Update the secondary (read, process, cache) mark."
6181   (gnus-summary-update-mark
6182    (cond ((memq article gnus-newsgroup-processable)
6183           gnus-process-mark)
6184          ((memq article gnus-newsgroup-cached)
6185           gnus-cached-mark)
6186          ((memq article gnus-newsgroup-replied)
6187           gnus-replied-mark)
6188          ((memq article gnus-newsgroup-saved)
6189           gnus-saved-mark)
6190          (t gnus-unread-mark))
6191    'replied)
6192   (when (gnus-visual-p 'summary-highlight 'highlight)
6193     (run-hooks 'gnus-summary-update-hook))
6194   t)
6195
6196 (defun gnus-summary-update-mark (mark type)
6197   (let ((forward (cdr (assq type gnus-summary-mark-positions)))
6198         (buffer-read-only nil))
6199     (re-search-backward "[\n\r]" (gnus-point-at-bol) 'move-to-limit)
6200     (and (looking-at "\r") (setq forward (1+ forward)))
6201     (when (and forward
6202                (<= (+ forward (point)) (point-max)))
6203       ;; Go to the right position on the line.
6204       (goto-char (+ forward (point)))
6205       ;; Replace the old mark with the new mark.
6206       (subst-char-in-region (point) (1+ (point)) (following-char) mark)
6207       ;; Optionally update the marks by some user rule.
6208       (when (eq type 'unread)
6209         (gnus-data-set-mark
6210          (gnus-data-find (gnus-summary-article-number)) mark)
6211         (gnus-summary-update-line (eq mark gnus-unread-mark))))))
6212
6213 (defun gnus-mark-article-as-read (article &optional mark)
6214   "Enter ARTICLE in the pertinent lists and remove it from others."
6215   ;; Make the article expirable.
6216   (let ((mark (or mark gnus-del-mark)))
6217     (if (= mark gnus-expirable-mark)
6218         (setq gnus-newsgroup-expirable (cons article gnus-newsgroup-expirable))
6219       (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)))
6220     ;; Remove from unread and marked lists.
6221     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
6222     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
6223     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
6224     (push (cons article mark) gnus-newsgroup-reads)
6225     ;; Possibly remove from cache, if that is used.
6226     (when gnus-use-cache
6227       (gnus-cache-enter-remove-article article))))
6228
6229 (defun gnus-mark-article-as-unread (article &optional mark)
6230   "Enter ARTICLE in the pertinent lists and remove it from others."
6231   (let ((mark (or mark gnus-ticked-mark)))
6232     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)
6233           gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)
6234           gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)
6235           gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
6236
6237     ;; Unsuppress duplicates?
6238     (when gnus-suppress-duplicates
6239       (gnus-dup-unsuppress-article article))
6240
6241     (cond ((= mark gnus-ticked-mark)
6242            (push article gnus-newsgroup-marked))
6243           ((= mark gnus-dormant-mark)
6244            (push article gnus-newsgroup-dormant))
6245           (t
6246            (push article gnus-newsgroup-unreads)))
6247     (setq gnus-newsgroup-reads
6248           (delq (assq article gnus-newsgroup-reads)
6249                 gnus-newsgroup-reads))))
6250
6251 (defalias 'gnus-summary-mark-as-unread-forward
6252   'gnus-summary-tick-article-forward)
6253 (make-obsolete 'gnus-summary-mark-as-unread-forward
6254                'gnus-summary-tick-article-forward)
6255 (defun gnus-summary-tick-article-forward (n)
6256   "Tick N articles forwards.
6257 If N is negative, tick backwards instead.
6258 The difference between N and the number of articles ticked is returned."
6259   (interactive "p")
6260   (gnus-summary-mark-forward n gnus-ticked-mark))
6261
6262 (defalias 'gnus-summary-mark-as-unread-backward
6263   'gnus-summary-tick-article-backward)
6264 (make-obsolete 'gnus-summary-mark-as-unread-backward
6265                'gnus-summary-tick-article-backward)
6266 (defun gnus-summary-tick-article-backward (n)
6267   "Tick N articles backwards.
6268 The difference between N and the number of articles ticked is returned."
6269   (interactive "p")
6270   (gnus-summary-mark-forward (- n) gnus-ticked-mark))
6271
6272 (defalias 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
6273 (make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
6274 (defun gnus-summary-tick-article (&optional article clear-mark)
6275   "Mark current article as unread.
6276 Optional 1st argument ARTICLE specifies article number to be marked as unread.
6277 Optional 2nd argument CLEAR-MARK remove any kinds of mark."
6278   (interactive)
6279   (gnus-summary-mark-article article (if clear-mark gnus-unread-mark
6280                                        gnus-ticked-mark)))
6281
6282 (defun gnus-summary-mark-as-read-forward (n)
6283   "Mark N articles as read forwards.
6284 If N is negative, mark backwards instead.
6285 The difference between N and the actual number of articles marked is
6286 returned."
6287   (interactive "p")
6288   (gnus-summary-mark-forward n gnus-del-mark t))
6289
6290 (defun gnus-summary-mark-as-read-backward (n)
6291   "Mark the N articles as read backwards.
6292 The difference between N and the actual number of articles marked is
6293 returned."
6294   (interactive "p")
6295   (gnus-summary-mark-forward (- n) gnus-del-mark t))
6296
6297 (defun gnus-summary-mark-as-read (&optional article mark)
6298   "Mark current article as read.
6299 ARTICLE specifies the article to be marked as read.
6300 MARK specifies a string to be inserted at the beginning of the line."
6301   (gnus-summary-mark-article article mark))
6302
6303 (defun gnus-summary-clear-mark-forward (n)
6304   "Clear marks from N articles forward.
6305 If N is negative, clear backward instead.
6306 The difference between N and the number of marks cleared is returned."
6307   (interactive "p")
6308   (gnus-summary-mark-forward n gnus-unread-mark))
6309
6310 (defun gnus-summary-clear-mark-backward (n)
6311   "Clear marks from N articles backward.
6312 The difference between N and the number of marks cleared is returned."
6313   (interactive "p")
6314   (gnus-summary-mark-forward (- n) gnus-unread-mark))
6315
6316 (defun gnus-summary-mark-unread-as-read ()
6317   "Intended to be used by `gnus-summary-mark-article-hook'."
6318   (when (memq gnus-current-article gnus-newsgroup-unreads)
6319     (gnus-summary-mark-article gnus-current-article gnus-read-mark)))
6320
6321 (defun gnus-summary-mark-read-and-unread-as-read ()
6322   "Intended to be used by `gnus-summary-mark-article-hook'."
6323   (let ((mark (gnus-summary-article-mark)))
6324     (when (or (gnus-unread-mark-p mark)
6325               (gnus-read-mark-p mark))
6326       (gnus-summary-mark-article gnus-current-article gnus-read-mark))))
6327
6328 (defun gnus-summary-mark-region-as-read (point mark all)
6329   "Mark all unread articles between point and mark as read.
6330 If given a prefix, mark all articles between point and mark as read,
6331 even ticked and dormant ones."
6332   (interactive "r\nP")
6333   (save-excursion
6334     (let (article)
6335       (goto-char point)
6336       (beginning-of-line)
6337       (while (and
6338               (< (point) mark)
6339               (progn
6340                 (when (or all
6341                           (memq (setq article (gnus-summary-article-number))
6342                                 gnus-newsgroup-unreads))
6343                   (gnus-summary-mark-article article gnus-del-mark))
6344                 t)
6345               (gnus-summary-find-next))))))
6346
6347 (defun gnus-summary-mark-below (score mark)
6348   "Mark articles with score less than SCORE with MARK."
6349   (interactive "P\ncMark: ")
6350   (gnus-set-global-variables)
6351   (setq score (if score
6352                   (prefix-numeric-value score)
6353                 (or gnus-summary-default-score 0)))
6354   (save-excursion
6355     (set-buffer gnus-summary-buffer)
6356     (goto-char (point-min))
6357     (while 
6358         (progn
6359           (and (< (gnus-summary-article-score) score)
6360                (gnus-summary-mark-article nil mark))
6361           (gnus-summary-find-next)))))
6362
6363 (defun gnus-summary-kill-below (&optional score)
6364   "Mark articles with score below SCORE as read."
6365   (interactive "P")
6366   (gnus-set-global-variables)
6367   (gnus-summary-mark-below score gnus-killed-mark))
6368
6369 (defun gnus-summary-clear-above (&optional score)
6370   "Clear all marks from articles with score above SCORE."
6371   (interactive "P")
6372   (gnus-set-global-variables)
6373   (gnus-summary-mark-above score gnus-unread-mark))
6374
6375 (defun gnus-summary-tick-above (&optional score)
6376   "Tick all articles with score above SCORE."
6377   (interactive "P")
6378   (gnus-set-global-variables)
6379   (gnus-summary-mark-above score gnus-ticked-mark))
6380
6381 (defun gnus-summary-mark-above (score mark)
6382   "Mark articles with score over SCORE with MARK."
6383   (interactive "P\ncMark: ")
6384   (gnus-set-global-variables)
6385   (setq score (if score
6386                   (prefix-numeric-value score)
6387                 (or gnus-summary-default-score 0)))
6388   (save-excursion
6389     (set-buffer gnus-summary-buffer)
6390     (goto-char (point-min))
6391     (while (and (progn
6392                   (if (> (gnus-summary-article-score) score)
6393                       (gnus-summary-mark-article nil mark))
6394                   t)
6395                 (gnus-summary-find-next)))))
6396
6397 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
6398 (defalias 'gnus-summary-show-all-expunged 'gnus-summary-limit-include-expunged)
6399 (defun gnus-summary-limit-include-expunged (&optional no-error)
6400   "Display all the hidden articles that were expunged for low scores."
6401   (interactive)
6402   (gnus-set-global-variables)
6403   (let ((buffer-read-only nil))
6404     (let ((scored gnus-newsgroup-scored)
6405           headers h)
6406       (while scored
6407         (or (gnus-summary-goto-subject (caar scored))
6408             (and (setq h (gnus-summary-article-header (caar scored)))
6409                  (< (cdar scored) gnus-summary-expunge-below)
6410                  (setq headers (cons h headers))))
6411         (setq scored (cdr scored)))
6412       (if (not headers)
6413           (when (not no-error)
6414             (error "No expunged articles hidden."))
6415         (goto-char (point-min))
6416         (gnus-summary-prepare-unthreaded (nreverse headers))
6417         (goto-char (point-min))
6418         (gnus-summary-position-point)
6419         t))))
6420
6421 (defun gnus-summary-catchup (&optional all quietly to-here not-mark)
6422   "Mark all articles not marked as unread in this newsgroup as read.
6423 If prefix argument ALL is non-nil, all articles are marked as read.
6424 If QUIETLY is non-nil, no questions will be asked.
6425 If TO-HERE is non-nil, it should be a point in the buffer.  All
6426 articles before this point will be marked as read.
6427 The number of articles marked as read is returned."
6428   (interactive "P")
6429   (gnus-set-global-variables)
6430   (prog1
6431       (when (or quietly
6432                 (not gnus-interactive-catchup) ;Without confirmation?
6433                 gnus-expert-user
6434                 (gnus-y-or-n-p
6435                  (if all
6436                      "Mark absolutely all articles as read? "
6437                    "Mark all unread articles as read? ")))
6438         (if (and not-mark
6439                  (not gnus-newsgroup-adaptive)
6440                  (not gnus-newsgroup-auto-expire))
6441             (progn
6442               (when all
6443                 (setq gnus-newsgroup-marked nil
6444                       gnus-newsgroup-dormant nil))
6445               (setq gnus-newsgroup-unreads nil))
6446           ;; We actually mark all articles as canceled, which we
6447           ;; have to do when using auto-expiry or adaptive scoring.
6448           (gnus-summary-show-all-threads)
6449           (when (gnus-summary-first-subject (not all))
6450             (while (and
6451                     (if to-here (< (point) to-here) t)
6452                     (gnus-summary-mark-article-as-read gnus-catchup-mark)
6453                     (gnus-summary-find-next (not all)))))
6454           (unless to-here
6455             (setq gnus-newsgroup-unreads nil))
6456           (gnus-set-mode-line 'summary)))
6457     (let ((method (gnus-find-method-for-group gnus-newsgroup-name)))
6458       (when (and (not to-here) (eq 'nnvirtual (car method)))
6459         (nnvirtual-catchup-group
6460          (gnus-group-real-name gnus-newsgroup-name) (nth 1 method) all)))
6461     (gnus-summary-position-point)))
6462
6463 (defun gnus-summary-catchup-to-here (&optional all)
6464   "Mark all unticked articles before the current one as read.
6465 If ALL is non-nil, also mark ticked and dormant articles as read."
6466   (interactive "P")
6467   (gnus-set-global-variables)
6468   (save-excursion
6469     (gnus-save-hidden-threads
6470       (let ((beg (point)))
6471         ;; We check that there are unread articles.
6472         (when (or all (gnus-summary-find-prev))
6473           (gnus-summary-catchup all t beg)))))
6474   (gnus-summary-position-point))
6475
6476 (defun gnus-summary-catchup-all (&optional quietly)
6477   "Mark all articles in this newsgroup as read."
6478   (interactive "P")
6479   (gnus-set-global-variables)
6480   (gnus-summary-catchup t quietly))
6481
6482 (defun gnus-summary-catchup-and-exit (&optional all quietly)
6483   "Mark all articles not marked as unread in this newsgroup as read, then exit.
6484 If prefix argument ALL is non-nil, all articles are marked as read."
6485   (interactive "P")
6486   (gnus-set-global-variables)
6487   (gnus-summary-catchup all quietly nil 'fast)
6488   ;; Select next newsgroup or exit.
6489   (if (eq gnus-auto-select-next 'quietly)
6490       (gnus-summary-next-group nil)
6491     (gnus-summary-exit)))
6492
6493 (defun gnus-summary-catchup-all-and-exit (&optional quietly)
6494   "Mark all articles in this newsgroup as read, and then exit."
6495   (interactive "P")
6496   (gnus-set-global-variables)
6497   (gnus-summary-catchup-and-exit t quietly))
6498
6499 ;; Suggested by "Arne Eofsson" <arne@hodgkin.mbi.ucla.edu>.
6500 (defun gnus-summary-catchup-and-goto-next-group (&optional all)
6501   "Mark all articles in this group as read and select the next group.
6502 If given a prefix, mark all articles, unread as well as ticked, as
6503 read."
6504   (interactive "P")
6505   (gnus-set-global-variables)
6506   (save-excursion
6507     (gnus-summary-catchup all))
6508   (gnus-summary-next-article t nil nil t))
6509
6510 ;; Thread-based commands.
6511
6512 (defun gnus-summary-articles-in-thread (&optional article)
6513   "Return a list of all articles in the current thread.
6514 If ARTICLE is non-nil, return all articles in the thread that starts
6515 with that article."
6516   (let* ((article (or article (gnus-summary-article-number)))
6517          (data (gnus-data-find-list article))
6518          (top-level (gnus-data-level (car data)))
6519          (top-subject
6520           (cond ((null gnus-thread-operation-ignore-subject)
6521                  (gnus-simplify-subject-re
6522                   (mail-header-subject (gnus-data-header (car data)))))
6523                 ((eq gnus-thread-operation-ignore-subject 'fuzzy)
6524                  (gnus-simplify-subject-fuzzy
6525                   (mail-header-subject (gnus-data-header (car data)))))
6526                 (t nil)))
6527          (end-point (save-excursion
6528                       (if (gnus-summary-go-to-next-thread) 
6529                           (point) (point-max))))
6530          articles)
6531     (while (and data
6532                 (< (gnus-data-pos (car data)) end-point))
6533       (when (or (not top-subject)
6534                 (string= top-subject
6535                          (if (eq gnus-thread-operation-ignore-subject 'fuzzy)
6536                              (gnus-simplify-subject-fuzzy
6537                               (mail-header-subject
6538                                (gnus-data-header (car data))))
6539                            (gnus-simplify-subject-re
6540                             (mail-header-subject
6541                              (gnus-data-header (car data)))))))
6542         (push (gnus-data-number (car data)) articles))
6543       (unless (and (setq data (cdr data))
6544                    (> (gnus-data-level (car data)) top-level))
6545         (setq data nil)))
6546     ;; Return the list of articles.
6547     (nreverse articles)))
6548
6549 (defun gnus-summary-rethread-current ()
6550   "Rethread the thread the current article is part of."
6551   (interactive)
6552   (gnus-set-global-variables)
6553   (let* ((gnus-show-threads t)
6554          (article (gnus-summary-article-number))
6555          (id (mail-header-id (gnus-summary-article-header)))
6556          (gnus-newsgroup-threads (list (gnus-id-to-thread (gnus-root-id id)))))
6557     (unless id
6558       (error "No article on the current line"))
6559     (gnus-rebuild-thread id)
6560     (gnus-summary-goto-subject article)))
6561
6562 (defun gnus-summary-reparent-thread ()
6563   "Make current article child of the marked (or previous) article.
6564
6565 Note that the re-threading will only work if `gnus-thread-ignore-subject'
6566 is non-nil or the Subject: of both articles are the same."
6567   (interactive)
6568   (or (not (gnus-group-read-only-p))
6569       (error "The current newsgroup does not support article editing."))
6570   (or (<= (length gnus-newsgroup-processable) 1)
6571       (error "No more than one article may be marked."))
6572   (save-window-excursion
6573     (let ((gnus-article-buffer " *reparent*")
6574           (current-article (gnus-summary-article-number))
6575           ; first grab the marked article, otherwise one line up.
6576           (parent-article (if (not (null gnus-newsgroup-processable))
6577                               (car gnus-newsgroup-processable)
6578                             (save-excursion
6579                               (if (eq (forward-line -1) 0)
6580                                   (gnus-summary-article-number)
6581                                 (error "Beginning of summary buffer."))))))
6582       (or (not (eq current-article parent-article))
6583           (error "An article may not be self-referential."))
6584       (let ((message-id (mail-header-id 
6585                          (gnus-summary-article-header parent-article))))
6586         (or (and message-id (not (equal message-id "")))
6587             (error "No message-id in desired parent."))
6588         (gnus-summary-select-article t t nil current-article)
6589         (set-buffer gnus-article-buffer)
6590         (setq buffer-read-only nil)
6591         (let ((buf (format "%s" (buffer-string))))
6592           (erase-buffer)
6593           (insert buf))
6594         (goto-char (point-min))
6595         (if (search-forward-regexp "^References: " nil t)
6596             (insert message-id " " )
6597           (insert "References: " message-id "\n"))
6598         (or (gnus-request-replace-article current-article
6599                                           (car gnus-article-current)
6600                                           gnus-article-buffer)
6601             (error "Couldn't replace article."))
6602         (set-buffer gnus-summary-buffer)
6603         (gnus-summary-unmark-all-processable)
6604         (gnus-summary-rethread-current)
6605         (gnus-message 3 "Article %d is now the child of article %d."
6606                       current-article parent-article)))))
6607
6608 (defun gnus-summary-toggle-threads (&optional arg)
6609   "Toggle showing conversation threads.
6610 If ARG is positive number, turn showing conversation threads on."
6611   (interactive "P")
6612   (gnus-set-global-variables)
6613   (let ((current (or (gnus-summary-article-number) gnus-newsgroup-end)))
6614     (setq gnus-show-threads
6615           (if (null arg) (not gnus-show-threads)
6616             (> (prefix-numeric-value arg) 0)))
6617     (gnus-summary-prepare)
6618     (gnus-summary-goto-subject current)
6619     (gnus-message 6 "Threading is now %s" (if gnus-show-threads "on" "off"))
6620     (gnus-summary-position-point)))
6621
6622 (defun gnus-summary-show-all-threads ()
6623   "Show all threads."
6624   (interactive)
6625   (gnus-set-global-variables)
6626   (save-excursion
6627     (let ((buffer-read-only nil))
6628       (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)))
6629   (gnus-summary-position-point))
6630
6631 (defun gnus-summary-show-thread ()
6632   "Show thread subtrees.
6633 Returns nil if no thread was there to be shown."
6634   (interactive)
6635   (gnus-set-global-variables)
6636   (let ((buffer-read-only nil)
6637         (orig (point))
6638         ;; first goto end then to beg, to have point at beg after let
6639         (end (progn (end-of-line) (point)))
6640         (beg (progn (beginning-of-line) (point))))
6641     (prog1
6642         ;; Any hidden lines here?
6643         (search-forward "\r" end t)
6644       (subst-char-in-region beg end ?\^M ?\n t)
6645       (goto-char orig)
6646       (gnus-summary-position-point))))
6647
6648 (defun gnus-summary-hide-all-threads ()
6649   "Hide all thread subtrees."
6650   (interactive)
6651   (gnus-set-global-variables)
6652   (save-excursion
6653     (goto-char (point-min))
6654     (gnus-summary-hide-thread)
6655     (while (zerop (gnus-summary-next-thread 1 t))
6656       (gnus-summary-hide-thread)))
6657   (gnus-summary-position-point))
6658
6659 (defun gnus-summary-hide-thread ()
6660   "Hide thread subtrees.
6661 Returns nil if no threads were there to be hidden."
6662   (interactive)
6663   (gnus-set-global-variables)
6664   (let ((buffer-read-only nil)
6665         (start (point))
6666         (article (gnus-summary-article-number)))
6667     (goto-char start)
6668     ;; Go forward until either the buffer ends or the subthread
6669     ;; ends.
6670     (when (and (not (eobp))
6671                (or (zerop (gnus-summary-next-thread 1 t))
6672                    (goto-char (point-max))))
6673       (prog1
6674           (if (and (> (point) start)
6675                    (search-backward "\n" start t))
6676               (progn
6677                 (subst-char-in-region start (point) ?\n ?\^M)
6678                 (gnus-summary-goto-subject article))
6679             (goto-char start)
6680             nil)
6681         ;;(gnus-summary-position-point)
6682         ))))
6683
6684 (defun gnus-summary-go-to-next-thread (&optional previous)
6685   "Go to the same level (or less) next thread.
6686 If PREVIOUS is non-nil, go to previous thread instead.
6687 Return the article number moved to, or nil if moving was impossible."
6688   (let ((level (gnus-summary-thread-level))
6689         (way (if previous -1 1))
6690         (beg (point)))
6691     (forward-line way)
6692     (while (and (not (eobp))
6693                 (< level (gnus-summary-thread-level)))
6694       (forward-line way))
6695     (if (eobp)
6696         (progn
6697           (goto-char beg)
6698           nil)
6699       (setq beg (point))
6700       (prog1
6701           (gnus-summary-article-number)
6702         (goto-char beg)))))
6703
6704 (defun gnus-summary-go-to-next-thread-old (&optional previous)
6705   "Go to the same level (or less) next thread.
6706 If PREVIOUS is non-nil, go to previous thread instead.
6707 Return the article number moved to, or nil if moving was impossible."
6708   (if (and (eq gnus-summary-make-false-root 'dummy)
6709            (gnus-summary-article-intangible-p))
6710       (let ((beg (point)))
6711         (while (and (zerop (forward-line 1))
6712                     (not (gnus-summary-article-intangible-p))
6713                     (not (zerop (save-excursion 
6714                                   (gnus-summary-thread-level))))))
6715         (if (eobp)
6716             (progn
6717               (goto-char beg)
6718               nil)
6719           (point)))
6720     (let* ((level (gnus-summary-thread-level))
6721            (article (gnus-summary-article-number))
6722            (data (cdr (gnus-data-find-list article (gnus-data-list previous))))
6723            oart)
6724       (while data
6725         (if (<= (gnus-data-level (car data)) level)
6726             (setq oart (gnus-data-number (car data))
6727                   data nil)
6728           (setq data (cdr data))))
6729       (and oart
6730            (gnus-summary-goto-subject oart)))))
6731
6732 (defun gnus-summary-next-thread (n &optional silent)
6733   "Go to the same level next N'th thread.
6734 If N is negative, search backward instead.
6735 Returns the difference between N and the number of skips actually
6736 done.
6737
6738 If SILENT, don't output messages."
6739   (interactive "p")
6740   (gnus-set-global-variables)
6741   (let ((backward (< n 0))
6742         (n (abs n))
6743         old dum int)
6744     (while (and (> n 0)
6745                 (gnus-summary-go-to-next-thread backward))
6746       (decf n))
6747     (unless silent 
6748       (gnus-summary-position-point))
6749     (when (and (not silent) (/= 0 n))
6750       (gnus-message 7 "No more threads"))
6751     n))
6752
6753 (defun gnus-summary-prev-thread (n)
6754   "Go to the same level previous N'th thread.
6755 Returns the difference between N and the number of skips actually
6756 done."
6757   (interactive "p")
6758   (gnus-set-global-variables)
6759   (gnus-summary-next-thread (- n)))
6760
6761 (defun gnus-summary-go-down-thread ()
6762   "Go down one level in the current thread."
6763   (let ((children (gnus-summary-article-children)))
6764     (and children
6765          (gnus-summary-goto-subject (car children)))))
6766
6767 (defun gnus-summary-go-up-thread ()
6768   "Go up one level in the current thread."
6769   (let ((parent (gnus-summary-article-parent)))
6770     (and parent
6771          (gnus-summary-goto-subject parent))))
6772
6773 (defun gnus-summary-down-thread (n)
6774   "Go down thread N steps.
6775 If N is negative, go up instead.
6776 Returns the difference between N and how many steps down that were
6777 taken."
6778   (interactive "p")
6779   (gnus-set-global-variables)
6780   (let ((up (< n 0))
6781         (n (abs n)))
6782     (while (and (> n 0)
6783                 (if up (gnus-summary-go-up-thread)
6784                   (gnus-summary-go-down-thread)))
6785       (setq n (1- n)))
6786     (gnus-summary-position-point)
6787     (if (/= 0 n) (gnus-message 7 "Can't go further"))
6788     n))
6789
6790 (defun gnus-summary-up-thread (n)
6791   "Go up thread N steps.
6792 If N is negative, go up instead.
6793 Returns the difference between N and how many steps down that were
6794 taken."
6795   (interactive "p")
6796   (gnus-set-global-variables)
6797   (gnus-summary-down-thread (- n)))
6798
6799 (defun gnus-summary-top-thread ()
6800   "Go to the top of the thread."
6801   (interactive)
6802   (gnus-set-global-variables)
6803   (while (gnus-summary-go-up-thread))
6804   (gnus-summary-article-number))
6805
6806 (defun gnus-summary-kill-thread (&optional unmark)
6807   "Mark articles under current thread as read.
6808 If the prefix argument is positive, remove any kinds of marks.
6809 If the prefix argument is negative, tick articles instead."
6810   (interactive "P")
6811   (gnus-set-global-variables)
6812   (when unmark
6813     (setq unmark (prefix-numeric-value unmark)))
6814   (let ((articles (gnus-summary-articles-in-thread)))
6815     (save-excursion
6816       ;; Expand the thread.
6817       (gnus-summary-show-thread)
6818       ;; Mark all the articles.
6819       (while articles
6820         (gnus-summary-goto-subject (car articles))
6821         (cond ((null unmark)
6822                (gnus-summary-mark-article-as-read gnus-killed-mark))
6823               ((> unmark 0)
6824                (gnus-summary-mark-article-as-unread gnus-unread-mark))
6825               (t
6826                (gnus-summary-mark-article-as-unread gnus-ticked-mark)))
6827         (setq articles (cdr articles))))
6828     ;; Hide killed subtrees.
6829     (and (null unmark)
6830          gnus-thread-hide-killed
6831          (gnus-summary-hide-thread))
6832     ;; If marked as read, go to next unread subject.
6833     (if (null unmark)
6834         ;; Go to next unread subject.
6835         (gnus-summary-next-subject 1 t)))
6836   (gnus-set-mode-line 'summary))
6837
6838 ;; Summary sorting commands
6839
6840 (defun gnus-summary-sort-by-number (&optional reverse)
6841   "Sort summary buffer by article number.
6842 Argument REVERSE means reverse order."
6843   (interactive "P")
6844   (gnus-summary-sort 'number reverse))
6845
6846 (defun gnus-summary-sort-by-author (&optional reverse)
6847   "Sort summary buffer by author name alphabetically.
6848 If case-fold-search is non-nil, case of letters is ignored.
6849 Argument REVERSE means reverse order."
6850   (interactive "P")
6851   (gnus-summary-sort 'author reverse))
6852
6853 (defun gnus-summary-sort-by-subject (&optional reverse)
6854   "Sort summary buffer by subject alphabetically. `Re:'s are ignored.
6855 If case-fold-search is non-nil, case of letters is ignored.
6856 Argument REVERSE means reverse order."
6857   (interactive "P")
6858   (gnus-summary-sort 'subject reverse))
6859
6860 (defun gnus-summary-sort-by-date (&optional reverse)
6861   "Sort summary buffer by date.
6862 Argument REVERSE means reverse order."
6863   (interactive "P")
6864   (gnus-summary-sort 'date reverse))
6865
6866 (defun gnus-summary-sort-by-score (&optional reverse)
6867   "Sort summary buffer by score.
6868 Argument REVERSE means reverse order."
6869   (interactive "P")
6870   (gnus-summary-sort 'score reverse))
6871
6872 (defun gnus-summary-sort (predicate reverse)
6873   "Sort summary buffer by PREDICATE.  REVERSE means reverse order."
6874   (gnus-set-global-variables)
6875   (let* ((thread (intern (format "gnus-thread-sort-by-%s" predicate)))
6876          (article (intern (format "gnus-article-sort-by-%s" predicate)))
6877          (gnus-thread-sort-functions
6878           (list
6879            (if (not reverse)
6880                thread
6881              `(lambda (t1 t2)
6882                 (,thread t2 t1)))))
6883          (gnus-article-sort-functions
6884           (list
6885            (if (not reverse)
6886                article
6887              `(lambda (t1 t2)
6888                 (,article t2 t1)))))
6889          (buffer-read-only)
6890          (gnus-summary-prepare-hook nil))
6891     ;; We do the sorting by regenerating the threads.
6892     (gnus-summary-prepare)
6893     ;; Hide subthreads if needed.
6894     (when (and gnus-show-threads gnus-thread-hide-subtree)
6895       (gnus-summary-hide-all-threads))))
6896
6897 ;; Summary saving commands.
6898
6899 (defun gnus-summary-save-article (&optional n not-saved)
6900   "Save the current article using the default saver function.
6901 If N is a positive number, save the N next articles.
6902 If N is a negative number, save the N previous articles.
6903 If N is nil and any articles have been marked with the process mark,
6904 save those articles instead.
6905 The variable `gnus-default-article-saver' specifies the saver function."
6906   (interactive "P")
6907   (gnus-set-global-variables)
6908   (let ((articles (gnus-summary-work-articles n))
6909         (save-buffer (save-excursion 
6910                        (nnheader-set-temp-buffer " *Gnus Save*")))
6911         header article file)
6912     (while articles
6913       (setq header (gnus-summary-article-header
6914                     (setq article (pop articles))))
6915       (if (not (vectorp header))
6916           ;; This is a pseudo-article.
6917           (if (assq 'name header)
6918               (gnus-copy-file (cdr (assq 'name header)))
6919             (gnus-message 1 "Article %d is unsaveable" article))
6920         ;; This is a real article.
6921         (save-window-excursion
6922           (gnus-summary-select-article t nil nil article))
6923         (save-excursion
6924           (set-buffer save-buffer)
6925           (erase-buffer)
6926           (insert-buffer-substring gnus-original-article-buffer))
6927         (setq file (gnus-article-save save-buffer file))
6928         (gnus-summary-remove-process-mark article)
6929         (unless not-saved
6930           (gnus-summary-set-saved-mark article))))
6931     (gnus-kill-buffer save-buffer)
6932     (gnus-summary-position-point)
6933     n))
6934
6935 (defun gnus-summary-pipe-output (&optional arg)
6936   "Pipe the current article to a subprocess.
6937 If N is a positive number, pipe the N next articles.
6938 If N is a negative number, pipe the N previous articles.
6939 If N is nil and any articles have been marked with the process mark,
6940 pipe those articles instead."
6941   (interactive "P")
6942   (gnus-set-global-variables)
6943   (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe))
6944     (gnus-summary-save-article arg t))
6945   (gnus-configure-windows 'pipe))
6946
6947 (defun gnus-summary-save-article-mail (&optional arg)
6948   "Append the current article to an mail file.
6949 If N is a positive number, save the N next articles.
6950 If N is a negative number, save the N previous articles.
6951 If N is nil and any articles have been marked with the process mark,
6952 save those articles instead."
6953   (interactive "P")
6954   (gnus-set-global-variables)
6955   (let ((gnus-default-article-saver 'gnus-summary-save-in-mail))
6956     (gnus-summary-save-article arg)))
6957
6958 (defun gnus-summary-save-article-rmail (&optional arg)
6959   "Append the current article to an rmail file.
6960 If N is a positive number, save the N next articles.
6961 If N is a negative number, save the N previous articles.
6962 If N is nil and any articles have been marked with the process mark,
6963 save those articles instead."
6964   (interactive "P")
6965   (gnus-set-global-variables)
6966   (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail))
6967     (gnus-summary-save-article arg)))
6968
6969 (defun gnus-summary-save-article-file (&optional arg)
6970   "Append the current article to a file.
6971 If N is a positive number, save the N next articles.
6972 If N is a negative number, save the N previous articles.
6973 If N is nil and any articles have been marked with the process mark,
6974 save those articles instead."
6975   (interactive "P")
6976   (gnus-set-global-variables)
6977   (let ((gnus-default-article-saver 'gnus-summary-save-in-file))
6978     (gnus-summary-save-article arg)))
6979
6980 (defun gnus-summary-save-article-body-file (&optional arg)
6981   "Append the current article body to a file.
6982 If N is a positive number, save the N next articles.
6983 If N is a negative number, save the N previous articles.
6984 If N is nil and any articles have been marked with the process mark,
6985 save those articles instead."
6986   (interactive "P")
6987   (gnus-set-global-variables)
6988   (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file))
6989     (gnus-summary-save-article arg)))
6990
6991 (defun gnus-get-split-value (methods)
6992   "Return a value based on the split METHODS."
6993   (let (split-name method result match)
6994     (when methods
6995       (save-excursion
6996         (set-buffer gnus-original-article-buffer)
6997         (save-restriction
6998           (nnheader-narrow-to-headers)
6999           (while methods
7000             (goto-char (point-min))
7001             (setq method (pop methods))
7002             (setq match (car method))
7003             (when (cond
7004                    ((stringp match)
7005                     ;; Regular expression.
7006                     (condition-case ()
7007                         (re-search-forward match nil t)
7008                       (error nil)))
7009                    ((gnus-functionp match)
7010                     ;; Function.
7011                     (save-restriction
7012                       (widen)
7013                       (setq result (funcall match gnus-newsgroup-name))))
7014                    ((consp match)
7015                     ;; Form.
7016                     (save-restriction
7017                       (widen)
7018                       (setq result (eval match)))))
7019               (setq split-name (append (cdr method) split-name))
7020               (cond ((stringp result)
7021                      (push result split-name))
7022                     ((consp result)
7023                      (setq split-name (append result split-name)))))))))
7024     split-name))
7025
7026 (defun gnus-read-move-group-name (prompt default articles prefix)
7027   "Read a group name."
7028   (let* ((split-name (gnus-get-split-value gnus-move-split-methods))
7029          (minibuffer-confirm-incomplete nil) ; XEmacs
7030          group-map
7031          (dum (mapatoms
7032                (lambda (g) 
7033                  (and (boundp g)
7034                       (symbol-name g)
7035                       (memq 'respool
7036                             (assoc (symbol-name
7037                                     (car (gnus-find-method-for-group
7038                                           (symbol-name g))))
7039                                    gnus-valid-select-methods))
7040                       (push (list (symbol-name g)) group-map)))
7041                gnus-active-hashtb))
7042          (prom
7043           (format "%s %s to:"
7044                   prompt
7045                   (if (> (length articles) 1)
7046                       (format "these %d articles" (length articles))
7047                     "this article")))
7048          (to-newsgroup
7049           (cond
7050            ((null split-name)
7051             (gnus-completing-read default prom
7052                                   group-map nil nil prefix
7053                                   'gnus-group-history))
7054            ((= 1 (length split-name))
7055             (gnus-completing-read (car split-name) prom group-map
7056                                   nil nil nil
7057                                   'gnus-group-history))
7058            (t
7059             (gnus-completing-read nil prom 
7060                                   (mapcar (lambda (el) (list el))
7061                                           (nreverse split-name))
7062                                   nil nil nil
7063                                   'gnus-group-history)))))
7064     (when to-newsgroup
7065       (if (or (string= to-newsgroup "")
7066               (string= to-newsgroup prefix))
7067           (setq to-newsgroup (or default "")))
7068       (or (gnus-active to-newsgroup)
7069           (gnus-activate-group to-newsgroup)
7070           (if (gnus-y-or-n-p (format "No such group: %s.  Create it? "
7071                                      to-newsgroup))
7072               (or (and (gnus-request-create-group 
7073                         to-newsgroup (gnus-group-name-to-method to-newsgroup))
7074                        (gnus-activate-group to-newsgroup nil nil
7075                                             (gnus-group-name-to-method
7076                                              to-newsgroup)))
7077                   (error "Couldn't create group %s" to-newsgroup)))
7078           (error "No such group: %s" to-newsgroup)))
7079     to-newsgroup))
7080
7081 ;; Summary extract commands
7082
7083 (defun gnus-summary-insert-pseudos (pslist &optional not-view)
7084   (let ((buffer-read-only nil)
7085         (article (gnus-summary-article-number))
7086         after-article b e)
7087     (or (gnus-summary-goto-subject article)
7088         (error (format "No such article: %d" article)))
7089     (gnus-summary-position-point)
7090     ;; If all commands are to be bunched up on one line, we collect
7091     ;; them here.
7092     (if gnus-view-pseudos-separately
7093         ()
7094       (let ((ps (setq pslist (sort pslist 'gnus-pseudos<)))
7095             files action)
7096         (while ps
7097           (setq action (cdr (assq 'action (car ps))))
7098           (setq files (list (cdr (assq 'name (car ps)))))
7099           (while (and ps (cdr ps)
7100                       (string= (or action "1")
7101                                (or (cdr (assq 'action (cadr ps))) "2")))
7102             (setq files (cons (cdr (assq 'name (cadr ps))) files))
7103             (setcdr ps (cddr ps)))
7104           (if (not files)
7105               ()
7106             (if (not (string-match "%s" action))
7107                 (setq files (cons " " files)))
7108             (setq files (cons " " files))
7109             (and (assq 'execute (car ps))
7110                  (setcdr (assq 'execute (car ps))
7111                          (funcall (if (string-match "%s" action)
7112                                       'format 'concat)
7113                                   action
7114                                   (mapconcat (lambda (f) f) files " ")))))
7115           (setq ps (cdr ps)))))
7116     (if (and gnus-view-pseudos (not not-view))
7117         (while pslist
7118           (and (assq 'execute (car pslist))
7119                (gnus-execute-command (cdr (assq 'execute (car pslist)))
7120                                      (eq gnus-view-pseudos 'not-confirm)))
7121           (setq pslist (cdr pslist)))
7122       (save-excursion
7123         (while pslist
7124           (setq after-article (or (cdr (assq 'article (car pslist)))
7125                                   (gnus-summary-article-number)))
7126           (gnus-summary-goto-subject after-article)
7127           (forward-line 1)
7128           (setq b (point))
7129           (insert "    " (file-name-nondirectory
7130                                 (cdr (assq 'name (car pslist))))
7131                   ": " (or (cdr (assq 'execute (car pslist))) "") "\n")
7132           (setq e (point))
7133           (forward-line -1)             ; back to `b'
7134           (gnus-add-text-properties
7135            b (1- e) (list 'gnus-number gnus-reffed-article-number
7136                           gnus-mouse-face-prop gnus-mouse-face))
7137           (gnus-data-enter
7138            after-article gnus-reffed-article-number
7139            gnus-unread-mark b (car pslist) 0 (- e b))
7140           (push gnus-reffed-article-number gnus-newsgroup-unreads)
7141           (setq gnus-reffed-article-number (1- gnus-reffed-article-number))
7142           (setq pslist (cdr pslist)))))))
7143
7144 (defun gnus-pseudos< (p1 p2)
7145   (let ((c1 (cdr (assq 'action p1)))
7146         (c2 (cdr (assq 'action p2))))
7147     (and c1 c2 (string< c1 c2))))
7148
7149 (defun gnus-request-pseudo-article (props)
7150   (cond ((assq 'execute props)
7151          (gnus-execute-command (cdr (assq 'execute props)))))
7152   (let ((gnus-current-article (gnus-summary-article-number)))
7153     (run-hooks 'gnus-mark-article-hook)))
7154
7155 (defun gnus-execute-command (command &optional automatic)
7156   (save-excursion
7157     (gnus-article-setup-buffer)
7158     (set-buffer gnus-article-buffer)
7159     (setq buffer-read-only nil)
7160     (let ((command (if automatic command (read-string "Command: " command)))
7161           ;; Just binding this here doesn't help, because there might
7162           ;; be output from the process after exiting the scope of 
7163           ;; this `let'.
7164           ;; (buffer-read-only nil)
7165           )
7166       (erase-buffer)
7167       (insert "$ " command "\n\n")
7168       (if gnus-view-pseudo-asynchronously
7169           (start-process "gnus-execute" nil shell-file-name
7170                          shell-command-switch command)
7171         (call-process shell-file-name nil t nil
7172                       shell-command-switch command)))))
7173
7174 ;; Summary kill commands.
7175
7176 (defun gnus-summary-edit-global-kill (article)
7177   "Edit the \"global\" kill file."
7178   (interactive (list (gnus-summary-article-number)))
7179   (gnus-set-global-variables)
7180   (gnus-group-edit-global-kill article))
7181
7182 (defun gnus-summary-edit-local-kill ()
7183   "Edit a local kill file applied to the current newsgroup."
7184   (interactive)
7185   (gnus-set-global-variables)
7186   (setq gnus-current-headers (gnus-summary-article-header))
7187   (gnus-set-global-variables)
7188   (gnus-group-edit-local-kill
7189    (gnus-summary-article-number) gnus-newsgroup-name))
7190
7191 ;;; Header reading.
7192
7193 (defun gnus-read-header (id &optional header)
7194   "Read the headers of article ID and enter them into the Gnus system."
7195   (let ((group gnus-newsgroup-name)
7196         (gnus-override-method 
7197          (and (gnus-news-group-p gnus-newsgroup-name)
7198               gnus-refer-article-method))       
7199         where)
7200     ;; First we check to see whether the header in question is already
7201     ;; fetched.
7202     (if (stringp id)
7203         ;; This is a Message-ID.
7204         (setq header (or header (gnus-id-to-header id)))
7205       ;; This is an article number.
7206       (setq header (or header (gnus-summary-article-header id))))
7207     (if (and header
7208              (not (memq (mail-header-number header) gnus-newsgroup-sparse)))
7209         ;; We have found the header.
7210         header
7211       ;; We have to really fetch the header to this article.
7212       (when (setq where (gnus-request-head id group))
7213         (save-excursion
7214           (set-buffer nntp-server-buffer)
7215           (goto-char (point-max))
7216           (insert ".\n")
7217           (goto-char (point-min))
7218           (insert "211 ")
7219           (princ (cond
7220                   ((numberp id) id)
7221                   ((cdr where) (cdr where))
7222                   (header (mail-header-number header))
7223                   (t gnus-reffed-article-number))
7224                  (current-buffer))
7225           (insert " Article retrieved.\n"))
7226         ;(when (and header
7227         ;          (memq (mail-header-number header) gnus-newsgroup-sparse))
7228         ;  (setcar (gnus-id-to-thread id) nil))
7229         (if (not (setq header (car (gnus-get-newsgroup-headers))))
7230             ()                          ; Malformed head.
7231           (unless (memq (mail-header-number header) gnus-newsgroup-sparse)
7232             (if (and (stringp id)
7233                      (not (string= (gnus-group-real-name group)
7234                                    (car where))))
7235                 ;; If we fetched by Message-ID and the article came
7236                 ;; from a different group, we fudge some bogus article
7237                 ;; numbers for this article.
7238                 (mail-header-set-number header gnus-reffed-article-number))
7239             (decf gnus-reffed-article-number)
7240             (gnus-remove-header (mail-header-number header))
7241             (push header gnus-newsgroup-headers)
7242             (setq gnus-current-headers header)
7243             (push (mail-header-number header) gnus-newsgroup-limit))
7244           header)))))
7245
7246 (defun gnus-remove-header (number)
7247   "Remove header NUMBER from `gnus-newsgroup-headers'."
7248   (if (and gnus-newsgroup-headers
7249            (= number (mail-header-number (car gnus-newsgroup-headers))))
7250       (pop gnus-newsgroup-headers)
7251     (let ((headers gnus-newsgroup-headers))
7252       (while (and (cdr headers)
7253                   (not (= number (mail-header-number (cadr headers)))))
7254         (pop headers))
7255       (when (cdr headers)
7256         (setcdr headers (cddr headers))))))
7257
7258 (provide 'gnus-sum)
7259
7260 ;;; gnus-sum.el ends here