gnus-sum.el (gnus-summary-move-article): Indent.
[gnus] / lisp / gnus-sum.el
1 ;;; gnus-sum.el --- summary mode commands for Gnus
2
3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 ;;   2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
5
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
7 ;; Keywords: news
8
9 ;; This file is part of GNU Emacs.
10
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
15
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
19 ;; GNU General Public License for more details.
20
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
23
24 ;;; Commentary:
25
26 ;;; Code:
27
28 ;; For Emacs <22.2 and XEmacs.
29 (eval-and-compile
30   (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
31 (eval-when-compile
32   (require 'cl))
33 (eval-when-compile
34   (when (featurep 'xemacs)
35     (require 'easy-mmode))) ; for `define-minor-mode'
36
37 (defvar tool-bar-mode)
38 (defvar gnus-tmp-header)
39
40 (require 'gnus)
41 (require 'gnus-group)
42 (require 'gnus-spec)
43 (require 'gnus-range)
44 (require 'gnus-int)
45 (require 'gnus-undo)
46 (require 'gnus-util)
47 (require 'gmm-utils)
48 (require 'mm-decode)
49 (require 'nnoo)
50
51 (autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t)
52 (autoload 'gnus-cache-write-active "gnus-cache")
53 (autoload 'gnus-mailing-list-insinuate "gnus-ml" nil t)
54 (autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" nil t)
55 (autoload 'gnus-pick-line-number "gnus-salt" nil t)
56 (autoload 'mm-uu-dissect "mm-uu")
57 (autoload 'gnus-article-outlook-deuglify-article "deuglify"
58   "Deuglify broken Outlook (Express) articles and redisplay."
59   t)
60 (autoload 'gnus-article-outlook-unwrap-lines "deuglify" nil t)
61 (autoload 'gnus-article-outlook-repair-attribution "deuglify" nil t)
62 (autoload 'gnus-article-outlook-rearrange-citation "deuglify" nil t)
63
64 (defcustom gnus-kill-summary-on-exit t
65   "*If non-nil, kill the summary buffer when you exit from it.
66 If nil, the summary will become a \"*Dead Summary*\" buffer, and
67 it will be killed sometime later."
68   :group 'gnus-summary-exit
69   :type 'boolean)
70
71 (defcustom gnus-summary-next-group-on-exit t
72   "If non-nil, go to the next unread newsgroup on summary exit.
73 See `gnus-group-goto-unread'."
74   :link '(custom-manual "(gnus)Group Maneuvering")
75   :group 'gnus-summary-exit
76   :version "23.1" ;; No Gnus
77   :type 'boolean)
78
79 (defcustom gnus-summary-stop-at-end-of-message nil
80   "If non-nil, don't select the next message when using `SPC'."
81   :link '(custom-manual "(gnus)Group Maneuvering")
82   :group 'gnus-summary-maneuvering
83   :version "24.1"
84   :type 'boolean)
85
86 (defcustom gnus-fetch-old-headers nil
87   "*Non-nil means that Gnus will try to build threads by grabbing old headers.
88 If an unread article in the group refers to an older, already
89 read (or just marked as read) article, the old article will not
90 normally be displayed in the Summary buffer.  If this variable is
91 t, Gnus will attempt to grab the headers to the old articles, and
92 thereby build complete threads.  If it has the value `some', all
93 old headers will be fetched but only enough headers to connect
94 otherwise loose threads will be displayed.  This variable can
95 also be a number.  In that case, no more than that number of old
96 headers will be fetched.  If it has the value `invisible', all
97 old headers will be fetched, but none will be displayed.
98
99 The server has to support NOV for any of this to work.
100
101 This feature can seriously impact performance it ignores all
102 locally cached header entries.  Setting it to t for groups for a
103 server that doesn't expire articles (such as news.gmane.org),
104 leads to very slow summary generation."
105   :group 'gnus-thread
106   :type '(choice (const :tag "off" nil)
107                  (const :tag "on" t)
108                  (const some)
109                  (const invisible)
110                  number
111                  (sexp :menu-tag "other" t)))
112
113 (defcustom gnus-refer-thread-limit 500
114   "*The number of old headers to fetch when doing \\<gnus-summary-mode-map>\\[gnus-summary-refer-thread].
115 If t, fetch all the available old headers."
116   :group 'gnus-thread
117   :type '(choice number
118                  (sexp :menu-tag "other" t)))
119
120 (defcustom gnus-summary-make-false-root 'adopt
121   "*nil means that Gnus won't gather loose threads.
122 If the root of a thread has expired or been read in a previous
123 session, the information necessary to build a complete thread has been
124 lost.  Instead of having many small sub-threads from this original thread
125 scattered all over the summary buffer, Gnus can gather them.
126
127 If non-nil, Gnus will try to gather all loose sub-threads from an
128 original thread into one large thread.
129
130 If this variable is non-nil, it should be one of `none', `adopt',
131 `dummy' or `empty'.
132
133 If this variable is `none', Gnus will not make a false root, but just
134 present the sub-threads after another.
135 If this variable is `dummy', Gnus will create a dummy root that will
136 have all the sub-threads as children.
137 If this variable is `adopt', Gnus will make one of the \"children\"
138 the parent and mark all the step-children as such.
139 If this variable is `empty', the \"children\" are printed with empty
140 subject fields.  (Or rather, they will be printed with a string
141 given by the `gnus-summary-same-subject' variable.)"
142   :group 'gnus-thread
143   :type '(choice (const :tag "off" nil)
144                  (const none)
145                  (const dummy)
146                  (const adopt)
147                  (const empty)))
148
149 (defcustom gnus-summary-make-false-root-always nil
150   "Always make a false dummy root."
151   :version "22.1"
152   :group 'gnus-thread
153   :type 'boolean)
154
155 (defcustom gnus-summary-gather-exclude-subject "^ *$\\|^(none)$"
156   "*A regexp to match subjects to be excluded from loose thread gathering.
157 As loose thread gathering is done on subjects only, that means that
158 there can be many false gatherings performed.  By rooting out certain
159 common subjects, gathering might become saner."
160   :group 'gnus-thread
161   :type 'regexp)
162
163 (defcustom gnus-summary-gather-subject-limit nil
164   "*Maximum length of subject comparisons when gathering loose threads.
165 Use nil to compare full subjects.  Setting this variable to a low
166 number will help gather threads that have been corrupted by
167 newsreaders chopping off subject lines, but it might also mean that
168 unrelated articles that have subject that happen to begin with the
169 same few characters will be incorrectly gathered.
170
171 If this variable is `fuzzy', Gnus will use a fuzzy algorithm when
172 comparing subjects."
173   :group 'gnus-thread
174   :type '(choice (const :tag "off" nil)
175                  (const fuzzy)
176                  (sexp :menu-tag "on" t)))
177
178 (defcustom gnus-simplify-subject-functions nil
179   "List of functions taking a string argument that simplify subjects.
180 The functions are applied recursively.
181
182 Useful functions to put in this list include:
183 `gnus-simplify-subject-re', `gnus-simplify-subject-fuzzy',
184 `gnus-simplify-whitespace', and `gnus-simplify-all-whitespace'."
185   :group 'gnus-thread
186   :type '(repeat function))
187
188 (defcustom gnus-simplify-ignored-prefixes nil
189   "*Remove matches for this regexp from subject lines when simplifying fuzzily."
190   :group 'gnus-thread
191   :type '(choice (const :tag "off" nil)
192                  regexp))
193
194 (defcustom gnus-build-sparse-threads nil
195   "*If non-nil, fill in the gaps in threads.
196 If `some', only fill in the gaps that are needed to tie loose threads
197 together.  If `more', fill in all leaf nodes that Gnus can find.  If
198 non-nil and non-`some', fill in all gaps that Gnus manages to guess."
199   :group 'gnus-thread
200   :type '(choice (const :tag "off" nil)
201                  (const some)
202                  (const more)
203                  (sexp :menu-tag "all" t)))
204
205 (defcustom gnus-summary-thread-gathering-function
206   'gnus-gather-threads-by-subject
207   "*Function used for gathering loose threads.
208 There are two pre-defined functions: `gnus-gather-threads-by-subject',
209 which only takes Subjects into consideration; and
210 `gnus-gather-threads-by-references', which compared the References
211 headers of the articles to find matches."
212   :group 'gnus-thread
213   :type '(radio (function-item gnus-gather-threads-by-subject)
214                 (function-item gnus-gather-threads-by-references)
215                 (function :tag "other")))
216
217 (defcustom gnus-summary-same-subject ""
218   "*String indicating that the current article has the same subject as the previous.
219 This variable will only be used if the value of
220 `gnus-summary-make-false-root' is `empty'."
221   :group 'gnus-summary-format
222   :type 'string)
223
224 (defcustom gnus-summary-goto-unread nil
225   "*If t, many commands will go to the next unread article.
226 This applies to marking commands as well as other commands that
227 \"naturally\" select the next article, like, for instance, `SPC' at
228 the end of an article.
229
230 If nil, the marking commands do NOT go to the next unread article
231 \(they go to the next article instead).  If `never', commands that
232 usually go to the next unread article, will go to the next article,
233 whether it is read or not."
234   :version "24.1"
235   :group 'gnus-summary-marks
236   :link '(custom-manual "(gnus)Setting Marks")
237   :type '(choice (const :tag "off" nil)
238                  (const never)
239                  (sexp :menu-tag "on" t)))
240
241 (defcustom gnus-summary-default-score 0
242   "*Default article score level.
243 All scores generated by the score files will be added to this score.
244 If this variable is nil, scoring will be disabled."
245   :group 'gnus-score-default
246   :type '(choice (const :tag "disable")
247                  integer))
248
249 (defcustom gnus-summary-default-high-score 0
250   "*Default threshold for a high scored article.
251 An article will be highlighted as high scored if its score is greater
252 than this score."
253   :version "22.1"
254   :group 'gnus-score-default
255   :type 'integer)
256
257 (defcustom gnus-summary-default-low-score 0
258   "*Default threshold for a low scored article.
259 An article will be highlighted as low scored if its score is smaller
260 than this score."
261   :version "22.1"
262   :group 'gnus-score-default
263   :type 'integer)
264
265 (defcustom gnus-summary-zcore-fuzz 0
266   "*Fuzziness factor for the zcore in the summary buffer.
267 Articles with scores closer than this to `gnus-summary-default-score'
268 will not be marked."
269   :group 'gnus-summary-format
270   :type 'integer)
271
272 (defcustom gnus-simplify-subject-fuzzy-regexp nil
273   "*Strings to be removed when doing fuzzy matches.
274 This can either be a regular expression or list of regular expressions
275 that will be removed from subject strings if fuzzy subject
276 simplification is selected."
277   :group 'gnus-thread
278   :type '(repeat regexp))
279
280 (defcustom gnus-show-threads t
281   "*If non-nil, display threads in summary mode."
282   :group 'gnus-thread
283   :type 'boolean)
284
285 (defcustom gnus-thread-hide-subtree nil
286   "*If non-nil, hide all threads initially.
287 This can be a predicate specifier which says which threads to hide.
288 If threads are hidden, you have to run the command
289 `gnus-summary-show-thread' by hand or select an article."
290   :group 'gnus-thread
291   :type '(radio (sexp :format "Non-nil\n"
292                       :match (lambda (widget value)
293                                (not (or (consp value) (functionp value))))
294                       :value t)
295                 (const nil)
296                 (sexp :tag "Predicate specifier")))
297
298 (defcustom gnus-thread-hide-killed t
299   "*If non-nil, hide killed threads automatically."
300   :group 'gnus-thread
301   :type 'boolean)
302
303 (defcustom gnus-thread-ignore-subject t
304   "*If non-nil, which is the default, ignore subjects and do all threading based on the Reference header.
305 If nil, articles that have different subjects from their parents will
306 start separate threads."
307   :group 'gnus-thread
308   :type 'boolean)
309
310 (defcustom gnus-thread-operation-ignore-subject t
311   "*If non-nil, subjects will be ignored when doing thread commands.
312 This affects commands like `gnus-summary-kill-thread' and
313 `gnus-summary-lower-thread'.
314
315 If this variable is nil, articles in the same thread with different
316 subjects will not be included in the operation in question.  If this
317 variable is `fuzzy', only articles that have subjects that are fuzzily
318 equal will be included."
319   :group 'gnus-thread
320   :type '(choice (const :tag "off" nil)
321                  (const fuzzy)
322                  (sexp :tag "on" t)))
323
324 (defcustom gnus-thread-indent-level 4
325   "*Number that says how much each sub-thread should be indented."
326   :group 'gnus-thread
327   :type 'integer)
328
329 (defcustom gnus-auto-extend-newsgroup t
330   "*If non-nil, extend newsgroup forward and backward when requested."
331   :group 'gnus-summary-choose
332   :type 'boolean)
333
334 (defcustom gnus-auto-select-first t
335   "If non-nil, select an article on group entry.
336 An article is selected automatically when entering a group
337 e.g. with \\<gnus-group-mode-map>\\[gnus-group-read-group], or via `gnus-summary-next-page' or
338 `gnus-summary-catchup-and-goto-next-group'.
339
340 Which article is selected is controlled by the variable
341 `gnus-auto-select-subject'.
342
343 If you want to prevent automatic selection of articles in some
344 newsgroups, set the variable to nil in `gnus-select-group-hook'."
345   ;; Commands include...
346   ;; \\<gnus-group-mode-map>\\[gnus-group-read-group]
347   ;; \\<gnus-summary-mode-map>\\[gnus-summary-next-page]
348   ;; \\<gnus-summary-mode-map>\\[gnus-summary-catchup-and-goto-next-group]
349   :group 'gnus-group-select
350   :type '(choice (const :tag "none" nil)
351                  (sexp :menu-tag "first" t)))
352
353 (defcustom gnus-auto-select-subject 'unseen-or-unread
354   "*Says what subject to place under point when entering a group.
355
356 This variable can either be the symbols `first' (place point on the
357 first subject), `unread' (place point on the subject line of the first
358 unread article), `best' (place point on the subject line of the
359 higest-scored article), `unseen' (place point on the subject line of
360 the first unseen article), `unseen-or-unread' (place point on the subject
361 line of the first unseen article or, if all article have been seen, on the
362 subject line of the first unread article), or a function to be called to
363 place point on some subject line."
364   :version "24.1"
365   :group 'gnus-group-select
366   :type '(choice (const best)
367                  (const unread)
368                  (const first)
369                  (const unseen)
370                  (const unseen-or-unread)))
371
372 (defcustom gnus-auto-select-next t
373   "*If non-nil, offer to go to the next group from the end of the previous.
374 If the value is t and the next newsgroup is empty, Gnus will exit
375 summary mode and go back to group mode.  If the value is neither nil
376 nor t, Gnus will select the following unread newsgroup.  In
377 particular, if the value is the symbol `quietly', the next unread
378 newsgroup will be selected without any confirmation, and if it is
379 `almost-quietly', the next group will be selected without any
380 confirmation if you are located on the last article in the group.
381 Finally, if this variable is `slightly-quietly', the `\\<gnus-summary-mode-map>\\[gnus-summary-catchup-and-goto-next-group]' command
382 will go to the next group without confirmation."
383   :group 'gnus-summary-maneuvering
384   :type '(choice (const :tag "off" nil)
385                  (const quietly)
386                  (const almost-quietly)
387                  (const slightly-quietly)
388                  (sexp :menu-tag "on" t)))
389
390 (defcustom gnus-auto-select-same nil
391   "*If non-nil, select the next article with the same subject.
392 If there are no more articles with the same subject, go to
393 the first unread article."
394   :group 'gnus-summary-maneuvering
395   :type 'boolean)
396
397 (defcustom gnus-auto-select-on-ephemeral-exit 'next-noselect
398   "What article should be selected after exiting an ephemeral group.
399 Valid values include:
400
401 `next'
402   Select the next article.
403 `next-unread'
404   Select the next unread article.
405 `next-noselect'
406   Move the cursor to the next article.  This is the default.
407 `next-unread-noselect'
408   Move the cursor to the next unread article.
409
410 If it has any other value or there is no next (unread) article, the
411 article selected before entering to the ephemeral group will appear."
412   :version "23.1" ;; No Gnus
413   :group 'gnus-summary-maneuvering
414   :type '(choice :format "%{%t%}:\n %[Value Menu%] %v"
415                  (const next) (const next-unread)
416                  (const next-noselect) (const next-unread-noselect)
417                  (sexp :tag "other" :value nil)))
418
419 (defcustom gnus-auto-goto-ignores 'unfetched
420   "*Says how to handle unfetched articles when maneuvering.
421
422 This variable can either be the symbols nil (maneuver to any
423 article), `undownloaded' (maneuvering while unplugged ignores articles
424 that have not been fetched), `always-undownloaded' (maneuvering always
425 ignores articles that have not been fetched), `unfetched' (maneuvering
426 ignores articles whose headers have not been fetched).
427
428 NOTE: The list of unfetched articles will always be nil when plugged
429 and, when unplugged, a subset of the undownloaded article list."
430   :version "22.1"
431   :group 'gnus-summary-maneuvering
432   :type '(choice (const :tag "None" nil)
433                  (const :tag "Undownloaded when unplugged" undownloaded)
434                  (const :tag "Undownloaded" always-undownloaded)
435                  (const :tag "Unfetched" unfetched)))
436
437 (defcustom gnus-summary-check-current nil
438   "*If non-nil, consider the current article when moving.
439 The \"unread\" movement commands will stay on the same line if the
440 current article is unread."
441   :group 'gnus-summary-maneuvering
442   :type 'boolean)
443
444 (defcustom gnus-auto-center-summary 2
445   "*If non-nil, always center the current summary buffer.
446 In particular, if `vertical' do only vertical recentering.  If non-nil
447 and non-`vertical', do both horizontal and vertical recentering."
448   :group 'gnus-summary-maneuvering
449   :type '(choice (const :tag "none" nil)
450                  (const vertical)
451                  (integer :tag "height")
452                  (sexp :menu-tag "both" t)))
453
454 (defcustom gnus-auto-center-group t
455   "If non-nil, always center the group buffer."
456   :group 'gnus-summary-maneuvering
457   :type 'boolean)
458
459 (defcustom gnus-show-all-headers nil
460   "*If non-nil, don't hide any headers."
461   :group 'gnus-article-hiding
462   :group 'gnus-article-headers
463   :type 'boolean)
464
465 (defcustom gnus-summary-ignore-duplicates nil
466   "*If non-nil, ignore articles with identical Message-ID headers."
467   :group 'gnus-summary
468   :type 'boolean)
469
470 (defcustom gnus-single-article-buffer nil
471   "*If non-nil, display all articles in the same buffer.
472 If nil, each group will get its own article buffer."
473   :version "24.1"
474   :group 'gnus-article-various
475   :type 'boolean)
476
477 (defcustom gnus-widen-article-window nil
478   "If non-nil, selecting the article buffer will display only the article buffer."
479   :version "24.1"
480   :group 'gnus-article-various
481   :type 'boolean)
482
483 (defcustom gnus-break-pages t
484   "*If non-nil, do page breaking on articles.
485 The page delimiter is specified by the `gnus-page-delimiter'
486 variable."
487   :group 'gnus-article-various
488   :type 'boolean)
489
490 (defcustom gnus-move-split-methods nil
491   "*Variable used to suggest where articles are to be moved to.
492 It uses the same syntax as the `gnus-split-methods' variable.
493 However, whereas `gnus-split-methods' specifies file names as targets,
494 this variable specifies group names."
495   :group 'gnus-summary-mail
496   :type '(repeat (choice (list :value (fun) function)
497                          (cons :value ("" "") regexp (repeat string))
498                          (sexp :value nil))))
499
500 (defcustom gnus-move-group-prefix-function 'gnus-group-real-prefix
501   "Function used to compute default prefix for article move/copy/etc prompts.
502 The function should take one argument, a group name, and return a
503 string with the suggested prefix."
504   :group 'gnus-summary-mail
505   :type 'function)
506
507 ;; FIXME: Although the custom type is `character' for the following variables,
508 ;; using multibyte characters (Latin-1, UTF-8) doesn't work.  -- rs
509
510 (defcustom gnus-unread-mark ?           ;Whitespace
511   "*Mark used for unread articles."
512   :group 'gnus-summary-marks
513   :type 'character)
514
515 (defcustom gnus-ticked-mark ?!
516   "*Mark used for ticked articles."
517   :group 'gnus-summary-marks
518   :type 'character)
519
520 (defcustom gnus-dormant-mark ??
521   "*Mark used for dormant articles."
522   :group 'gnus-summary-marks
523   :type 'character)
524
525 (defcustom gnus-del-mark ?r
526   "*Mark used for del'd articles."
527   :group 'gnus-summary-marks
528   :type 'character)
529
530 (defcustom gnus-read-mark ?R
531   "*Mark used for read articles."
532   :group 'gnus-summary-marks
533   :type 'character)
534
535 (defcustom gnus-expirable-mark ?E
536   "*Mark used for expirable articles."
537   :group 'gnus-summary-marks
538   :type 'character)
539
540 (defcustom gnus-killed-mark ?K
541   "*Mark used for killed articles."
542   :group 'gnus-summary-marks
543   :type 'character)
544
545 (defcustom gnus-spam-mark ?$
546   "*Mark used for spam articles."
547   :version "22.1"
548   :group 'gnus-summary-marks
549   :type 'character)
550
551 (defcustom gnus-kill-file-mark ?X
552   "*Mark used for articles killed by kill files."
553   :group 'gnus-summary-marks
554   :type 'character)
555
556 (defcustom gnus-low-score-mark ?Y
557   "*Mark used for articles with a low score."
558   :group 'gnus-summary-marks
559   :type 'character)
560
561 (defcustom gnus-catchup-mark ?C
562   "*Mark used for articles that are caught up."
563   :group 'gnus-summary-marks
564   :type 'character)
565
566 (defcustom gnus-replied-mark ?A
567   "*Mark used for articles that have been replied to."
568   :group 'gnus-summary-marks
569   :type 'character)
570
571 (defcustom gnus-forwarded-mark ?F
572   "*Mark used for articles that have been forwarded."
573   :version "22.1"
574   :group 'gnus-summary-marks
575   :type 'character)
576
577 (defcustom gnus-recent-mark ?N
578   "*Mark used for articles that are recent."
579   :version "22.1"
580   :group 'gnus-summary-marks
581   :type 'character)
582
583 (defcustom gnus-cached-mark ?*
584   "*Mark used for articles that are in the cache."
585   :group 'gnus-summary-marks
586   :type 'character)
587
588 (defcustom gnus-saved-mark ?S
589   "*Mark used for articles that have been saved."
590   :group 'gnus-summary-marks
591   :type 'character)
592
593 (defcustom gnus-unseen-mark ?.
594   "*Mark used for articles that haven't been seen."
595   :version "22.1"
596   :group 'gnus-summary-marks
597   :type 'character)
598
599 (defcustom gnus-no-mark ?               ;Whitespace
600   "*Mark used for articles that have no other secondary mark."
601   :version "22.1"
602   :group 'gnus-summary-marks
603   :type 'character)
604
605 (defcustom gnus-ancient-mark ?O
606   "*Mark used for ancient articles."
607   :group 'gnus-summary-marks
608   :type 'character)
609
610 (defcustom gnus-sparse-mark ?Q
611   "*Mark used for sparsely reffed articles."
612   :group 'gnus-summary-marks
613   :type 'character)
614
615 (defcustom gnus-canceled-mark ?G
616   "*Mark used for canceled articles."
617   :group 'gnus-summary-marks
618   :type 'character)
619
620 (defcustom gnus-duplicate-mark ?M
621   "*Mark used for duplicate articles."
622   :group 'gnus-summary-marks
623   :type 'character)
624
625 (defcustom gnus-undownloaded-mark ?-
626   "*Mark used for articles that weren't downloaded."
627   :version "22.1"
628   :group 'gnus-summary-marks
629   :type 'character)
630
631 (defcustom gnus-downloaded-mark ?+
632   "*Mark used for articles that were downloaded."
633   :group 'gnus-summary-marks
634   :type 'character)
635
636 (defcustom gnus-downloadable-mark ?%
637   "*Mark used for articles that are to be downloaded."
638   :group 'gnus-summary-marks
639   :type 'character)
640
641 (defcustom gnus-unsendable-mark ?=
642   "*Mark used for articles that won't be sent."
643   :group 'gnus-summary-marks
644   :type 'character)
645
646 (defcustom gnus-score-over-mark ?+
647   "*Score mark used for articles with high scores."
648   :group 'gnus-summary-marks
649   :type 'character)
650
651 (defcustom gnus-score-below-mark ?-
652   "*Score mark used for articles with low scores."
653   :group 'gnus-summary-marks
654   :type 'character)
655
656 (defcustom gnus-empty-thread-mark ?     ;Whitespace
657   "*There is no thread under the article."
658   :group 'gnus-summary-marks
659   :type 'character)
660
661 (defcustom gnus-not-empty-thread-mark ?=
662   "*There is a thread under the article."
663   :group 'gnus-summary-marks
664   :type 'character)
665
666 (defcustom gnus-view-pseudo-asynchronously nil
667   "*If non-nil, Gnus will view pseudo-articles asynchronously."
668   :group 'gnus-extract-view
669   :type 'boolean)
670
671 (defcustom gnus-auto-expirable-marks
672   (list gnus-killed-mark gnus-del-mark gnus-catchup-mark
673         gnus-low-score-mark gnus-ancient-mark gnus-read-mark
674         gnus-duplicate-mark)
675   "*The list of marks converted into expiration if a group is auto-expirable."
676   :version "24.1"
677   :group 'gnus-summary
678   :type '(repeat character))
679
680 (defcustom gnus-inhibit-user-auto-expire t
681   "*If non-nil, user marking commands will not mark an article as expirable, even if the group has auto-expire turned on."
682   :version "21.1"
683   :group 'gnus-summary
684   :type 'boolean)
685
686 (defcustom gnus-mark-copied-or-moved-articles-as-expirable nil
687   "If non-nil, mark articles copied or moved to auto-expire group as expirable.
688 If nil, the expirable marks will be unchanged except that the marks
689 will be removed when copying or moving articles to a group that has
690 not turned auto-expire on.  If non-nil, articles that have been read
691 will be marked as expirable when being copied or moved to a group in
692 which auto-expire is turned on."
693   :version "23.2"
694   :type 'boolean
695   :group 'gnus-summary-marks)
696
697 (defcustom gnus-view-pseudos nil
698   "*If `automatic', pseudo-articles will be viewed automatically.
699 If `not-confirm', pseudos will be viewed automatically, and the user
700 will not be asked to confirm the command."
701   :group 'gnus-extract-view
702   :type '(choice (const :tag "off" nil)
703                  (const automatic)
704                  (const not-confirm)))
705
706 (defcustom gnus-view-pseudos-separately t
707   "*If non-nil, one pseudo-article will be created for each file to be viewed.
708 If nil, all files that use the same viewing command will be given as a
709 list of parameters to that command."
710   :group 'gnus-extract-view
711   :type 'boolean)
712
713 (defcustom gnus-insert-pseudo-articles t
714   "*If non-nil, insert pseudo-articles when decoding articles."
715   :group 'gnus-extract-view
716   :type 'boolean)
717
718 (defcustom gnus-summary-dummy-line-format
719   "   %(:                             :%) %S\n"
720   "*The format specification for the dummy roots in the summary buffer.
721 It works along the same lines as a normal formatting string,
722 with some simple extensions.
723
724 %S  The subject
725
726 General format specifiers can also be used.
727 See `(gnus)Formatting Variables'."
728   :link '(custom-manual "(gnus)Formatting Variables")
729   :group 'gnus-threading
730   :type 'string)
731
732 (defcustom gnus-summary-mode-line-format "Gnus: %g [%A] %Z"
733   "*The format specification for the summary mode line.
734 It works along the same lines as a normal formatting string,
735 with some simple extensions:
736
737 %G  Group name
738 %p  Unprefixed group name
739 %A  Current article number
740 %z  Current article score
741 %V  Gnus version
742 %U  Number of unread articles in the group
743 %e  Number of unselected articles in the group
744 %Z  A string with unread/unselected article counts
745 %g  Shortish group name
746 %S  Subject of the current article
747 %u  User-defined spec
748 %s  Current score file name
749 %d  Number of dormant articles
750 %r  Number of articles that have been marked as read in this session
751 %E  Number of articles expunged by the score files"
752   :group 'gnus-summary-format
753   :type 'string)
754
755 (defcustom gnus-list-identifiers nil
756   "Regexp that matches list identifiers to be removed from subject.
757 This can also be a list of regexps."
758   :version "21.1"
759   :group 'gnus-summary-format
760   :group 'gnus-article-hiding
761   :type '(choice (const :tag "none" nil)
762                  (regexp :value ".*")
763                  (repeat :value (".*") regexp)))
764
765 (defcustom gnus-summary-mark-below 0
766   "*Mark all articles with a score below this variable as read.
767 This variable is local to each summary buffer and usually set by the
768 score file."
769   :group 'gnus-score-default
770   :type 'integer)
771
772 (defun gnus-widget-reversible-match (widget value)
773   "Ignoring WIDGET, convert VALUE to internal form.
774 VALUE should have the form `FOO' or `(not FOO)', where FOO is an symbol."
775   ;; (debug value)
776   (or (symbolp value)
777       (and (listp value)
778            (eq (length value) 2)
779            (eq (nth 0 value) 'not)
780            (symbolp (nth 1 value)))))
781
782 (defun gnus-widget-reversible-to-internal (widget value)
783   "Ignoring WIDGET, convert VALUE to internal form.
784 VALUE should have the form `FOO' or `(not FOO)', where FOO is an atom.
785 FOO is converted to (FOO nil) and (not FOO) is converted to (FOO t)."
786   ;; (debug value)
787   (if (atom value)
788       (list value nil)
789     (list (nth 1 value) t)))
790
791 (defun gnus-widget-reversible-to-external (widget value)
792   "Ignoring WIDGET, convert VALUE to external form.
793 VALUE should have the form `(FOO nil)' or `(FOO t)', where FOO is an atom.
794 \(FOO  nil) is converted to FOO and (FOO t) is converted to (not FOO)."
795   ;; (debug value)
796   (if (nth 1 value)
797       (list 'not (nth 0 value))
798     (nth 0 value)))
799
800 (define-widget 'gnus-widget-reversible 'group
801   "A `group' that convert values."
802   :match 'gnus-widget-reversible-match
803   :value-to-internal 'gnus-widget-reversible-to-internal
804   :value-to-external 'gnus-widget-reversible-to-external)
805
806 (defcustom gnus-article-sort-functions '(gnus-article-sort-by-number)
807   "*List of functions used for sorting articles in the summary buffer.
808
809 Each function takes two articles and returns non-nil if the first
810 article should be sorted before the other.  If you use more than one
811 function, the primary sort function should be the last.  You should
812 probably always include `gnus-article-sort-by-number' in the list of
813 sorting functions -- preferably first.  Also note that sorting by date
814 is often much slower than sorting by number, and the sorting order is
815 very similar.  (Sorting by date means sorting by the time the message
816 was sent, sorting by number means sorting by arrival time.)
817
818 Each item can also be a list `(not F)' where F is a function;
819 this reverses the sort order.
820
821 Ready-made functions include `gnus-article-sort-by-number',
822 `gnus-article-sort-by-author', `gnus-article-sort-by-subject',
823 `gnus-article-sort-by-date', `gnus-article-sort-by-random'
824 and `gnus-article-sort-by-score'.
825
826 When threading is turned on, the variable `gnus-thread-sort-functions'
827 controls how articles are sorted."
828   :group 'gnus-summary-sort
829   :type '(repeat (gnus-widget-reversible
830                   (choice (function-item gnus-article-sort-by-number)
831                           (function-item gnus-article-sort-by-author)
832                           (function-item gnus-article-sort-by-subject)
833                           (function-item gnus-article-sort-by-date)
834                           (function-item gnus-article-sort-by-score)
835                           (function-item gnus-article-sort-by-random)
836                           (function :tag "other"))
837                   (boolean :tag "Reverse order"))))
838
839
840 (defcustom gnus-thread-sort-functions '(gnus-thread-sort-by-number)
841   "*List of functions used for sorting threads in the summary buffer.
842 By default, threads are sorted by article number.
843
844 Each function takes two threads and returns non-nil if the first
845 thread should be sorted before the other.  If you use more than one
846 function, the primary sort function should be the last.  You should
847 probably always include `gnus-thread-sort-by-number' in the list of
848 sorting functions -- preferably first.  Also note that sorting by date
849 is often much slower than sorting by number, and the sorting order is
850 very similar.  (Sorting by date means sorting by the time the message
851 was sent, sorting by number means sorting by arrival time.)
852
853 Each list item can also be a list `(not F)' where F is a
854 function; this specifies reversed sort order.
855
856 Ready-made functions include `gnus-thread-sort-by-number',
857 `gnus-thread-sort-by-author', `gnus-thread-sort-by-recipient'
858 `gnus-thread-sort-by-subject', `gnus-thread-sort-by-date',
859 `gnus-thread-sort-by-score', `gnus-thread-sort-by-most-recent-number',
860 `gnus-thread-sort-by-most-recent-date', `gnus-thread-sort-by-random',
861 and `gnus-thread-sort-by-total-score' (see
862 `gnus-thread-score-function').
863
864 When threading is turned off, the variable
865 `gnus-article-sort-functions' controls how articles are sorted."
866   :group 'gnus-summary-sort
867   :type '(repeat
868           (gnus-widget-reversible
869            (choice (function-item gnus-thread-sort-by-number)
870                    (function-item gnus-thread-sort-by-author)
871                    (function-item gnus-thread-sort-by-recipient)
872                    (function-item gnus-thread-sort-by-subject)
873                    (function-item gnus-thread-sort-by-date)
874                    (function-item gnus-thread-sort-by-score)
875                    (function-item gnus-thread-sort-by-most-recent-number)
876                    (function-item gnus-thread-sort-by-most-recent-date)
877                    (function-item gnus-thread-sort-by-random)
878                    (function-item gnus-thread-sort-by-total-score)
879                    (function :tag "other"))
880            (boolean :tag "Reverse order"))))
881
882 (defcustom gnus-thread-score-function '+
883   "*Function used for calculating the total score of a thread.
884
885 The function is called with the scores of the article and each
886 subthread and should then return the score of the thread.
887
888 Some functions you can use are `+', `max', or `min'."
889   :group 'gnus-summary-sort
890   :type 'function)
891
892 (defcustom gnus-summary-expunge-below nil
893   "All articles that have a score less than this variable will be expunged.
894 This variable is local to the summary buffers."
895   :group 'gnus-score-default
896   :type '(choice (const :tag "off" nil)
897                  integer))
898
899 (defcustom gnus-thread-expunge-below nil
900   "All threads that have a total score less than this variable will be expunged.
901 See `gnus-thread-score-function' for en explanation of what a
902 \"thread score\" is.
903
904 This variable is local to the summary buffers."
905   :group 'gnus-threading
906   :group 'gnus-score-default
907   :type '(choice (const :tag "off" nil)
908                  integer))
909
910 (defcustom gnus-summary-mode-hook nil
911   "*A hook for Gnus summary mode.
912 This hook is run before any variables are set in the summary buffer."
913   :options '(turn-on-gnus-mailing-list-mode gnus-pick-mode)
914   :group 'gnus-summary-various
915   :type 'hook)
916
917 ;; Extracted from gnus-xmas-redefine in order to preserve user settings
918 (when (featurep 'xemacs)
919   (add-hook 'gnus-summary-mode-hook 'gnus-xmas-summary-menu-add)
920   (add-hook 'gnus-summary-mode-hook 'gnus-xmas-setup-summary-toolbar)
921   (add-hook 'gnus-summary-mode-hook
922             'gnus-xmas-switch-horizontal-scrollbar-off))
923
924 (defcustom gnus-summary-menu-hook nil
925   "*Hook run after the creation of the summary mode menu."
926   :group 'gnus-summary-visual
927   :type 'hook)
928
929 (defcustom gnus-summary-exit-hook nil
930   "*A hook called on exit from the summary buffer.
931 It will be called with point in the group buffer."
932   :group 'gnus-summary-exit
933   :type 'hook)
934
935 (defcustom gnus-summary-prepare-hook nil
936   "*A hook called after the summary buffer has been generated.
937 If you want to modify the summary buffer, you can use this hook."
938   :group 'gnus-summary-various
939   :type 'hook)
940
941 (defcustom gnus-summary-prepared-hook nil
942   "*A hook called as the last thing after the summary buffer has been generated."
943   :group 'gnus-summary-various
944   :type 'hook)
945
946 (defcustom gnus-summary-generate-hook nil
947   "*A hook run just before generating the summary buffer.
948 This hook is commonly used to customize threading variables and the
949 like."
950   :group 'gnus-summary-various
951   :type 'hook)
952
953 (defcustom gnus-select-group-hook nil
954   "*A hook called when a newsgroup is selected.
955
956 If you'd like to simplify subjects like the
957 `gnus-summary-next-same-subject' command does, you can use the
958 following hook:
959
960  (add-hook gnus-select-group-hook
961            (lambda ()
962              (mapcar (lambda (header)
963                        (mail-header-set-subject
964                         header
965                         (gnus-simplify-subject
966                          (mail-header-subject header) 're-only)))
967                      gnus-newsgroup-headers)))"
968   :group 'gnus-group-select
969   :type 'hook)
970
971 (defcustom gnus-select-article-hook nil
972   "*A hook called when an article is selected."
973   :group 'gnus-summary-choose
974   :options '(gnus-agent-fetch-selected-article)
975   :type 'hook)
976
977 (defcustom gnus-visual-mark-article-hook
978   (list 'gnus-highlight-selected-summary)
979   "*Hook run after selecting an article in the summary buffer.
980 It is meant to be used for highlighting the article in some way.  It
981 is not run if `gnus-visual' is nil."
982   :group 'gnus-summary-visual
983   :type 'hook)
984
985 (defcustom gnus-parse-headers-hook nil
986   "*A hook called before parsing the headers."
987   :group 'gnus-various
988   :type 'hook)
989
990 (defcustom gnus-exit-group-hook nil
991   "*A hook called when exiting summary mode.
992 This hook is not called from the non-updating exit commands like `Q'."
993   :group 'gnus-various
994   :type 'hook)
995
996 (defcustom gnus-summary-update-hook nil
997   "*A hook called when a summary line is changed.
998 The hook will not be called if `gnus-visual' is nil.
999
1000 The default function `gnus-summary-highlight-line' will
1001 highlight the line according to the `gnus-summary-highlight'
1002 variable."
1003   :group 'gnus-summary-visual
1004   :type 'hook)
1005
1006 (defcustom gnus-mark-article-hook '(gnus-summary-mark-read-and-unread-as-read)
1007   "*A hook called when an article is selected for the first time.
1008 The hook is intended to mark an article as read (or unread)
1009 automatically when it is selected."
1010   :group 'gnus-summary-choose
1011   :type 'hook)
1012
1013 (defcustom gnus-group-no-more-groups-hook nil
1014   "*A hook run when returning to group mode having no more (unread) groups."
1015   :group 'gnus-group-select
1016   :type 'hook)
1017
1018 (defcustom gnus-ps-print-hook nil
1019   "*A hook run before ps-printing something from Gnus."
1020   :group 'gnus-summary
1021   :type 'hook)
1022
1023 (defcustom gnus-summary-article-move-hook nil
1024   "*A hook called after an article is moved, copied, respooled, or crossposted."
1025   :version "22.1"
1026   :group 'gnus-summary
1027   :type 'hook)
1028
1029 (defcustom gnus-summary-article-delete-hook nil
1030   "*A hook called after an article is deleted."
1031   :version "22.1"
1032   :group 'gnus-summary
1033   :type 'hook)
1034
1035 (defcustom gnus-summary-article-expire-hook nil
1036   "*A hook called after an article is expired."
1037   :version "22.1"
1038   :group 'gnus-summary
1039   :type 'hook)
1040
1041 (defcustom gnus-summary-display-arrow
1042   (and (fboundp 'display-graphic-p)
1043        (display-graphic-p))
1044   "*If non-nil, display an arrow highlighting the current article."
1045   :version "22.1"
1046   :group 'gnus-summary
1047   :type 'boolean)
1048
1049 (defcustom gnus-summary-selected-face 'gnus-summary-selected
1050   "Face used for highlighting the current article in the summary buffer."
1051   :group 'gnus-summary-visual
1052   :type 'face)
1053
1054 (defvar gnus-tmp-downloaded nil)
1055
1056 (defcustom gnus-summary-highlight
1057   '(((eq mark gnus-canceled-mark)
1058      . gnus-summary-cancelled)
1059     ((and uncached (> score default-high))
1060      . gnus-summary-high-undownloaded)
1061     ((and uncached (< score default-low))
1062      . gnus-summary-low-undownloaded)
1063     (uncached
1064      . gnus-summary-normal-undownloaded)
1065     ((and (> score default-high)
1066           (or (eq mark gnus-dormant-mark)
1067               (eq mark gnus-ticked-mark)))
1068      . gnus-summary-high-ticked)
1069     ((and (< score default-low)
1070           (or (eq mark gnus-dormant-mark)
1071               (eq mark gnus-ticked-mark)))
1072      . gnus-summary-low-ticked)
1073     ((or (eq mark gnus-dormant-mark)
1074          (eq mark gnus-ticked-mark))
1075      . gnus-summary-normal-ticked)
1076     ((and (> score default-high) (eq mark gnus-ancient-mark))
1077      . gnus-summary-high-ancient)
1078     ((and (< score default-low) (eq mark gnus-ancient-mark))
1079      . gnus-summary-low-ancient)
1080     ((eq mark gnus-ancient-mark)
1081      . gnus-summary-normal-ancient)
1082     ((and (> score default-high) (eq mark gnus-unread-mark))
1083      . gnus-summary-high-unread)
1084     ((and (< score default-low) (eq mark gnus-unread-mark))
1085      . gnus-summary-low-unread)
1086     ((eq mark gnus-unread-mark)
1087      . gnus-summary-normal-unread)
1088     ((> score default-high)
1089      . gnus-summary-high-read)
1090     ((< score default-low)
1091      . gnus-summary-low-read)
1092     (t
1093      . gnus-summary-normal-read))
1094   "*Controls the highlighting of summary buffer lines.
1095
1096 A list of (FORM . FACE) pairs.  When deciding how a particular
1097 summary line should be displayed, each form is evaluated.  The content
1098 of the face field after the first true form is used.  You can change
1099 how those summary lines are displayed, by editing the face field.
1100
1101 You can use the following variables in the FORM field.
1102
1103 score:        The article's score.
1104 default:      The default article score.
1105 default-high: The default score for high scored articles.
1106 default-low:  The default score for low scored articles.
1107 below:        The score below which articles are automatically marked as read.
1108 mark:         The article's mark.
1109 uncached:     Non-nil if the article is uncached."
1110   :group 'gnus-summary-visual
1111   :type '(repeat (cons (sexp :tag "Form" nil)
1112                        face)))
1113 (put 'gnus-summary-highlight 'risky-local-variable t)
1114
1115 (defcustom gnus-alter-header-function nil
1116   "Function called to allow alteration of article header structures.
1117 The function is called with one parameter, the article header vector,
1118 which it may alter in any way."
1119   :type '(choice (const :tag "None" nil)
1120                  function)
1121   :group 'gnus-summary)
1122
1123 (defvar gnus-decode-encoded-word-function 'mail-decode-encoded-word-string
1124   "Function used to decode a string with encoded words.")
1125
1126 (defvar gnus-decode-encoded-address-function
1127   'mail-decode-encoded-address-string
1128   "Function used to decode addresses with encoded words.")
1129
1130 (defcustom gnus-extra-headers '(To Newsgroups)
1131   "*Extra headers to parse."
1132   :version "21.1"
1133   :group 'gnus-summary
1134   :type '(repeat symbol))
1135
1136 (defcustom gnus-ignored-from-addresses
1137   (and user-mail-address
1138        (not (string= user-mail-address ""))
1139        (regexp-quote user-mail-address))
1140   "*From headers that may be suppressed in favor of To headers.
1141 This can be a regexp or a list of regexps."
1142   :version "21.1"
1143   :group 'gnus-summary
1144   :type '(choice regexp
1145                  (repeat :tag "Regexp List" regexp)))
1146
1147 (defsubst gnus-ignored-from-addresses ()
1148   (gmm-regexp-concat gnus-ignored-from-addresses))
1149
1150 (defcustom gnus-summary-to-prefix "-> "
1151   "*String prefixed to the To field in the summary line when
1152 using `gnus-ignored-from-addresses'."
1153   :version "22.1"
1154   :group 'gnus-summary
1155   :type 'string)
1156
1157 (defcustom gnus-summary-newsgroup-prefix "=> "
1158   "*String prefixed to the Newsgroup field in the summary
1159 line when using `gnus-ignored-from-addresses'."
1160   :version "22.1"
1161   :group 'gnus-summary
1162   :type 'string)
1163
1164 (defcustom gnus-newsgroup-ignored-charsets '(unknown-8bit x-unknown)
1165   "List of charsets that should be ignored.
1166 When these charsets are used in the \"charset\" parameter, the
1167 default charset will be used instead."
1168   :version "21.1"
1169   :type '(repeat symbol)
1170   :group 'gnus-charset)
1171
1172 (defcustom gnus-newsgroup-maximum-articles nil
1173   "The maximum number of articles a newsgroup.
1174 If this is a number, old articles in a newsgroup exceeding this number
1175 are silently ignored.  If it is nil, no article is ignored.  Note that
1176 setting this variable to a number might prevent you from reading very
1177 old articles."
1178   :group 'gnus-group-select
1179   :version "22.2"
1180   :type '(choice (const :tag "No limit" nil)
1181                  integer))
1182
1183 (gnus-define-group-parameter
1184  ignored-charsets
1185  :type list
1186  :function-document
1187  "Return the ignored charsets of GROUP."
1188  :variable gnus-group-ignored-charsets-alist
1189  :variable-default
1190  '(("alt\\.chinese\\.text" iso-8859-1))
1191  :variable-document
1192  "Alist of regexps (to match group names) and charsets that should be ignored.
1193 When these charsets are used in the \"charset\" parameter, the
1194 default charset will be used instead."
1195  :variable-group gnus-charset
1196  :variable-type '(repeat (cons (regexp :tag "Group")
1197                                (repeat symbol)))
1198  :parameter-type '(choice :tag "Ignored charsets"
1199                           :value nil
1200                           (repeat (symbol)))
1201  :parameter-document       "\
1202 List of charsets that should be ignored.
1203
1204 When these charsets are used in the \"charset\" parameter, the
1205 default charset will be used instead.")
1206
1207 (defcustom gnus-group-highlight-words-alist nil
1208   "Alist of group regexps and highlight regexps.
1209 This variable uses the same syntax as `gnus-emphasis-alist'."
1210   :version "21.1"
1211   :type '(repeat (cons (regexp :tag "Group")
1212                        (repeat (list (regexp :tag "Highlight regexp")
1213                                      (number :tag "Group for entire word" 0)
1214                                      (number :tag "Group for displayed part" 0)
1215                                      (symbol :tag "Face"
1216                                              gnus-emphasis-highlight-words)))))
1217   :group 'gnus-summary-visual)
1218
1219 (defcustom gnus-summary-show-article-charset-alist
1220   nil
1221   "Alist of number and charset.
1222 The article will be shown with the charset corresponding to the
1223 numbered argument.
1224 For example: ((1 . cn-gb-2312) (2 . big5))."
1225   :version "21.1"
1226   :type '(repeat (cons (number :tag "Argument" 1)
1227                        (symbol :tag "Charset")))
1228   :group 'gnus-charset)
1229
1230 (defcustom gnus-preserve-marks t
1231   "Whether marks are preserved when moving, copying and respooling messages."
1232   :version "21.1"
1233   :type 'boolean
1234   :group 'gnus-summary-marks)
1235
1236 (defcustom gnus-propagate-marks t
1237   "If non-nil, do not propagate marks to the backends."
1238   :version "23.1" ;; No Gnus
1239   :type 'boolean
1240   :group 'gnus-summary-marks)
1241
1242 (defcustom gnus-alter-articles-to-read-function nil
1243   "Function to be called to alter the list of articles to be selected."
1244   :type '(choice (const nil) function)
1245   :group 'gnus-summary)
1246
1247 (defcustom gnus-orphan-score nil
1248   "*All orphans get this score added.  Set in the score file."
1249   :group 'gnus-score-default
1250   :type '(choice (const nil)
1251                  integer))
1252
1253 (defcustom gnus-summary-save-parts-default-mime "image/.*"
1254   "*A regexp to match MIME parts when saving multiple parts of a
1255 message with `gnus-summary-save-parts' (\\<gnus-summary-mode-map>\\[gnus-summary-save-parts]).
1256 This regexp will be used by default when prompting the user for which
1257 type of files to save."
1258   :group 'gnus-summary
1259   :type 'regexp)
1260
1261 (defcustom gnus-read-all-available-headers nil
1262   "Whether Gnus should parse all headers made available to it.
1263 This is mostly relevant for slow back ends where the user may
1264 wish to widen the summary buffer to include all headers
1265 that were fetched."
1266   :version "22.1"
1267   :group 'gnus-summary
1268   :type '(choice boolean regexp))
1269
1270 (defcustom gnus-summary-pipe-output-default-command nil
1271   "Command (and optional arguments) used to pipe article to subprocess.
1272 This will be used as the default command if it is non-nil.  The value
1273 will be updated if you modify it when executing the command
1274 `gnus-summary-pipe-output' or the function `gnus-summary-save-in-pipe'."
1275   :version "23.1" ;; No Gnus
1276   :group 'gnus-summary
1277   :type '(radio (const :tag "None" nil) (string :tag "Command")))
1278
1279 (defcustom gnus-summary-muttprint-program "muttprint"
1280   "Command (and optional arguments) used to run Muttprint.
1281 The value will be updated if you modify it when executing the command
1282 `gnus-summary-muttprint'."
1283   :version "22.1"
1284   :group 'gnus-summary
1285   :type 'string)
1286
1287 (defcustom gnus-article-loose-mime t
1288   "If non-nil, don't require MIME-Version header.
1289 Some brain-damaged MUA/MTA, e.g. Lotus Domino 5.0.6 clients, does not
1290 supply the MIME-Version header or deliberately strip it from the mail.
1291 If non-nil (the default), Gnus will treat some articles as MIME
1292 even if the MIME-Version header is missing."
1293   :version "22.1"
1294   :type 'boolean
1295   :group 'gnus-article-mime)
1296
1297 (defcustom gnus-article-emulate-mime t
1298   "If non-nil, use MIME emulation for uuencode and the like.
1299 This means that Gnus will search message bodies for text that look
1300 like uuencoded bits, yEncoded bits, and so on, and present that using
1301 the normal Gnus MIME machinery."
1302   :version "22.1"
1303   :type 'boolean
1304   :group 'gnus-article-mime)
1305
1306 ;;; Internal variables
1307
1308 (defvar gnus-summary-display-cache nil)
1309 (defvar gnus-article-mime-handles nil)
1310 (defvar gnus-article-decoded-p nil)
1311 (defvar gnus-article-charset nil)
1312 (defvar gnus-article-ignored-charsets nil)
1313 (defvar gnus-article-original-subject nil)
1314 (defvar gnus-scores-exclude-files nil)
1315 (defvar gnus-page-broken nil)
1316
1317 (defvar gnus-original-article nil)
1318 (defvar gnus-article-internal-prepare-hook nil)
1319 (defvar gnus-newsgroup-process-stack nil)
1320
1321 (defvar gnus-thread-indent-array nil)
1322 (defvar gnus-thread-indent-array-level gnus-thread-indent-level)
1323 (defvar gnus-sort-gathered-threads-function 'gnus-thread-sort-by-number
1324   "Function called to sort the articles within a thread after it has been gathered together.")
1325
1326 (defvar gnus-summary-save-parts-type-history nil)
1327 (defvar gnus-summary-save-parts-last-directory mm-default-directory)
1328
1329 ;; Avoid highlighting in kill files.
1330 (defvar gnus-summary-inhibit-highlight nil)
1331 (defvar gnus-newsgroup-selected-overlay nil)
1332 (defvar gnus-inhibit-limiting nil)
1333 (defvar gnus-newsgroup-adaptive-score-file nil)
1334 (defvar gnus-current-score-file nil)
1335 (defvar gnus-current-move-group nil)
1336 (defvar gnus-current-copy-group nil)
1337 (defvar gnus-current-crosspost-group nil)
1338 (defvar gnus-newsgroup-display nil)
1339 (defvar gnus-newsgroup-original-name nil)
1340
1341 (defvar gnus-newsgroup-dependencies nil)
1342 (defvar gnus-newsgroup-adaptive nil)
1343 (defvar gnus-summary-display-article-function nil)
1344 (defvar gnus-summary-highlight-line-function nil
1345   "Function called after highlighting a summary line.")
1346
1347 (defvar gnus-summary-line-format-alist
1348   `((?N ,(macroexpand '(mail-header-number gnus-tmp-header)) ?d)
1349     (?S ,(macroexpand '(mail-header-subject gnus-tmp-header)) ?s)
1350     (?s gnus-tmp-subject-or-nil ?s)
1351     (?n gnus-tmp-name ?s)
1352     (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from)))
1353         ?s)
1354     (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from))
1355             gnus-tmp-from) ?s)
1356     (?F gnus-tmp-from ?s)
1357     (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s)
1358     (?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s)
1359     (?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s)
1360     (?o (gnus-date-iso8601 (mail-header-date gnus-tmp-header)) ?s)
1361     (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s)
1362     (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s)
1363     (?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
1364     (?k (gnus-summary-line-message-size gnus-tmp-header) ?s)
1365     (?L gnus-tmp-lines ?s)
1366     (?O gnus-tmp-downloaded ?c)
1367     (?I gnus-tmp-indentation ?s)
1368     (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
1369     (?R gnus-tmp-replied ?c)
1370     (?\[ gnus-tmp-opening-bracket ?c)
1371     (?\] gnus-tmp-closing-bracket ?c)
1372     (?\> (make-string gnus-tmp-level ? ) ?s)
1373     (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s)
1374     (?i gnus-tmp-score ?d)
1375     (?z gnus-tmp-score-char ?c)
1376     (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d)
1377     (?U gnus-tmp-unread ?c)
1378     (?f (gnus-summary-from-or-to-or-newsgroups gnus-tmp-header gnus-tmp-from)
1379         ?s)
1380     (?t (gnus-summary-number-of-articles-in-thread
1381          (and (boundp 'thread) (car thread)) gnus-tmp-level)
1382         ?d)
1383     (?e (gnus-summary-number-of-articles-in-thread
1384          (and (boundp 'thread) (car thread)) gnus-tmp-level t)
1385         ?c)
1386     (?u gnus-tmp-user-defined ?s)
1387     (?P (gnus-pick-line-number) ?d)
1388     (?B gnus-tmp-thread-tree-header-string ?s)
1389     (user-date (gnus-user-date
1390                 ,(macroexpand '(mail-header-date gnus-tmp-header))) ?s))
1391   "An alist of format specifications that can appear in summary lines.
1392 These are paired with what variables they correspond with, along with
1393 the type of the variable (string, integer, character, etc).")
1394
1395 (defvar gnus-summary-dummy-line-format-alist
1396   `((?S gnus-tmp-subject ?s)
1397     (?N gnus-tmp-number ?d)
1398     (?u gnus-tmp-user-defined ?s)))
1399
1400 (defvar gnus-summary-mode-line-format-alist
1401   `((?G gnus-tmp-group-name ?s)
1402     (?g (gnus-short-group-name gnus-tmp-group-name) ?s)
1403     (?p (gnus-group-real-name gnus-tmp-group-name) ?s)
1404     (?A gnus-tmp-article-number ?d)
1405     (?Z gnus-tmp-unread-and-unselected ?s)
1406     (?V gnus-version ?s)
1407     (?U gnus-tmp-unread-and-unticked ?d)
1408     (?S gnus-tmp-subject ?s)
1409     (?e gnus-tmp-unselected ?d)
1410     (?u gnus-tmp-user-defined ?s)
1411     (?d (length gnus-newsgroup-dormant) ?d)
1412     (?t (length gnus-newsgroup-marked) ?d)
1413     (?h (length gnus-newsgroup-spam-marked) ?d)
1414     (?r (length gnus-newsgroup-reads) ?d)
1415     (?z (gnus-summary-article-score gnus-tmp-article-number) ?d)
1416     (?E gnus-newsgroup-expunged-tally ?d)
1417     (?s (gnus-current-score-file-nondirectory) ?s)))
1418
1419 ;; This is here rather than in gnus-art for compilation reasons.
1420 (defvar gnus-article-mode-line-format-alist
1421   (nconc '((?w (gnus-article-wash-status) ?s)
1422            (?m (gnus-article-mime-part-status) ?s))
1423          gnus-summary-mode-line-format-alist))
1424
1425 (defvar gnus-last-search-regexp nil
1426   "Default regexp for article search command.")
1427
1428 (defvar gnus-last-shell-command nil
1429   "Default shell command on article.")
1430
1431 (defvar gnus-newsgroup-agentized nil
1432   "Locally bound in each summary buffer to indicate whether the server has been agentized.")
1433 (defvar gnus-newsgroup-begin nil)
1434 (defvar gnus-newsgroup-end nil)
1435 (defvar gnus-newsgroup-last-rmail nil)
1436 (defvar gnus-newsgroup-last-mail nil)
1437 (defvar gnus-newsgroup-last-folder nil)
1438 (defvar gnus-newsgroup-last-file nil)
1439 (defvar gnus-newsgroup-last-directory nil)
1440 (defvar gnus-newsgroup-auto-expire nil)
1441 (defvar gnus-newsgroup-active nil)
1442 (defvar gnus-newsgroup-highest nil)
1443
1444 (defvar gnus-newsgroup-data nil)
1445 (defvar gnus-newsgroup-data-reverse nil)
1446 (defvar gnus-newsgroup-limit nil)
1447 (defvar gnus-newsgroup-limits nil)
1448 (defvar gnus-summary-use-undownloaded-faces nil)
1449
1450 (defvar gnus-newsgroup-unreads nil
1451   "Sorted list of unread articles in the current newsgroup.")
1452
1453 (defvar gnus-newsgroup-unselected nil
1454   "Sorted list of unselected unread articles in the current newsgroup.")
1455
1456 (defvar gnus-newsgroup-reads nil
1457   "Alist of read articles and article marks in the current newsgroup.")
1458
1459 (defvar gnus-newsgroup-expunged-tally nil)
1460
1461 (defvar gnus-newsgroup-marked nil
1462   "Sorted list of ticked articles in the current newsgroup (a subset of unread art).")
1463
1464 (defvar gnus-newsgroup-spam-marked nil
1465   "List of ranges of articles that have been marked as spam.")
1466
1467 (defvar gnus-newsgroup-killed nil
1468   "List of ranges of articles that have been through the scoring process.")
1469
1470 (defvar gnus-newsgroup-cached nil
1471   "Sorted list of articles that come from the article cache.")
1472
1473 (defvar gnus-newsgroup-saved nil
1474   "List of articles that have been saved.")
1475
1476 (defvar gnus-newsgroup-kill-headers nil)
1477
1478 (defvar gnus-newsgroup-replied nil
1479   "List of articles that have been replied to in the current newsgroup.")
1480
1481 (defvar gnus-newsgroup-forwarded nil
1482   "List of articles that have been forwarded in the current newsgroup.")
1483
1484 (defvar gnus-newsgroup-recent nil
1485   "List of articles that have are recent in the current newsgroup.")
1486
1487 (defvar gnus-newsgroup-expirable nil
1488   "Sorted list of articles in the current newsgroup that can be expired.")
1489
1490 (defvar gnus-newsgroup-processable nil
1491   "List of articles in the current newsgroup that can be processed.")
1492
1493 (defvar gnus-newsgroup-downloadable nil
1494   "Sorted list of articles in the current newsgroup that can be processed.")
1495
1496 (defvar gnus-newsgroup-unfetched nil
1497   "Sorted list of articles in the current newsgroup whose headers have
1498 not been fetched into the agent.
1499
1500 This list will always be a subset of gnus-newsgroup-undownloaded.")
1501
1502 (defvar gnus-newsgroup-undownloaded nil
1503   "List of articles in the current newsgroup that haven't been downloaded.")
1504
1505 (defvar gnus-newsgroup-unsendable nil
1506   "List of articles in the current newsgroup that won't be sent.")
1507
1508 (defvar gnus-newsgroup-bookmarks nil
1509   "List of articles in the current newsgroup that have bookmarks.")
1510
1511 (defvar gnus-newsgroup-dormant nil
1512   "Sorted list of dormant articles in the current newsgroup.")
1513
1514 (defvar gnus-newsgroup-unseen nil
1515   "List of unseen articles in the current newsgroup.")
1516
1517 (defvar gnus-newsgroup-seen nil
1518   "Range of seen articles in the current newsgroup.")
1519
1520 (defvar gnus-newsgroup-articles nil
1521   "List of articles in the current newsgroup.")
1522
1523 (defvar gnus-newsgroup-scored nil
1524   "List of scored articles in the current newsgroup.")
1525
1526 (defvar gnus-newsgroup-headers nil
1527   "List of article headers in the current newsgroup.")
1528
1529 (defvar gnus-newsgroup-threads nil)
1530
1531 (defvar gnus-newsgroup-prepared nil
1532   "Whether the current group has been prepared properly.")
1533
1534 (defvar gnus-newsgroup-ancient nil
1535   "List of `gnus-fetch-old-headers' articles in the current newsgroup.")
1536
1537 (defvar gnus-newsgroup-sparse nil)
1538
1539 (defvar gnus-current-article nil)
1540 (defvar gnus-article-current nil)
1541 (defvar gnus-current-headers nil)
1542 (defvar gnus-have-all-headers nil)
1543 (defvar gnus-last-article nil)
1544 (defvar gnus-newsgroup-history nil)
1545 (defvar gnus-newsgroup-charset nil)
1546 (defvar gnus-newsgroup-ephemeral-charset nil)
1547 (defvar gnus-newsgroup-ephemeral-ignored-charsets nil)
1548
1549 (defvar gnus-article-before-search nil)
1550
1551 (defvar gnus-summary-local-variables
1552   '(gnus-newsgroup-name
1553
1554     ;; Marks lists
1555     gnus-newsgroup-unreads
1556     gnus-newsgroup-unselected
1557     gnus-newsgroup-marked
1558     gnus-newsgroup-spam-marked
1559     gnus-newsgroup-reads
1560     gnus-newsgroup-saved
1561     gnus-newsgroup-replied
1562     gnus-newsgroup-forwarded
1563     gnus-newsgroup-recent
1564     gnus-newsgroup-expirable
1565     gnus-newsgroup-killed
1566     gnus-newsgroup-unseen
1567     gnus-newsgroup-seen
1568     gnus-newsgroup-cached
1569     gnus-newsgroup-downloadable
1570     gnus-newsgroup-undownloaded
1571     gnus-newsgroup-unsendable
1572
1573     gnus-newsgroup-begin gnus-newsgroup-end
1574     gnus-newsgroup-last-rmail gnus-newsgroup-last-mail
1575     gnus-newsgroup-last-folder gnus-newsgroup-last-file
1576     gnus-newsgroup-last-directory
1577     gnus-newsgroup-auto-expire
1578     gnus-newsgroup-processable
1579     gnus-newsgroup-unfetched
1580     gnus-newsgroup-articles
1581     gnus-newsgroup-bookmarks gnus-newsgroup-dormant
1582     gnus-newsgroup-headers gnus-newsgroup-threads
1583     gnus-newsgroup-prepared gnus-summary-highlight-line-function
1584     gnus-current-article gnus-current-headers gnus-have-all-headers
1585     gnus-last-article gnus-article-internal-prepare-hook
1586     gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay
1587     gnus-newsgroup-scored gnus-newsgroup-kill-headers
1588     gnus-thread-expunge-below
1589     gnus-score-alist gnus-current-score-file
1590     (gnus-summary-expunge-below . global)
1591     (gnus-summary-mark-below . global)
1592     (gnus-orphan-score . global)
1593     gnus-newsgroup-active gnus-scores-exclude-files
1594     gnus-newsgroup-highest
1595     gnus-newsgroup-history gnus-newsgroup-ancient
1596     gnus-newsgroup-sparse gnus-newsgroup-process-stack
1597     (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring)
1598     gnus-newsgroup-adaptive-score-file (gnus-reffed-article-number . -1)
1599     (gnus-newsgroup-expunged-tally . 0)
1600     gnus-cache-removable-articles
1601     gnus-newsgroup-data gnus-newsgroup-data-reverse
1602     gnus-newsgroup-limit gnus-newsgroup-limits
1603     gnus-newsgroup-charset gnus-newsgroup-display
1604     gnus-summary-use-undownloaded-faces)
1605   "Variables that are buffer-local to the summary buffers.")
1606
1607 (defvar gnus-newsgroup-variables nil
1608   "A list of variables that have separate values in different newsgroups.
1609 A list of newsgroup (summary buffer) local variables, or cons of
1610 variables and their default expressions to be evalled (when the default
1611 values are not nil), that should be made global while the summary buffer
1612 is active.
1613
1614 Note: The default expressions will be evaluated (using function `eval')
1615 before assignment to the local variable rather than just assigned to it.
1616 If the default expression is the symbol `global', that symbol will not
1617 be evaluated but the global value of the local variable will be used
1618 instead.
1619
1620 These variables can be used to set variables in the group parameters
1621 while still allowing them to affect operations done in other buffers.
1622 For example:
1623
1624 \(setq gnus-newsgroup-variables
1625      '(message-use-followup-to
1626        (gnus-visible-headers .
1627          \"^From:\\\\|^Newsgroups:\\\\|^Subject:\\\\|^Date:\\\\|^To:\")))
1628 ")
1629
1630 (eval-when-compile
1631   ;; Bind features so that require will believe that gnus-sum has
1632   ;; already been loaded (avoids infinite recursion)
1633   (let ((features (cons 'gnus-sum features)))
1634     (require 'gnus-art)))
1635
1636 ;; MIME stuff.
1637
1638 (defvar gnus-decode-encoded-word-methods
1639   '(mail-decode-encoded-word-string)
1640   "List of methods used to decode encoded words.
1641
1642 This variable is a list of FUNCTION or (REGEXP . FUNCTION).  If item
1643 is FUNCTION, FUNCTION will be apply to all newsgroups.  If item is a
1644 \(REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups
1645 whose names match REGEXP.
1646
1647 For example:
1648 \((\"chinese\" . gnus-decode-encoded-word-string-by-guess)
1649  mail-decode-encoded-word-string
1650  (\"chinese\" . rfc1843-decode-string))")
1651
1652 (defvar gnus-decode-encoded-word-methods-cache nil)
1653
1654 (defun gnus-multi-decode-encoded-word-string (string)
1655   "Apply the functions from `gnus-encoded-word-methods' that match."
1656   (unless (and gnus-decode-encoded-word-methods-cache
1657                (eq gnus-newsgroup-name
1658                    (car gnus-decode-encoded-word-methods-cache)))
1659     (setq gnus-decode-encoded-word-methods-cache (list gnus-newsgroup-name))
1660     (dolist (method gnus-decode-encoded-word-methods)
1661       (if (symbolp method)
1662           (nconc gnus-decode-encoded-word-methods-cache (list method))
1663         (if (and gnus-newsgroup-name
1664                  (string-match (car method) gnus-newsgroup-name))
1665             (nconc gnus-decode-encoded-word-methods-cache
1666                    (list (cdr method)))))))
1667   (dolist (method (cdr gnus-decode-encoded-word-methods-cache) string)
1668     (setq string (funcall method string))))
1669
1670 ;; Subject simplification.
1671
1672 (defun gnus-simplify-whitespace (str)
1673   "Remove excessive whitespace from STR."
1674   ;; Multiple spaces.
1675   (while (string-match "[ \t][ \t]+" str)
1676     (setq str (concat (substring str 0 (match-beginning 0))
1677                         " "
1678                         (substring str (match-end 0)))))
1679   ;; Leading spaces.
1680   (when (string-match "^[ \t]+" str)
1681     (setq str (substring str (match-end 0))))
1682   ;; Trailing spaces.
1683   (when (string-match "[ \t]+$" str)
1684     (setq str (substring str 0 (match-beginning 0))))
1685   str)
1686
1687 (defun gnus-simplify-all-whitespace (str)
1688   "Remove all whitespace from STR."
1689   (while (string-match "[ \t\n]+" str)
1690     (setq str (replace-match "" nil nil str)))
1691   str)
1692
1693 (defsubst gnus-simplify-subject-re (subject)
1694   "Remove \"Re:\" from subject lines."
1695   (if (string-match message-subject-re-regexp subject)
1696       (substring subject (match-end 0))
1697     subject))
1698
1699 (defun gnus-simplify-subject (subject &optional re-only)
1700   "Remove `Re:' and words in parentheses.
1701 If RE-ONLY is non-nil, strip leading `Re:'s only."
1702   (let ((case-fold-search t))           ;Ignore case.
1703     ;; Remove `Re:', `Re^N:', `Re(n)', and `Re[n]:'.
1704     (when (string-match "\\`\\(re\\([[(^][0-9]+[])]?\\)?:[ \t]*\\)+" subject)
1705       (setq subject (substring subject (match-end 0))))
1706     ;; Remove uninteresting prefixes.
1707     (when (and (not re-only)
1708                gnus-simplify-ignored-prefixes
1709                (string-match gnus-simplify-ignored-prefixes subject))
1710       (setq subject (substring subject (match-end 0))))
1711     ;; Remove words in parentheses from end.
1712     (unless re-only
1713       (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject)
1714         (setq subject (substring subject 0 (match-beginning 0)))))
1715     ;; Return subject string.
1716     subject))
1717
1718 ;; Remove any leading "re:"s, any trailing paren phrases, and simplify
1719 ;; all whitespace.
1720 (defsubst gnus-simplify-buffer-fuzzy-step (regexp &optional newtext)
1721   (goto-char (point-min))
1722   (while (re-search-forward regexp nil t)
1723     (replace-match (or newtext ""))))
1724
1725 (defun gnus-simplify-buffer-fuzzy ()
1726   "Simplify string in the buffer fuzzily.
1727 The string in the accessible portion of the current buffer is simplified.
1728 It is assumed to be a single-line subject.
1729 Whitespace is generally cleaned up, and miscellaneous leading/trailing
1730 matter is removed.  Additional things can be deleted by setting
1731 `gnus-simplify-subject-fuzzy-regexp'."
1732   (let ((case-fold-search t)
1733         (modified-tick))
1734     (gnus-simplify-buffer-fuzzy-step "\t" " ")
1735
1736     (while (not (eq modified-tick (buffer-modified-tick)))
1737       (setq modified-tick (buffer-modified-tick))
1738       (cond
1739        ((listp gnus-simplify-subject-fuzzy-regexp)
1740         (mapc 'gnus-simplify-buffer-fuzzy-step
1741               gnus-simplify-subject-fuzzy-regexp))
1742        (gnus-simplify-subject-fuzzy-regexp
1743         (gnus-simplify-buffer-fuzzy-step gnus-simplify-subject-fuzzy-regexp)))
1744       (gnus-simplify-buffer-fuzzy-step "^ *\\[[-+?*!][-+?*!]\\] *")
1745       (gnus-simplify-buffer-fuzzy-step
1746        "^ *\\(re\\|fw\\|fwd\\)[[{(^0-9]*[])}]?[:;] *")
1747       (gnus-simplify-buffer-fuzzy-step "^[[].*:\\( .*\\)[]]$" "\\1"))
1748
1749     (gnus-simplify-buffer-fuzzy-step " *[[{(][^()\n]*[]})] *$")
1750     (gnus-simplify-buffer-fuzzy-step "  +" " ")
1751     (gnus-simplify-buffer-fuzzy-step " $")
1752     (gnus-simplify-buffer-fuzzy-step "^ +")))
1753
1754 (defun gnus-simplify-subject-fuzzy (subject)
1755   "Simplify a subject string fuzzily.
1756 See `gnus-simplify-buffer-fuzzy' for details."
1757   (save-excursion
1758     (gnus-set-work-buffer)
1759     (let ((case-fold-search t))
1760       ;; Remove uninteresting prefixes.
1761       (when (and gnus-simplify-ignored-prefixes
1762                  (string-match gnus-simplify-ignored-prefixes subject))
1763         (setq subject (substring subject (match-end 0))))
1764       (insert subject)
1765       (inline (gnus-simplify-buffer-fuzzy))
1766       (buffer-string))))
1767
1768 (defsubst gnus-simplify-subject-fully (subject)
1769   "Simplify a subject string according to `gnus-summary-gather-subject-limit'."
1770   (cond
1771    (gnus-simplify-subject-functions
1772     (gnus-map-function gnus-simplify-subject-functions subject))
1773    ((null gnus-summary-gather-subject-limit)
1774     (gnus-simplify-subject-re subject))
1775    ((eq gnus-summary-gather-subject-limit 'fuzzy)
1776     (gnus-simplify-subject-fuzzy subject))
1777    ((numberp gnus-summary-gather-subject-limit)
1778     (truncate-string-to-width (gnus-simplify-subject-re subject)
1779                               gnus-summary-gather-subject-limit))
1780    (t
1781     subject)))
1782
1783 (defsubst gnus-subject-equal (s1 s2 &optional simple-first)
1784   "Check whether two subjects are equal.
1785 If optional argument SIMPLE-FIRST is t, first argument is already
1786 simplified."
1787   (cond
1788    ((null simple-first)
1789     (equal (gnus-simplify-subject-fully s1)
1790            (gnus-simplify-subject-fully s2)))
1791    (t
1792     (equal s1
1793            (gnus-simplify-subject-fully s2)))))
1794
1795 (defun gnus-summary-bubble-group ()
1796   "Increase the score of the current group.
1797 This is a handy function to add to `gnus-summary-exit-hook' to
1798 increase the score of each group you read."
1799   (gnus-group-add-score gnus-newsgroup-name))
1800
1801 \f
1802 ;;;
1803 ;;; Gnus summary mode
1804 ;;;
1805
1806 (put 'gnus-summary-mode 'mode-class 'special)
1807
1808 (defvar gnus-article-commands-menu)
1809
1810 ;; Non-orthogonal keys
1811
1812 (gnus-define-keys gnus-summary-mode-map
1813   " " gnus-summary-next-page
1814   "\177" gnus-summary-prev-page
1815   [delete] gnus-summary-prev-page
1816   [backspace] gnus-summary-prev-page
1817   "\r" gnus-summary-scroll-up
1818   "\M-\r" gnus-summary-scroll-down
1819   "n" gnus-summary-next-unread-article
1820   "p" gnus-summary-prev-unread-article
1821   "N" gnus-summary-next-article
1822   "P" gnus-summary-prev-article
1823   "\M-\C-n" gnus-summary-next-same-subject
1824   "\M-\C-p" gnus-summary-prev-same-subject
1825   "\M-n" gnus-summary-next-unread-subject
1826   "\M-p" gnus-summary-prev-unread-subject
1827   "." gnus-summary-first-unread-article
1828   "," gnus-summary-best-unread-article
1829   "\M-s" gnus-summary-search-article-forward
1830   "\M-r" gnus-summary-search-article-backward
1831   "\M-S" gnus-summary-repeat-search-article-forward
1832   "\M-R" gnus-summary-repeat-search-article-backward
1833   "<" gnus-summary-beginning-of-article
1834   ">" gnus-summary-end-of-article
1835   "j" gnus-summary-goto-article
1836   "^" gnus-summary-refer-parent-article
1837   "\M-^" gnus-summary-refer-article
1838   "u" gnus-summary-tick-article-forward
1839   "!" gnus-summary-tick-article-forward
1840   "U" gnus-summary-tick-article-backward
1841   "d" gnus-summary-mark-as-read-forward
1842   "D" gnus-summary-mark-as-read-backward
1843   "E" gnus-summary-mark-as-expirable
1844   "\M-u" gnus-summary-clear-mark-forward
1845   "\M-U" gnus-summary-clear-mark-backward
1846   "k" gnus-summary-kill-same-subject-and-select
1847   "\C-k" gnus-summary-kill-same-subject
1848   "\M-\C-k" gnus-summary-kill-thread
1849   "\M-\C-l" gnus-summary-lower-thread
1850   "e" gnus-summary-edit-article
1851   "#" gnus-summary-mark-as-processable
1852   "\M-#" gnus-summary-unmark-as-processable
1853   "\M-\C-t" gnus-summary-toggle-threads
1854   "\M-\C-s" gnus-summary-show-thread
1855   "\M-\C-h" gnus-summary-hide-thread
1856   "\M-\C-f" gnus-summary-next-thread
1857   "\M-\C-b" gnus-summary-prev-thread
1858   [(meta down)] gnus-summary-next-thread
1859   [(meta up)] gnus-summary-prev-thread
1860   "\M-\C-u" gnus-summary-up-thread
1861   "\M-\C-d" gnus-summary-down-thread
1862   "&" gnus-summary-execute-command
1863   "c" gnus-summary-catchup-and-exit
1864   "\C-w" gnus-summary-mark-region-as-read
1865   "\C-t" gnus-summary-toggle-truncation
1866   "?" gnus-summary-mark-as-dormant
1867   "\C-c\M-\C-s" gnus-summary-limit-include-expunged
1868   "\C-c\C-s\C-n" gnus-summary-sort-by-number
1869   "\C-c\C-s\C-m\C-n" gnus-summary-sort-by-most-recent-number
1870   "\C-c\C-s\C-l" gnus-summary-sort-by-lines
1871   "\C-c\C-s\C-c" gnus-summary-sort-by-chars
1872   "\C-c\C-s\C-a" gnus-summary-sort-by-author
1873   "\C-c\C-s\C-t" gnus-summary-sort-by-recipient
1874   "\C-c\C-s\C-s" gnus-summary-sort-by-subject
1875   "\C-c\C-s\C-d" gnus-summary-sort-by-date
1876   "\C-c\C-s\C-m\C-d" gnus-summary-sort-by-most-recent-date
1877   "\C-c\C-s\C-i" gnus-summary-sort-by-score
1878   "\C-c\C-s\C-o" gnus-summary-sort-by-original
1879   "\C-c\C-s\C-r" gnus-summary-sort-by-random
1880   "=" gnus-summary-expand-window
1881   "\C-x\C-s" gnus-summary-reselect-current-group
1882   "\M-g" gnus-summary-rescan-group
1883   "\C-c\C-r" gnus-summary-caesar-message
1884   "f" gnus-summary-followup
1885   "F" gnus-summary-followup-with-original
1886   "C" gnus-summary-cancel-article
1887   "r" gnus-summary-reply
1888   "R" gnus-summary-reply-with-original
1889   "\C-c\C-f" gnus-summary-mail-forward
1890   "o" gnus-summary-save-article
1891   "\C-o" gnus-summary-save-article-mail
1892   "|" gnus-summary-pipe-output
1893   "\M-k" gnus-summary-edit-local-kill
1894   "\M-K" gnus-summary-edit-global-kill
1895   ;; "V" gnus-version
1896   "\C-c\C-d" gnus-summary-describe-group
1897   "q" gnus-summary-exit
1898   "Q" gnus-summary-exit-no-update
1899   "\C-c\C-i" gnus-info-find-node
1900   gnus-mouse-2 gnus-mouse-pick-article
1901   [follow-link] mouse-face
1902   "m" gnus-summary-mail-other-window
1903   "a" gnus-summary-post-news
1904   "x" gnus-summary-limit-to-unread
1905   "s" gnus-summary-isearch-article
1906   "t" gnus-summary-toggle-header
1907   "g" gnus-summary-show-article
1908   "l" gnus-summary-goto-last-article
1909   "\C-c\C-v\C-v" gnus-uu-decode-uu-view
1910   "\C-d" gnus-summary-enter-digest-group
1911   "\M-\C-d" gnus-summary-read-document
1912   "\M-\C-e" gnus-summary-edit-parameters
1913   "\M-\C-a" gnus-summary-customize-parameters
1914   "\C-c\C-b" gnus-bug
1915   "*" gnus-cache-enter-article
1916   "\M-*" gnus-cache-remove-article
1917   "\M-&" gnus-summary-universal-argument
1918   "\C-l" gnus-recenter
1919   "I" gnus-summary-increase-score
1920   "L" gnus-summary-lower-score
1921   "\M-i" gnus-symbolic-argument
1922   "h" gnus-summary-select-article-buffer
1923
1924   "b" gnus-article-view-part
1925   "\M-t" gnus-summary-toggle-display-buttonized
1926
1927   "V" gnus-summary-score-map
1928   "X" gnus-uu-extract-map
1929   "S" gnus-summary-send-map)
1930
1931 ;; Sort of orthogonal keymap
1932 (gnus-define-keys (gnus-summary-mark-map "M" gnus-summary-mode-map)
1933   "t" gnus-summary-tick-article-forward
1934   "!" gnus-summary-tick-article-forward
1935   "d" gnus-summary-mark-as-read-forward
1936   "r" gnus-summary-mark-as-read-forward
1937   "c" gnus-summary-clear-mark-forward
1938   " " gnus-summary-clear-mark-forward
1939   "e" gnus-summary-mark-as-expirable
1940   "x" gnus-summary-mark-as-expirable
1941   "?" gnus-summary-mark-as-dormant
1942   "b" gnus-summary-set-bookmark
1943   "B" gnus-summary-remove-bookmark
1944   "#" gnus-summary-mark-as-processable
1945   "\M-#" gnus-summary-unmark-as-processable
1946   "S" gnus-summary-limit-include-expunged
1947   "C" gnus-summary-catchup
1948   "H" gnus-summary-catchup-to-here
1949   "h" gnus-summary-catchup-from-here
1950   "\C-c" gnus-summary-catchup-all
1951   "k" gnus-summary-kill-same-subject-and-select
1952   "K" gnus-summary-kill-same-subject
1953   "P" gnus-uu-mark-map)
1954
1955 (gnus-define-keys (gnus-summary-mscore-map "V" gnus-summary-mark-map)
1956   "c" gnus-summary-clear-above
1957   "u" gnus-summary-tick-above
1958   "m" gnus-summary-mark-above
1959   "k" gnus-summary-kill-below)
1960
1961 (gnus-define-keys (gnus-summary-limit-map "/" gnus-summary-mode-map)
1962   "/" gnus-summary-limit-to-subject
1963   "n" gnus-summary-limit-to-articles
1964   "b" gnus-summary-limit-to-bodies
1965   "h" gnus-summary-limit-to-headers
1966   "w" gnus-summary-pop-limit
1967   "s" gnus-summary-limit-to-subject
1968   "a" gnus-summary-limit-to-author
1969   "u" gnus-summary-limit-to-unread
1970   "m" gnus-summary-limit-to-marks
1971   "M" gnus-summary-limit-exclude-marks
1972   "v" gnus-summary-limit-to-score
1973   "*" gnus-summary-limit-include-cached
1974   "D" gnus-summary-limit-include-dormant
1975   "T" gnus-summary-limit-include-thread
1976   "d" gnus-summary-limit-exclude-dormant
1977   "t" gnus-summary-limit-to-age
1978   "." gnus-summary-limit-to-unseen
1979   "x" gnus-summary-limit-to-extra
1980   "p" gnus-summary-limit-to-display-predicate
1981   "E" gnus-summary-limit-include-expunged
1982   "c" gnus-summary-limit-exclude-childless-dormant
1983   "C" gnus-summary-limit-mark-excluded-as-read
1984   "o" gnus-summary-insert-old-articles
1985   "N" gnus-summary-insert-new-articles
1986   "S" gnus-summary-limit-to-singletons
1987   "r" gnus-summary-limit-to-replied
1988   "R" gnus-summary-limit-to-recipient
1989   "A" gnus-summary-limit-to-address)
1990
1991 (gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map)
1992   "n" gnus-summary-next-unread-article
1993   "p" gnus-summary-prev-unread-article
1994   "N" gnus-summary-next-article
1995   "P" gnus-summary-prev-article
1996   "\C-n" gnus-summary-next-same-subject
1997   "\C-p" gnus-summary-prev-same-subject
1998   "\M-n" gnus-summary-next-unread-subject
1999   "\M-p" gnus-summary-prev-unread-subject
2000   "f" gnus-summary-first-unread-article
2001   "b" gnus-summary-best-unread-article
2002   "j" gnus-summary-goto-article
2003   "g" gnus-summary-goto-subject
2004   "l" gnus-summary-goto-last-article
2005   "o" gnus-summary-pop-article)
2006
2007 (gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map)
2008   "k" gnus-summary-kill-thread
2009   "E" gnus-summary-expire-thread
2010   "l" gnus-summary-lower-thread
2011   "i" gnus-summary-raise-thread
2012   "T" gnus-summary-toggle-threads
2013   "t" gnus-summary-rethread-current
2014   "^" gnus-summary-reparent-thread
2015   "\M-^" gnus-summary-reparent-children
2016   "s" gnus-summary-show-thread
2017   "S" gnus-summary-show-all-threads
2018   "h" gnus-summary-hide-thread
2019   "H" gnus-summary-hide-all-threads
2020   "n" gnus-summary-next-thread
2021   "p" gnus-summary-prev-thread
2022   "u" gnus-summary-up-thread
2023   "o" gnus-summary-top-thread
2024   "d" gnus-summary-down-thread
2025   "#" gnus-uu-mark-thread
2026   "\M-#" gnus-uu-unmark-thread)
2027
2028 (gnus-define-keys (gnus-summary-buffer-map "Y" gnus-summary-mode-map)
2029   "g" gnus-summary-prepare
2030   "c" gnus-summary-insert-cached-articles
2031   "d" gnus-summary-insert-dormant-articles
2032   "t" gnus-summary-insert-ticked-articles)
2033
2034 (gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map)
2035   "c" gnus-summary-catchup-and-exit
2036   "C" gnus-summary-catchup-all-and-exit
2037   "E" gnus-summary-exit-no-update
2038   "Q" gnus-summary-exit
2039   "Z" gnus-summary-exit
2040   "n" gnus-summary-catchup-and-goto-next-group
2041   "p" gnus-summary-catchup-and-goto-prev-group
2042   "R" gnus-summary-reselect-current-group
2043   "G" gnus-summary-rescan-group
2044   "N" gnus-summary-next-group
2045   "s" gnus-summary-save-newsrc
2046   "P" gnus-summary-prev-group)
2047
2048 (gnus-define-keys (gnus-summary-article-map "A" gnus-summary-mode-map)
2049   " " gnus-summary-next-page
2050   "n" gnus-summary-next-page
2051   "\177" gnus-summary-prev-page
2052   [delete] gnus-summary-prev-page
2053   "p" gnus-summary-prev-page
2054   "\r" gnus-summary-scroll-up
2055   "\M-\r" gnus-summary-scroll-down
2056   "<" gnus-summary-beginning-of-article
2057   ">" gnus-summary-end-of-article
2058   "b" gnus-summary-beginning-of-article
2059   "e" gnus-summary-end-of-article
2060   "^" gnus-summary-refer-parent-article
2061   "r" gnus-summary-refer-parent-article
2062   "C" gnus-summary-show-complete-article
2063   "D" gnus-summary-enter-digest-group
2064   "R" gnus-summary-refer-references
2065   "T" gnus-summary-refer-thread
2066   "W" gnus-warp-to-article
2067   "g" gnus-summary-show-article
2068   "s" gnus-summary-isearch-article
2069   "P" gnus-summary-print-article
2070   "S" gnus-sticky-article
2071   "M" gnus-mailing-list-insinuate
2072   "t" gnus-article-babel)
2073
2074 (gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map)
2075   "b" gnus-article-add-buttons
2076   "B" gnus-article-add-buttons-to-head
2077   "o" gnus-article-treat-overstrike
2078   "e" gnus-article-emphasize
2079   "w" gnus-article-fill-cited-article
2080   "Q" gnus-article-fill-long-lines
2081   "L" gnus-article-toggle-truncate-lines
2082   "C" gnus-article-capitalize-sentences
2083   "c" gnus-article-remove-cr
2084   "q" gnus-article-de-quoted-unreadable
2085   "6" gnus-article-de-base64-unreadable
2086   "Z" gnus-article-decode-HZ
2087   "A" gnus-article-treat-ansi-sequences
2088   "h" gnus-article-wash-html
2089   "u" gnus-article-unsplit-urls
2090   "s" gnus-summary-force-verify-and-decrypt
2091   "f" gnus-article-display-x-face
2092   "l" gnus-summary-stop-page-breaking
2093   "r" gnus-summary-caesar-message
2094   "m" gnus-summary-morse-message
2095   "t" gnus-summary-toggle-header
2096   "g" gnus-treat-smiley
2097   "v" gnus-summary-verbose-headers
2098   "a" gnus-article-strip-headers-in-body ;; mnemonic: wash archive
2099   "p" gnus-article-verify-x-pgp-sig
2100   "d" gnus-article-treat-dumbquotes
2101   "U" gnus-article-treat-non-ascii
2102   "i" gnus-summary-idna-message)
2103
2104 (gnus-define-keys (gnus-summary-wash-deuglify-map "Y" gnus-summary-wash-map)
2105   ;; mnemonic: deuglif*Y*
2106   "u" gnus-article-outlook-unwrap-lines
2107   "a" gnus-article-outlook-repair-attribution
2108   "c" gnus-article-outlook-rearrange-citation
2109   "f" gnus-article-outlook-deuglify-article) ;; mnemonic: full deuglify
2110
2111 (gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
2112   "a" gnus-article-hide
2113   "h" gnus-article-hide-headers
2114   "b" gnus-article-hide-boring-headers
2115   "s" gnus-article-hide-signature
2116   "c" gnus-article-hide-citation
2117   "C" gnus-article-hide-citation-in-followups
2118   "l" gnus-article-hide-list-identifiers
2119   "B" gnus-article-strip-banner
2120   "P" gnus-article-hide-pem
2121   "\C-c" gnus-article-hide-citation-maybe)
2122
2123 (gnus-define-keys (gnus-summary-wash-highlight-map "H" gnus-summary-wash-map)
2124   "a" gnus-article-highlight
2125   "h" gnus-article-highlight-headers
2126   "c" gnus-article-highlight-citation
2127   "s" gnus-article-highlight-signature)
2128
2129 (gnus-define-keys (gnus-summary-wash-header-map "G" gnus-summary-wash-map)
2130   "f" gnus-article-treat-fold-headers
2131   "u" gnus-article-treat-unfold-headers
2132   "n" gnus-article-treat-fold-newsgroups)
2133
2134 (gnus-define-keys (gnus-summary-wash-display-map "D" gnus-summary-wash-map)
2135   "x" gnus-article-display-x-face
2136   "d" gnus-article-display-face
2137   "s" gnus-treat-smiley
2138   "D" gnus-article-remove-images
2139   "W" gnus-html-show-images
2140   "f" gnus-treat-from-picon
2141   "m" gnus-treat-mail-picon
2142   "n" gnus-treat-newsgroups-picon
2143   "g" gnus-treat-from-gravatar
2144   "h" gnus-treat-mail-gravatar)
2145
2146 (gnus-define-keys (gnus-summary-wash-mime-map "M" gnus-summary-wash-map)
2147   "w" gnus-article-decode-mime-words
2148   "c" gnus-article-decode-charset
2149   "v" gnus-mime-view-all-parts
2150   "b" gnus-article-view-part)
2151
2152 (gnus-define-keys (gnus-summary-wash-time-map "T" gnus-summary-wash-map)
2153   "z" gnus-article-date-ut
2154   "u" gnus-article-date-ut
2155   "l" gnus-article-date-local
2156   "p" gnus-article-date-english
2157   "e" gnus-article-date-lapsed
2158   "o" gnus-article-date-original
2159   "i" gnus-article-date-iso8601
2160   "s" gnus-article-date-user)
2161
2162 (gnus-define-keys (gnus-summary-wash-empty-map "E" gnus-summary-wash-map)
2163   "t" gnus-article-remove-trailing-blank-lines
2164   "l" gnus-article-strip-leading-blank-lines
2165   "m" gnus-article-strip-multiple-blank-lines
2166   "a" gnus-article-strip-blank-lines
2167   "A" gnus-article-strip-all-blank-lines
2168   "s" gnus-article-strip-leading-space
2169   "e" gnus-article-strip-trailing-space
2170   "w" gnus-article-remove-leading-whitespace)
2171
2172 (gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map)
2173   "v" gnus-version
2174   "d" gnus-summary-describe-group
2175   "h" gnus-summary-describe-briefly
2176   "i" gnus-info-find-node)
2177
2178 (gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map)
2179   "e" gnus-summary-expire-articles
2180   "\M-\C-e" gnus-summary-expire-articles-now
2181   "\177" gnus-summary-delete-article
2182   [delete] gnus-summary-delete-article
2183   [backspace] gnus-summary-delete-article
2184   "m" gnus-summary-move-article
2185   "r" gnus-summary-respool-article
2186   "w" gnus-summary-edit-article
2187   "c" gnus-summary-copy-article
2188   "B" gnus-summary-crosspost-article
2189   "q" gnus-summary-respool-query
2190   "t" gnus-summary-respool-trace
2191   "i" gnus-summary-import-article
2192   "I" gnus-summary-create-article
2193   "p" gnus-summary-article-posted-p)
2194
2195 (gnus-define-keys (gnus-summary-save-map "O" gnus-summary-mode-map)
2196   "o" gnus-summary-save-article
2197   "m" gnus-summary-save-article-mail
2198   "F" gnus-summary-write-article-file
2199   "r" gnus-summary-save-article-rmail
2200   "f" gnus-summary-save-article-file
2201   "b" gnus-summary-save-article-body-file
2202   "B" gnus-summary-write-article-body-file
2203   "h" gnus-summary-save-article-folder
2204   "v" gnus-summary-save-article-vm
2205   "p" gnus-summary-pipe-output
2206   "P" gnus-summary-muttprint)
2207
2208 (gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map)
2209   "b" gnus-summary-display-buttonized
2210   "m" gnus-summary-repair-multipart
2211   "v" gnus-article-view-part
2212   "o" gnus-article-save-part
2213   "O" gnus-article-save-part-and-strip
2214   "r" gnus-article-replace-part
2215   "d" gnus-article-delete-part
2216   "t" gnus-article-view-part-as-type
2217   "j" gnus-article-jump-to-part
2218   "c" gnus-article-copy-part
2219   "C" gnus-article-view-part-as-charset
2220   "e" gnus-article-view-part-externally
2221   "H" gnus-article-browse-html-article
2222   "E" gnus-article-encrypt-body
2223   "i" gnus-article-inline-part
2224   "|" gnus-article-pipe-part)
2225
2226 (gnus-define-keys (gnus-uu-mark-map "P" gnus-summary-mark-map)
2227   "p" gnus-summary-mark-as-processable
2228   "u" gnus-summary-unmark-as-processable
2229   "U" gnus-summary-unmark-all-processable
2230   "v" gnus-uu-mark-over
2231   "s" gnus-uu-mark-series
2232   "r" gnus-uu-mark-region
2233   "g" gnus-uu-unmark-region
2234   "R" gnus-uu-mark-by-regexp
2235   "G" gnus-uu-unmark-by-regexp
2236   "t" gnus-uu-mark-thread
2237   "T" gnus-uu-unmark-thread
2238   "a" gnus-uu-mark-all
2239   "b" gnus-uu-mark-buffer
2240   "S" gnus-uu-mark-sparse
2241   "k" gnus-summary-kill-process-mark
2242   "y" gnus-summary-yank-process-mark
2243   "w" gnus-summary-save-process-mark
2244   "i" gnus-uu-invert-processable)
2245
2246 (gnus-define-keys (gnus-uu-extract-map "X" gnus-summary-mode-map)
2247   ;;"x" gnus-uu-extract-any
2248   "m" gnus-summary-save-parts
2249   "u" gnus-uu-decode-uu
2250   "U" gnus-uu-decode-uu-and-save
2251   "s" gnus-uu-decode-unshar
2252   "S" gnus-uu-decode-unshar-and-save
2253   "o" gnus-uu-decode-save
2254   "O" gnus-uu-decode-save
2255   "b" gnus-uu-decode-binhex
2256   "B" gnus-uu-decode-binhex
2257   "Y" gnus-uu-decode-yenc
2258   "p" gnus-uu-decode-postscript
2259   "P" gnus-uu-decode-postscript-and-save)
2260
2261 (gnus-define-keys
2262     (gnus-uu-extract-view-map "v" gnus-uu-extract-map)
2263   "u" gnus-uu-decode-uu-view
2264   "U" gnus-uu-decode-uu-and-save-view
2265   "s" gnus-uu-decode-unshar-view
2266   "S" gnus-uu-decode-unshar-and-save-view
2267   "o" gnus-uu-decode-save-view
2268   "O" gnus-uu-decode-save-view
2269   "b" gnus-uu-decode-binhex-view
2270   "B" gnus-uu-decode-binhex-view
2271   "p" gnus-uu-decode-postscript-view
2272   "P" gnus-uu-decode-postscript-and-save-view)
2273
2274 (defvar gnus-article-post-menu nil)
2275
2276 (defconst gnus-summary-menu-maxlen 20)
2277
2278 (defun gnus-summary-menu-split (menu)
2279   ;; If we have lots of elements, divide them into groups of 20
2280   ;; and make a pane (or submenu) for each one.
2281   (if (> (length menu) (/ (* gnus-summary-menu-maxlen 3) 2))
2282       (let ((menu menu) sublists next
2283             (i 1))
2284         (while menu
2285           ;; Pull off the next gnus-summary-menu-maxlen elements
2286           ;; and make them the next element of sublist.
2287           (setq next (nthcdr gnus-summary-menu-maxlen menu))
2288           (if next
2289               (setcdr (nthcdr (1- gnus-summary-menu-maxlen) menu)
2290                       nil))
2291           (setq sublists (cons (cons (format "%s ... %s" (aref (car menu) 0)
2292                                              (aref (car (last menu)) 0)) menu)
2293                                sublists))
2294           (setq i (1+ i))
2295           (setq menu next))
2296         (nreverse sublists))
2297     ;; Few elements--put them all in one pane.
2298     menu))
2299
2300 (defun gnus-summary-make-menu-bar ()
2301   (gnus-turn-off-edit-menu 'summary)
2302
2303   (unless (boundp 'gnus-summary-misc-menu)
2304
2305     (easy-menu-define
2306       gnus-summary-kill-menu gnus-summary-mode-map ""
2307       (cons
2308        "Score"
2309        (nconc
2310         (list
2311          ["Customize" gnus-score-customize t])
2312         (gnus-make-score-map 'increase)
2313         (gnus-make-score-map 'lower)
2314         '(("Mark"
2315            ["Kill below" gnus-summary-kill-below t]
2316            ["Mark above" gnus-summary-mark-above t]
2317            ["Tick above" gnus-summary-tick-above t]
2318            ["Clear above" gnus-summary-clear-above t])
2319           ["Current score" gnus-summary-current-score t]
2320           ["Set score" gnus-summary-set-score t]
2321           ["Switch current score file..." gnus-score-change-score-file t]
2322           ["Set mark below..." gnus-score-set-mark-below t]
2323           ["Set expunge below..." gnus-score-set-expunge-below t]
2324           ["Edit current score file" gnus-score-edit-current-scores t]
2325           ["Edit score file..." gnus-score-edit-file t]
2326           ["Trace score" gnus-score-find-trace t]
2327           ["Find words" gnus-score-find-favourite-words t]
2328           ["Rescore buffer" gnus-summary-rescore t]
2329           ["Increase score..." gnus-summary-increase-score t]
2330           ["Lower score..." gnus-summary-lower-score t]))))
2331
2332     ;; Define both the Article menu in the summary buffer and the
2333     ;; equivalent Commands menu in the article buffer here for
2334     ;; consistency.
2335     (let ((innards
2336            `(("Hide"
2337               ["All" gnus-article-hide t]
2338               ["Headers" gnus-article-hide-headers t]
2339               ["Signature" gnus-article-hide-signature t]
2340               ["Citation" gnus-article-hide-citation t]
2341               ["List identifiers" gnus-article-hide-list-identifiers t]
2342               ["Banner" gnus-article-strip-banner t]
2343               ["Boring headers" gnus-article-hide-boring-headers t])
2344              ("Highlight"
2345               ["All" gnus-article-highlight t]
2346               ["Headers" gnus-article-highlight-headers t]
2347               ["Signature" gnus-article-highlight-signature t]
2348               ["Citation" gnus-article-highlight-citation t])
2349              ("MIME"
2350               ["Words" gnus-article-decode-mime-words t]
2351               ["Charset" gnus-article-decode-charset t]
2352               ["QP" gnus-article-de-quoted-unreadable t]
2353               ["Base64" gnus-article-de-base64-unreadable t]
2354               ["View MIME buttons" gnus-summary-display-buttonized t]
2355               ["View all" gnus-mime-view-all-parts t]
2356               ["Verify and Decrypt" gnus-summary-force-verify-and-decrypt t]
2357               ["Encrypt body" gnus-article-encrypt-body
2358                :active (not (gnus-group-read-only-p))
2359                ,@(if (featurep 'xemacs) nil
2360                    '(:help "Encrypt the message body on disk"))]
2361               ["Extract all parts..." gnus-summary-save-parts t]
2362               ("Multipart"
2363                ["Repair multipart" gnus-summary-repair-multipart t]
2364                ["Pipe part..." gnus-article-pipe-part t]
2365                ["Inline part" gnus-article-inline-part t]
2366                ["View part as type..." gnus-article-view-part-as-type t]
2367                ["Encrypt body" gnus-article-encrypt-body
2368                 :active (not (gnus-group-read-only-p))
2369                ,@(if (featurep 'xemacs) nil
2370                    '(:help "Encrypt the message body on disk"))]
2371                ["View part externally" gnus-article-view-part-externally t]
2372                ["View HTML parts in browser" gnus-article-browse-html-article t]
2373                ["View part with charset..." gnus-article-view-part-as-charset t]
2374                ["Copy part" gnus-article-copy-part t]
2375                ["Save part..." gnus-article-save-part t]
2376                ["View part" gnus-article-view-part t]))
2377              ("Date"
2378               ["Local" gnus-article-date-local t]
2379               ["ISO8601" gnus-article-date-iso8601 t]
2380               ["UT" gnus-article-date-ut t]
2381               ["Original" gnus-article-date-original t]
2382               ["Lapsed" gnus-article-date-lapsed t]
2383               ["User-defined" gnus-article-date-user t])
2384              ("Display"
2385               ["Remove images" gnus-article-remove-images t]
2386               ["Toggle smiley" gnus-treat-smiley t]
2387               ["Show X-Face" gnus-article-display-x-face t]
2388               ["Show picons in From" gnus-treat-from-picon t]
2389               ["Show picons in mail headers" gnus-treat-mail-picon t]
2390               ["Show picons in news headers" gnus-treat-newsgroups-picon t]
2391               ["Show Gravatars in From" gnus-treat-from-gravatar t]
2392               ["Show Gravatars in mail headers" gnus-treat-mail-gravatar t]
2393               ("View as different encoding"
2394                ,@(gnus-summary-menu-split
2395                   (mapcar
2396                    (lambda (cs)
2397                      ;; Since easymenu under Emacs doesn't allow
2398                      ;; lambda forms for menu commands, we should
2399                      ;; provide intern'ed function symbols.
2400                      (let ((command (intern (format "\
2401 gnus-summary-show-article-from-menu-as-charset-%s" cs))))
2402                        (fset command
2403                              `(lambda ()
2404                                 (interactive)
2405                                 (let ((gnus-summary-show-article-charset-alist
2406                                        '((1 . ,cs))))
2407                                   (gnus-summary-show-article 1))))
2408                        `[,(symbol-name cs) ,command t]))
2409                    (sort (if (fboundp 'coding-system-list)
2410                              (coding-system-list)
2411                            (mapcar 'car mm-mime-mule-charset-alist))
2412                          'string<)))))
2413              ("Washing"
2414               ("Remove Blanks"
2415                ["Leading" gnus-article-strip-leading-blank-lines t]
2416                ["Multiple" gnus-article-strip-multiple-blank-lines t]
2417                ["Trailing" gnus-article-remove-trailing-blank-lines t]
2418                ["All of the above" gnus-article-strip-blank-lines t]
2419                ["All" gnus-article-strip-all-blank-lines t]
2420                ["Leading space" gnus-article-strip-leading-space t]
2421                ["Trailing space" gnus-article-strip-trailing-space t]
2422                ["Leading space in headers"
2423                 gnus-article-remove-leading-whitespace t])
2424               ["Overstrike" gnus-article-treat-overstrike t]
2425               ["Dumb quotes" gnus-article-treat-dumbquotes t]
2426               ["Non-ASCII" gnus-article-treat-non-ascii t]
2427               ["Emphasis" gnus-article-emphasize t]
2428               ["Word wrap" gnus-article-fill-cited-article t]
2429               ["Fill long lines" gnus-article-fill-long-lines t]
2430               ["Toggle truncate long lines" gnus-article-toggle-truncate-lines t]
2431               ["Capitalize sentences" gnus-article-capitalize-sentences t]
2432               ["Remove CR" gnus-article-remove-cr t]
2433               ["Quoted-Printable" gnus-article-de-quoted-unreadable t]
2434               ["Base64" gnus-article-de-base64-unreadable t]
2435               ["Rot 13" gnus-summary-caesar-message
2436                ,@(if (featurep 'xemacs) '(t)
2437                    '(:help "\"Caesar rotate\" article by 13"))]
2438               ["De-IDNA" gnus-summary-idna-message t]
2439               ["Morse decode" gnus-summary-morse-message t]
2440               ["Unix pipe..." gnus-summary-pipe-message t]
2441               ["Add buttons" gnus-article-add-buttons t]
2442               ["Add buttons to head" gnus-article-add-buttons-to-head t]
2443               ["Stop page breaking" gnus-summary-stop-page-breaking t]
2444               ["Verbose header" gnus-summary-verbose-headers t]
2445               ["Toggle header" gnus-summary-toggle-header t]
2446               ["Unfold headers" gnus-article-treat-unfold-headers t]
2447               ["Fold newsgroups" gnus-article-treat-fold-newsgroups t]
2448               ["Html" gnus-article-wash-html t]
2449               ["Unsplit URLs" gnus-article-unsplit-urls t]
2450               ["Verify X-PGP-Sig" gnus-article-verify-x-pgp-sig t]
2451               ["Decode HZ" gnus-article-decode-HZ t]
2452               ["ANSI sequences" gnus-article-treat-ansi-sequences t]
2453               ("(Outlook) Deuglify"
2454                ["Unwrap lines" gnus-article-outlook-unwrap-lines t]
2455                ["Repair attribution" gnus-article-outlook-repair-attribution t]
2456                ["Rearrange citation" gnus-article-outlook-rearrange-citation t]
2457                ["Full (Outlook) deuglify"
2458                 gnus-article-outlook-deuglify-article t])
2459               )
2460              ("Output"
2461               ["Save in default format..." gnus-summary-save-article
2462                ,@(if (featurep 'xemacs) '(t)
2463                    '(:help "Save article using default method"))]
2464               ["Save in file..." gnus-summary-save-article-file
2465                ,@(if (featurep 'xemacs) '(t)
2466                    '(:help "Save article in file"))]
2467               ["Save in Unix mail format..." gnus-summary-save-article-mail t]
2468               ["Save in MH folder..." gnus-summary-save-article-folder t]
2469               ["Save in VM folder..." gnus-summary-save-article-vm t]
2470               ["Save in RMAIL mbox..." gnus-summary-save-article-rmail t]
2471               ["Save body in file..." gnus-summary-save-article-body-file t]
2472               ["Pipe through a filter..." gnus-summary-pipe-output t]
2473               ["Print with Muttprint..." gnus-summary-muttprint t]
2474               ["Print" gnus-summary-print-article
2475                ,@(if (featurep 'xemacs) '(t)
2476                    '(:help "Generate and print a PostScript image"))])
2477              ("Copy, move,... (Backend)"
2478               ,@(if (featurep 'xemacs) nil
2479                   '(:help "Copying, moving, expiring articles..."))
2480               ["Respool article..." gnus-summary-respool-article t]
2481               ["Move article..." gnus-summary-move-article
2482                (gnus-check-backend-function
2483                 'request-move-article gnus-newsgroup-name)]
2484               ["Copy article..." gnus-summary-copy-article t]
2485               ["Crosspost article..." gnus-summary-crosspost-article
2486                (gnus-check-backend-function
2487                 'request-replace-article gnus-newsgroup-name)]
2488               ["Import file..." gnus-summary-import-article
2489                (gnus-check-backend-function
2490                 'request-accept-article gnus-newsgroup-name)]
2491               ["Create article..." gnus-summary-create-article
2492                (gnus-check-backend-function
2493                 'request-accept-article gnus-newsgroup-name)]
2494               ["Check if posted" gnus-summary-article-posted-p t]
2495               ["Edit article" gnus-summary-edit-article
2496                (not (gnus-group-read-only-p))]
2497               ["Delete article" gnus-summary-delete-article
2498                (gnus-check-backend-function
2499                 'request-expire-articles gnus-newsgroup-name)]
2500               ["Query respool" gnus-summary-respool-query t]
2501               ["Trace respool" gnus-summary-respool-trace t]
2502               ["Delete expirable articles" gnus-summary-expire-articles-now
2503                (gnus-check-backend-function
2504                 'request-expire-articles gnus-newsgroup-name)])
2505              ("Extract"
2506               ["Uudecode" gnus-uu-decode-uu
2507                ,@(if (featurep 'xemacs) '(t)
2508                    '(:help "Decode uuencoded article(s)"))]
2509               ["Uudecode and save" gnus-uu-decode-uu-and-save t]
2510               ["Unshar" gnus-uu-decode-unshar t]
2511               ["Unshar and save" gnus-uu-decode-unshar-and-save t]
2512               ["Save" gnus-uu-decode-save t]
2513               ["Binhex" gnus-uu-decode-binhex t]
2514               ["Postscript" gnus-uu-decode-postscript t]
2515               ["All MIME parts" gnus-summary-save-parts t])
2516              ("Cache"
2517               ["Enter article" gnus-cache-enter-article t]
2518               ["Remove article" gnus-cache-remove-article t])
2519              ["Translate" gnus-article-babel t]
2520              ["Select article buffer" gnus-summary-select-article-buffer t]
2521              ["Make article buffer sticky" gnus-sticky-article t]
2522              ["Enter digest buffer" gnus-summary-enter-digest-group t]
2523              ["Isearch article..." gnus-summary-isearch-article t]
2524              ["Beginning of the article" gnus-summary-beginning-of-article t]
2525              ["End of the article" gnus-summary-end-of-article t]
2526              ["Fetch parent of article" gnus-summary-refer-parent-article t]
2527              ["Fetch referenced articles" gnus-summary-refer-references t]
2528              ["Fetch current thread" gnus-summary-refer-thread t]
2529              ["Fetch article with id..." gnus-summary-refer-article t]
2530              ["Setup Mailing List Params" gnus-mailing-list-insinuate t]
2531              ["Redisplay" gnus-summary-show-article t]
2532              ["Raw article" gnus-summary-show-raw-article :keys "C-u g"])))
2533       (easy-menu-define
2534         gnus-summary-article-menu gnus-summary-mode-map ""
2535         (cons "Article" innards))
2536
2537       (if (not (keymapp gnus-summary-article-menu))
2538           (easy-menu-define
2539             gnus-article-commands-menu gnus-article-mode-map ""
2540             (cons "Commands" innards))
2541         ;; in Emacs, don't share menu.
2542         (setq gnus-article-commands-menu
2543               (copy-keymap gnus-summary-article-menu))
2544         (define-key gnus-article-mode-map [menu-bar commands]
2545           (cons "Commands" gnus-article-commands-menu))))
2546
2547     (easy-menu-define
2548       gnus-summary-thread-menu gnus-summary-mode-map ""
2549       '("Threads"
2550         ["Find all messages in thread" gnus-summary-refer-thread t]
2551         ["Toggle threading" gnus-summary-toggle-threads t]
2552         ["Hide threads" gnus-summary-hide-all-threads t]
2553         ["Show threads" gnus-summary-show-all-threads t]
2554         ["Hide thread" gnus-summary-hide-thread t]
2555         ["Show thread" gnus-summary-show-thread t]
2556         ["Go to next thread" gnus-summary-next-thread t]
2557         ["Go to previous thread" gnus-summary-prev-thread t]
2558         ["Go down thread" gnus-summary-down-thread t]
2559         ["Go up thread" gnus-summary-up-thread t]
2560         ["Top of thread" gnus-summary-top-thread t]
2561         ["Mark thread as read" gnus-summary-kill-thread t]
2562         ["Mark thread as expired" gnus-summary-expire-thread t]
2563         ["Lower thread score" gnus-summary-lower-thread t]
2564         ["Raise thread score" gnus-summary-raise-thread t]
2565         ["Rethread current" gnus-summary-rethread-current t]))
2566
2567     (easy-menu-define
2568       gnus-summary-post-menu gnus-summary-mode-map ""
2569       `("Post"
2570         ["Send a message (mail or news)" gnus-summary-post-news
2571          ,@(if (featurep 'xemacs) '(t)
2572              '(:help "Compose a new message (mail or news)"))]
2573         ["Followup" gnus-summary-followup
2574          ,@(if (featurep 'xemacs) '(t)
2575              '(:help "Post followup to this article"))]
2576         ["Followup and yank" gnus-summary-followup-with-original
2577          ,@(if (featurep 'xemacs) '(t)
2578              '(:help "Post followup to this article, quoting its contents"))]
2579         ["Supersede article" gnus-summary-supersede-article t]
2580         ["Cancel article" gnus-summary-cancel-article
2581          ,@(if (featurep 'xemacs) '(t)
2582              '(:help "Cancel an article you posted"))]
2583         ["Reply" gnus-summary-reply t]
2584         ["Reply and yank" gnus-summary-reply-with-original t]
2585         ["Wide reply" gnus-summary-wide-reply t]
2586         ["Wide reply and yank" gnus-summary-wide-reply-with-original
2587          ,@(if (featurep 'xemacs) '(t)
2588              '(:help "Mail a reply, quoting this article"))]
2589         ["Very wide reply" gnus-summary-very-wide-reply t]
2590         ["Very wide reply and yank" gnus-summary-very-wide-reply-with-original
2591          ,@(if (featurep 'xemacs) '(t)
2592              '(:help "Mail a very wide reply, quoting this article"))]
2593         ["Mail forward" gnus-summary-mail-forward t]
2594         ["Post forward" gnus-summary-post-forward t]
2595         ["Digest and mail" gnus-uu-digest-mail-forward t]
2596         ["Digest and post" gnus-uu-digest-post-forward t]
2597         ["Resend message" gnus-summary-resend-message t]
2598         ["Resend message edit" gnus-summary-resend-message-edit t]
2599         ["Send bounced mail" gnus-summary-resend-bounced-mail t]
2600         ["Send a mail" gnus-summary-mail-other-window t]
2601         ["Create a local message" gnus-summary-news-other-window t]
2602         ["Uuencode and post" gnus-uu-post-news
2603          ,@(if (featurep 'xemacs) '(t)
2604              '(:help "Post a uuencoded article"))]
2605         ["Followup via news" gnus-summary-followup-to-mail t]
2606         ["Followup via news and yank"
2607          gnus-summary-followup-to-mail-with-original t]
2608         ["Strip signature on reply"
2609          (lambda ()
2610            (interactive)
2611            (if (not (memq message-cite-function
2612                           '(message-cite-original-without-signature
2613                             message-cite-original)))
2614                ;; Stupid workaround for XEmacs not honoring :visible.
2615                (message "Can't toggle this value of `message-cite-function'")
2616              (setq message-cite-function
2617                    (if (eq message-cite-function
2618                            'message-cite-original-without-signature)
2619                        'message-cite-original
2620                      'message-cite-original-without-signature))))
2621          ;; XEmacs barfs on :visible.
2622          ,@(if (featurep 'xemacs) nil
2623              '(:visible (memq message-cite-function
2624                               '(message-cite-original-without-signature
2625                                 message-cite-original))))
2626          :style toggle
2627          :selected (eq message-cite-function
2628                        'message-cite-original-without-signature)
2629          ,@(if (featurep 'xemacs) nil
2630              '(:help "Strip signature from cited article when replying."))]
2631         ;;("Draft"
2632         ;;["Send" gnus-summary-send-draft t]
2633         ;;["Send bounced" gnus-resend-bounced-mail t])
2634         ))
2635
2636     (cond
2637      ((not (keymapp gnus-summary-post-menu))
2638       (setq gnus-article-post-menu gnus-summary-post-menu))
2639      ((not gnus-article-post-menu)
2640       ;; Don't share post menu.
2641       (setq gnus-article-post-menu
2642             (copy-keymap gnus-summary-post-menu))))
2643     (define-key gnus-article-mode-map [menu-bar post]
2644       (cons "Post" gnus-article-post-menu))
2645
2646     (easy-menu-define
2647       gnus-summary-misc-menu gnus-summary-mode-map ""
2648       `("Gnus"
2649         ("Mark Read"
2650          ["Mark as read" gnus-summary-mark-as-read-forward t]
2651          ["Mark same subject and select"
2652           gnus-summary-kill-same-subject-and-select t]
2653          ["Mark same subject" gnus-summary-kill-same-subject t]
2654          ["Catchup" gnus-summary-catchup
2655           ,@(if (featurep 'xemacs) '(t)
2656               '(:help "Mark unread articles in this group as read"))]
2657          ["Catchup all" gnus-summary-catchup-all t]
2658          ["Catchup to here" gnus-summary-catchup-to-here t]
2659          ["Catchup from here" gnus-summary-catchup-from-here t]
2660          ["Catchup region" gnus-summary-mark-region-as-read
2661           (gnus-mark-active-p)]
2662          ["Mark excluded" gnus-summary-limit-mark-excluded-as-read t])
2663         ("Mark Various"
2664          ["Tick" gnus-summary-tick-article-forward t]
2665          ["Mark as dormant" gnus-summary-mark-as-dormant t]
2666          ["Remove marks" gnus-summary-clear-mark-forward t]
2667          ["Set expirable mark" gnus-summary-mark-as-expirable t]
2668          ["Set bookmark" gnus-summary-set-bookmark t]
2669          ["Remove bookmark" gnus-summary-remove-bookmark t])
2670         ("Limit to"
2671          ["Marks..." gnus-summary-limit-to-marks t]
2672          ["Subject..." gnus-summary-limit-to-subject t]
2673          ["Author..." gnus-summary-limit-to-author t]
2674          ["Recipient..." gnus-summary-limit-to-recipient t]
2675          ["Address..." gnus-summary-limit-to-address t]
2676          ["Age..." gnus-summary-limit-to-age t]
2677          ["Extra..." gnus-summary-limit-to-extra t]
2678          ["Score..." gnus-summary-limit-to-score t]
2679          ["Display Predicate" gnus-summary-limit-to-display-predicate t]
2680          ["Unread" gnus-summary-limit-to-unread t]
2681          ["Unseen" gnus-summary-limit-to-unseen t]
2682          ["Singletons" gnus-summary-limit-to-singletons t]
2683          ["Replied" gnus-summary-limit-to-replied t]
2684          ["Non-dormant" gnus-summary-limit-exclude-dormant t]
2685          ["Next or process marked articles" gnus-summary-limit-to-articles t]
2686          ["Pop limit" gnus-summary-pop-limit t]
2687          ["Show dormant" gnus-summary-limit-include-dormant t]
2688          ["Hide childless dormant"
2689           gnus-summary-limit-exclude-childless-dormant t]
2690          ;;["Hide thread" gnus-summary-limit-exclude-thread t]
2691          ["Hide marked" gnus-summary-limit-exclude-marks t]
2692          ["Show expunged" gnus-summary-limit-include-expunged t])
2693         ("Process Mark"
2694          ["Set mark" gnus-summary-mark-as-processable t]
2695          ["Remove mark" gnus-summary-unmark-as-processable t]
2696          ["Remove all marks" gnus-summary-unmark-all-processable t]
2697          ["Invert marks" gnus-uu-invert-processable t]
2698          ["Mark above" gnus-uu-mark-over t]
2699          ["Mark series" gnus-uu-mark-series t]
2700          ["Mark region" gnus-uu-mark-region (gnus-mark-active-p)]
2701          ["Unmark region" gnus-uu-unmark-region (gnus-mark-active-p)]
2702          ["Mark by regexp..." gnus-uu-mark-by-regexp t]
2703          ["Unmark by regexp..." gnus-uu-unmark-by-regexp t]
2704          ["Mark all" gnus-uu-mark-all t]
2705          ["Mark buffer" gnus-uu-mark-buffer t]
2706          ["Mark sparse" gnus-uu-mark-sparse t]
2707          ["Mark thread" gnus-uu-mark-thread t]
2708          ["Unmark thread" gnus-uu-unmark-thread t]
2709          ("Process Mark Sets"
2710           ["Kill" gnus-summary-kill-process-mark t]
2711           ["Yank" gnus-summary-yank-process-mark
2712            gnus-newsgroup-process-stack]
2713           ["Save" gnus-summary-save-process-mark t]
2714           ["Run command on marked..." gnus-summary-universal-argument t]))
2715         ("Registry Marks")
2716         ("Scroll article"
2717          ["Page forward" gnus-summary-next-page
2718           ,@(if (featurep 'xemacs) '(t)
2719               '(:help "Show next page of article"))]
2720          ["Page backward" gnus-summary-prev-page
2721           ,@(if (featurep 'xemacs) '(t)
2722               '(:help "Show previous page of article"))]
2723          ["Line forward" gnus-summary-scroll-up t])
2724         ("Move"
2725          ["Next unread article" gnus-summary-next-unread-article t]
2726          ["Previous unread article" gnus-summary-prev-unread-article t]
2727          ["Next article" gnus-summary-next-article t]
2728          ["Previous article" gnus-summary-prev-article t]
2729          ["Next unread subject" gnus-summary-next-unread-subject t]
2730          ["Previous unread subject" gnus-summary-prev-unread-subject t]
2731          ["Next article same subject" gnus-summary-next-same-subject t]
2732          ["Previous article same subject" gnus-summary-prev-same-subject t]
2733          ["First unread article" gnus-summary-first-unread-article t]
2734          ["Best unread article" gnus-summary-best-unread-article t]
2735          ["Go to subject number..." gnus-summary-goto-subject t]
2736          ["Go to article number..." gnus-summary-goto-article t]
2737          ["Go to the last article" gnus-summary-goto-last-article t]
2738          ["Pop article off history" gnus-summary-pop-article t])
2739         ("Sort"
2740          ["Sort by number" gnus-summary-sort-by-number t]
2741          ["Sort by most recent number" gnus-summary-sort-by-most-recent-number t]
2742          ["Sort by author" gnus-summary-sort-by-author t]
2743          ["Sort by recipient" gnus-summary-sort-by-recipient t]
2744          ["Sort by subject" gnus-summary-sort-by-subject t]
2745          ["Sort by date" gnus-summary-sort-by-date t]
2746          ["Sort by most recent date" gnus-summary-sort-by-most-recent-date t]
2747          ["Sort by score" gnus-summary-sort-by-score t]
2748          ["Sort by lines" gnus-summary-sort-by-lines t]
2749          ["Sort by characters" gnus-summary-sort-by-chars t]
2750          ["Randomize" gnus-summary-sort-by-random t]
2751          ["Original sort" gnus-summary-sort-by-original t])
2752         ("Help"
2753          ["Describe group" gnus-summary-describe-group t]
2754          ["Read manual" gnus-info-find-node t])
2755         ("Modes"
2756          ["Pick and read" gnus-pick-mode t]
2757          ["Binary" gnus-binary-mode t])
2758         ("Regeneration"
2759          ["Regenerate" gnus-summary-prepare t]
2760          ["Insert cached articles" gnus-summary-insert-cached-articles t]
2761          ["Insert dormant articles" gnus-summary-insert-dormant-articles t]
2762          ["Insert ticked articles" gnus-summary-insert-ticked-articles t]
2763          ["Toggle threading" gnus-summary-toggle-threads t])
2764         ["See old articles" gnus-summary-insert-old-articles t]
2765         ["See new articles" gnus-summary-insert-new-articles t]
2766         ["Filter articles..." gnus-summary-execute-command t]
2767         ["Run command on articles..." gnus-summary-universal-argument t]
2768         ["Search articles forward..." gnus-summary-search-article-forward t]
2769         ["Search articles backward..." gnus-summary-search-article-backward t]
2770         ["Toggle line truncation" gnus-summary-toggle-truncation t]
2771         ["Expand window" gnus-summary-expand-window t]
2772         ["Expire expirable articles" gnus-summary-expire-articles
2773          (gnus-check-backend-function
2774           'request-expire-articles gnus-newsgroup-name)]
2775         ["Edit local kill file" gnus-summary-edit-local-kill t]
2776         ["Edit main kill file" gnus-summary-edit-global-kill t]
2777         ["Edit group parameters" gnus-summary-edit-parameters t]
2778         ["Customize group parameters" gnus-summary-customize-parameters t]
2779         ["Send a bug report" gnus-bug t]
2780         ("Exit"
2781          ["Catchup and exit" gnus-summary-catchup-and-exit
2782           ,@(if (featurep 'xemacs) '(t)
2783               '(:help "Mark unread articles in this group as read, then exit"))]
2784          ["Catchup all and exit" gnus-summary-catchup-all-and-exit t]
2785          ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t]
2786          ["Catchup and goto prev" gnus-summary-catchup-and-goto-prev-group t]
2787          ["Exit group" gnus-summary-exit
2788           ,@(if (featurep 'xemacs) '(t)
2789               '(:help "Exit current group, return to group selection mode"))]
2790          ["Exit group without updating" gnus-summary-exit-no-update t]
2791          ["Exit and goto next group" gnus-summary-next-group t]
2792          ["Exit and goto prev group" gnus-summary-prev-group t]
2793          ["Reselect group" gnus-summary-reselect-current-group t]
2794          ["Rescan group" gnus-summary-rescan-group t]
2795          ["Update dribble" gnus-summary-save-newsrc t])))
2796
2797     (gnus-run-hooks 'gnus-summary-menu-hook)))
2798
2799 (defvar gnus-summary-tool-bar-map nil)
2800
2801 ;; Note: The :set function in the `gnus-summary-tool-bar*' variables will only
2802 ;; affect _new_ message buffers.  We might add a function that walks thru all
2803 ;; summary-mode buffers and force the update.
2804 (defun gnus-summary-tool-bar-update (&optional symbol value)
2805   "Update summary mode toolbar.
2806 Setter function for custom variables."
2807   (setq-default gnus-summary-tool-bar-map nil)
2808   (when symbol
2809     ;; When used as ":set" function:
2810     (set-default symbol value))
2811   (when (gnus-buffer-live-p gnus-summary-buffer)
2812     (with-current-buffer gnus-summary-buffer
2813       (gnus-summary-make-tool-bar))))
2814
2815 (defcustom gnus-summary-tool-bar (if (eq gmm-tool-bar-style 'gnome)
2816                                      'gnus-summary-tool-bar-gnome
2817                                    'gnus-summary-tool-bar-retro)
2818   "Specifies the Gnus summary tool bar.
2819
2820 It can be either a list or a symbol refering to a list.  See
2821 `gmm-tool-bar-from-list' for the format of the list.  The
2822 default key map is `gnus-summary-mode-map'.
2823
2824 Pre-defined symbols include `gnus-summary-tool-bar-gnome' and
2825 `gnus-summary-tool-bar-retro'."
2826   :type '(choice (const :tag "GNOME style" gnus-summary-tool-bar-gnome)
2827                  (const :tag "Retro look"  gnus-summary-tool-bar-retro)
2828                  (repeat :tag "User defined list" gmm-tool-bar-item)
2829                  (symbol))
2830   :version "23.1" ;; No Gnus
2831   :initialize 'custom-initialize-default
2832   :set 'gnus-summary-tool-bar-update
2833   :group 'gnus-summary)
2834
2835 (defcustom gnus-summary-tool-bar-gnome
2836   '((gnus-summary-post-news "mail/compose" nil)
2837     (gnus-summary-insert-new-articles "mail/inbox" nil
2838                                       :visible (or (not gnus-agent)
2839                                                    gnus-plugged))
2840     (gnus-summary-reply-with-original "mail/reply")
2841     (gnus-summary-reply "mail/reply" nil :visible nil)
2842     (gnus-summary-followup-with-original "mail/reply-all")
2843     (gnus-summary-followup "mail/reply-all" nil :visible nil)
2844     (gnus-summary-mail-forward "mail/forward")
2845     (gnus-summary-save-article "mail/save")
2846     (gnus-summary-search-article-forward "search" nil :visible nil)
2847     (gnus-summary-print-article "print")
2848     (gnus-summary-tick-article-forward "flag-followup" nil :visible nil)
2849     ;; Some new commands that may need more suitable icons:
2850     (gnus-summary-save-newsrc "save" nil :visible nil)
2851     ;; (gnus-summary-show-article "stock_message-display" nil :visible nil)
2852     (gnus-summary-prev-article "left-arrow")
2853     (gnus-summary-next-article "right-arrow")
2854     (gnus-summary-next-page "next-page")
2855     ;; (gnus-summary-enter-digest-group "right_arrow" nil :visible nil)
2856     ;;
2857     ;; Maybe some sort-by-... could be added:
2858     ;; (gnus-summary-sort-by-author "sort-a-z" nil :visible nil)
2859     ;; (gnus-summary-sort-by-date "sort-1-9" nil :visible nil)
2860     (gnus-summary-mark-as-expirable
2861      "delete" nil
2862      :visible (gnus-check-backend-function 'request-expire-articles
2863                                            gnus-newsgroup-name))
2864     (gnus-summary-mark-as-spam
2865      "mail/spam" t
2866      :visible (and (fboundp 'spam-group-ham-contents-p)
2867                    (spam-group-ham-contents-p gnus-newsgroup-name))
2868      :help "Mark as spam")
2869     (gnus-summary-mark-as-read-forward
2870      "mail/not-spam" nil
2871      :visible (and (fboundp 'spam-group-spam-contents-p)
2872                    (spam-group-spam-contents-p gnus-newsgroup-name)))
2873     ;;
2874     (gnus-summary-exit "exit")
2875     (gmm-customize-mode "preferences" t :help "Edit mode preferences")
2876     (gnus-info-find-node "help"))
2877   "List of functions for the summary tool bar (GNOME style).
2878
2879 See `gmm-tool-bar-from-list' for the format of the list."
2880   :type '(repeat gmm-tool-bar-item)
2881   :version "23.1" ;; No Gnus
2882   :initialize 'custom-initialize-default
2883   :set 'gnus-summary-tool-bar-update
2884   :group 'gnus-summary)
2885
2886 (defcustom gnus-summary-tool-bar-retro
2887   '((gnus-summary-prev-unread-article "gnus/prev-ur")
2888     (gnus-summary-next-unread-article "gnus/next-ur")
2889     (gnus-summary-post-news "gnus/post")
2890     (gnus-summary-followup-with-original "gnus/fuwo")
2891     (gnus-summary-followup "gnus/followup")
2892     (gnus-summary-reply-with-original "gnus/reply-wo")
2893     (gnus-summary-reply "gnus/reply")
2894     (gnus-summary-caesar-message "gnus/rot13")
2895     (gnus-uu-decode-uu "gnus/uu-decode")
2896     (gnus-summary-save-article-file "gnus/save-aif")
2897     (gnus-summary-save-article "gnus/save-art")
2898     (gnus-uu-post-news "gnus/uu-post")
2899     (gnus-summary-catchup "gnus/catchup")
2900     (gnus-summary-catchup-and-exit "gnus/cu-exit")
2901     (gnus-summary-exit "gnus/exit-summ")
2902     ;; Some new command that may need more suitable icons:
2903     (gnus-summary-print-article "gnus/print" nil :visible nil)
2904     (gnus-summary-mark-as-expirable "gnus/close" nil :visible nil)
2905     (gnus-summary-save-newsrc "gnus/save" nil :visible nil)
2906     ;; (gnus-summary-enter-digest-group "gnus/right_arrow" nil :visible nil)
2907     (gnus-summary-search-article-forward "gnus/search" nil :visible nil)
2908     ;; (gnus-summary-insert-new-articles "gnus/paste" nil :visible nil)
2909     ;; (gnus-summary-toggle-threads "gnus/open" nil :visible nil)
2910     ;;
2911     (gnus-info-find-node "gnus/help" nil :visible nil))
2912   "List of functions for the summary tool bar (retro look).
2913
2914 See `gmm-tool-bar-from-list' for the format of the list."
2915   :type '(repeat gmm-tool-bar-item)
2916   :version "23.1" ;; No Gnus
2917   :initialize 'custom-initialize-default
2918   :set 'gnus-summary-tool-bar-update
2919   :group 'gnus-summary)
2920
2921 (defcustom gnus-summary-tool-bar-zap-list t
2922   "List of icon items from the global tool bar.
2923 These items are not displayed in the Gnus summary mode tool bar.
2924
2925 See `gmm-tool-bar-from-list' for the format of the list."
2926   :type 'gmm-tool-bar-zap-list
2927   :version "23.1" ;; No Gnus
2928   :initialize 'custom-initialize-default
2929   :set 'gnus-summary-tool-bar-update
2930   :group 'gnus-summary)
2931
2932 (defvar image-load-path)
2933 (defvar tool-bar-map)
2934
2935 (defun gnus-summary-make-tool-bar (&optional force)
2936   "Make a summary mode tool bar from `gnus-summary-tool-bar'.
2937 When FORCE, rebuild the tool bar."
2938   (when (and (not (featurep 'xemacs))
2939              (boundp 'tool-bar-mode)
2940              tool-bar-mode
2941              (or (not gnus-summary-tool-bar-map) force))
2942     (let* ((load-path
2943             (gmm-image-load-path-for-library "gnus"
2944                                              "mail/save.xpm"
2945                                              nil t))
2946            (image-load-path (cons (car load-path)
2947                                   (when (boundp 'image-load-path)
2948                                     image-load-path)))
2949            (map (gmm-tool-bar-from-list gnus-summary-tool-bar
2950                                         gnus-summary-tool-bar-zap-list
2951                                         'gnus-summary-mode-map)))
2952       (when map
2953         ;; Need to set `gnus-summary-tool-bar-map' because `gnus-article-mode'
2954         ;; uses it's value.
2955         (setq gnus-summary-tool-bar-map map))))
2956   (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map))
2957
2958 (defun gnus-score-set-default (var value)
2959   "A version of set that updates the GNU Emacs menu-bar."
2960   (set var value)
2961   ;; It is the message that forces the active status to be updated.
2962   (message ""))
2963
2964 (defun gnus-make-score-map (type)
2965   "Make a summary score map of type TYPE."
2966   (if t
2967       nil
2968     (let ((headers '(("author" "from" string)
2969                      ("subject" "subject" string)
2970                      ("article body" "body" string)
2971                      ("article head" "head" string)
2972                      ("xref" "xref" string)
2973                      ("extra header" "extra" string)
2974                      ("lines" "lines" number)
2975                      ("followups to author" "followup" string)))
2976           (types '((number ("less than" <)
2977                            ("greater than" >)
2978                            ("equal" =))
2979                    (string ("substring" s)
2980                            ("exact string" e)
2981                            ("fuzzy string" f)
2982                            ("regexp" r))))
2983           (perms '(("temporary" (current-time-string))
2984                    ("permanent" nil)
2985                    ("immediate" now)))
2986           header)
2987       (list
2988        (apply
2989         'nconc
2990         (list
2991          (if (eq type 'lower)
2992              "Lower score"
2993            "Increase score"))
2994         (let (outh)
2995           (while headers
2996             (setq header (car headers))
2997             (setq outh
2998                   (cons
2999                    (apply
3000                     'nconc
3001                     (list (car header))
3002                     (let ((ts (cdr (assoc (nth 2 header) types)))
3003                           outt)
3004                       (while ts
3005                         (setq outt
3006                               (cons
3007                                (apply
3008                                 'nconc
3009                                 (list (caar ts))
3010                                 (let ((ps perms)
3011                                       outp)
3012                                   (while ps
3013                                     (setq outp
3014                                           (cons
3015                                            (vector
3016                                             (caar ps)
3017                                             (list
3018                                              'gnus-summary-score-entry
3019                                              (nth 1 header)
3020                                              (if (or (string= (nth 1 header)
3021                                                               "head")
3022                                                      (string= (nth 1 header)
3023                                                               "body"))
3024                                                  ""
3025                                                (list 'gnus-summary-header
3026                                                      (nth 1 header)))
3027                                              (list 'quote (nth 1 (car ts)))
3028                                              (list 'gnus-score-delta-default
3029                                                    nil)
3030                                              (nth 1 (car ps))
3031                                              t)
3032                                             t)
3033                                            outp))
3034                                     (setq ps (cdr ps)))
3035                                   (list (nreverse outp))))
3036                                outt))
3037                         (setq ts (cdr ts)))
3038                       (list (nreverse outt))))
3039                    outh))
3040             (setq headers (cdr headers)))
3041           (list (nreverse outh))))))))
3042
3043
3044 (declare-function turn-on-gnus-mailing-list-mode "gnus-ml" ())
3045 (defvar bookmark-make-record-function)
3046 \f
3047
3048 (defun gnus-summary-mode (&optional group)
3049   "Major mode for reading articles.
3050
3051 All normal editing commands are switched off.
3052 \\<gnus-summary-mode-map>
3053 Each line in this buffer represents one article.  To read an
3054 article, you can, for instance, type `\\[gnus-summary-next-page]'.  To move forwards
3055 and backwards while displaying articles, type `\\[gnus-summary-next-unread-article]' and `\\[gnus-summary-prev-unread-article]',
3056 respectively.
3057
3058 You can also post articles and send mail from this buffer.  To
3059 follow up an article, type `\\[gnus-summary-followup]'.  To mail a reply to the author
3060 of an article, type `\\[gnus-summary-reply]'.
3061
3062 There are approx. one gazillion commands you can execute in this
3063 buffer; read the info pages for more information (`\\[gnus-info-find-node]').
3064
3065 The following commands are available:
3066
3067 \\{gnus-summary-mode-map}"
3068   (interactive)
3069   (kill-all-local-variables)
3070   (let ((gnus-summary-local-variables gnus-newsgroup-variables))
3071     (gnus-summary-make-local-variables))
3072   (gnus-summary-make-local-variables)
3073   (setq gnus-newsgroup-name group)
3074   (when (gnus-visual-p 'summary-menu 'menu)
3075     (gnus-summary-make-menu-bar)
3076     (gnus-summary-make-tool-bar))
3077   (gnus-make-thread-indent-array)
3078   (gnus-simplify-mode-line)
3079   (setq major-mode 'gnus-summary-mode)
3080   (setq mode-name "Summary")
3081   (use-local-map gnus-summary-mode-map)
3082   (buffer-disable-undo)
3083   (setq buffer-read-only t              ;Disable modification
3084         show-trailing-whitespace nil)
3085   (setq truncate-lines t)
3086   (add-to-invisibility-spec '(gnus-sum . t))
3087   (gnus-summary-set-display-table)
3088   (gnus-set-default-directory)
3089   (make-local-variable 'gnus-summary-line-format)
3090   (make-local-variable 'gnus-summary-line-format-spec)
3091   (make-local-variable 'gnus-summary-dummy-line-format)
3092   (make-local-variable 'gnus-summary-dummy-line-format-spec)
3093   (make-local-variable 'gnus-summary-mark-positions)
3094   (gnus-make-local-hook 'pre-command-hook)
3095   (add-hook 'pre-command-hook 'gnus-set-global-variables nil t)
3096   (gnus-run-mode-hooks 'gnus-summary-mode-hook)
3097   (turn-on-gnus-mailing-list-mode)
3098   (mm-enable-multibyte)
3099   (set (make-local-variable 'bookmark-make-record-function)
3100        'gnus-summary-bookmark-make-record)
3101   (gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy)
3102   (gnus-update-summary-mark-positions))
3103
3104 (defun gnus-summary-make-local-variables ()
3105   "Make all the local summary buffer variables."
3106   (let (global)
3107     (dolist (local gnus-summary-local-variables)
3108       (if (consp local)
3109           (progn
3110             (if (eq (cdr local) 'global)
3111                 ;; Copy the global value of the variable.
3112                 (setq global (symbol-value (car local)))
3113               ;; Use the value from the list.
3114               (setq global (eval (cdr local))))
3115             (set (make-local-variable (car local)) global))
3116         ;; Simple nil-valued local variable.
3117         (set (make-local-variable local) nil)))))
3118
3119 ;; Summary data functions.
3120
3121 (defmacro gnus-data-number (data)
3122   `(car ,data))
3123
3124 (defmacro gnus-data-set-number (data number)
3125   `(setcar ,data ,number))
3126
3127 (defmacro gnus-data-mark (data)
3128   `(nth 1 ,data))
3129
3130 (defmacro gnus-data-set-mark (data mark)
3131   `(setcar (nthcdr 1 ,data) ,mark))
3132
3133 (defmacro gnus-data-pos (data)
3134   `(nth 2 ,data))
3135
3136 (defmacro gnus-data-set-pos (data pos)
3137   `(setcar (nthcdr 2 ,data) ,pos))
3138
3139 (defmacro gnus-data-header (data)
3140   `(nth 3 ,data))
3141
3142 (defmacro gnus-data-set-header (data header)
3143   `(setf (nth 3 ,data) ,header))
3144
3145 (defmacro gnus-data-level (data)
3146   `(nth 4 ,data))
3147
3148 (defmacro gnus-data-unread-p (data)
3149   `(= (nth 1 ,data) gnus-unread-mark))
3150
3151 (defmacro gnus-data-read-p (data)
3152   `(/= (nth 1 ,data) gnus-unread-mark))
3153
3154 (defmacro gnus-data-pseudo-p (data)
3155   `(consp (nth 3 ,data)))
3156
3157 (defmacro gnus-data-find (number)
3158   `(assq ,number gnus-newsgroup-data))
3159
3160 (defmacro gnus-data-find-list (number &optional data)
3161   `(let ((bdata ,(or data 'gnus-newsgroup-data)))
3162      (memq (assq ,number bdata)
3163            bdata)))
3164
3165 (defmacro gnus-data-make (number mark pos header level)
3166   `(list ,number ,mark ,pos ,header ,level))
3167
3168 (defun gnus-data-enter (after-article number mark pos header level offset)
3169   (let ((data (gnus-data-find-list after-article)))
3170     (unless data
3171       (error "No such article: %d" after-article))
3172     (setcdr data (cons (gnus-data-make number mark pos header level)
3173                        (cdr data)))
3174     (setq gnus-newsgroup-data-reverse nil)
3175     (gnus-data-update-list (cddr data) offset)))
3176
3177 (defun gnus-data-enter-list (after-article list &optional offset)
3178   (when list
3179     (let ((data (and after-article (gnus-data-find-list after-article)))
3180           (ilist list))
3181       (if (not (or data
3182                    after-article))
3183           (let ((odata gnus-newsgroup-data))
3184             (setq gnus-newsgroup-data (nconc list gnus-newsgroup-data))
3185             (when offset
3186               (gnus-data-update-list odata offset)))
3187         ;; Find the last element in the list to be spliced into the main
3188         ;; list.
3189         (setq list (last list))
3190         (if (not data)
3191             (progn
3192               (setcdr list gnus-newsgroup-data)
3193               (setq gnus-newsgroup-data ilist)
3194               (when offset
3195                 (gnus-data-update-list (cdr list) offset)))
3196           (setcdr list (cdr data))
3197           (setcdr data ilist)
3198           (when offset
3199             (gnus-data-update-list (cdr list) offset))))
3200       (setq gnus-newsgroup-data-reverse nil))))
3201
3202 (defun gnus-data-remove (article &optional offset)
3203   (let ((data gnus-newsgroup-data))
3204     (if (= (gnus-data-number (car data)) article)
3205         (progn
3206           (setq gnus-newsgroup-data (cdr gnus-newsgroup-data)
3207                 gnus-newsgroup-data-reverse nil)
3208           (when offset
3209             (gnus-data-update-list gnus-newsgroup-data offset)))
3210       (while (cdr data)
3211         (when (= (gnus-data-number (cadr data)) article)
3212           (setcdr data (cddr data))
3213           (when offset
3214             (gnus-data-update-list (cdr data) offset))
3215           (setq data nil
3216                 gnus-newsgroup-data-reverse nil))
3217         (setq data (cdr data))))))
3218
3219 (defmacro gnus-data-list (backward)
3220   `(if ,backward
3221        (or gnus-newsgroup-data-reverse
3222            (setq gnus-newsgroup-data-reverse
3223                  (reverse gnus-newsgroup-data)))
3224      gnus-newsgroup-data))
3225
3226 (defun gnus-data-update-list (data offset)
3227   "Add OFFSET to the POS of all data entries in DATA."
3228   (setq gnus-newsgroup-data-reverse nil)
3229   (while data
3230     (setcar (nthcdr 2 (car data)) (+ offset (nth 2 (car data))))
3231     (setq data (cdr data))))
3232
3233 (defun gnus-summary-article-pseudo-p (article)
3234   "Say whether this article is a pseudo article or not."
3235   (not (vectorp (gnus-data-header (gnus-data-find article)))))
3236
3237 (defmacro gnus-summary-article-sparse-p (article)
3238   "Say whether this article is a sparse article or not."
3239   `(memq ,article gnus-newsgroup-sparse))
3240
3241 (defmacro gnus-summary-article-ancient-p (article)
3242   "Say whether this article is a sparse article or not."
3243   `(memq ,article gnus-newsgroup-ancient))
3244
3245 (defun gnus-article-parent-p (number)
3246   "Say whether this article is a parent or not."
3247   (let ((data (gnus-data-find-list number)))
3248     (and (cdr data)              ; There has to be an article after...
3249          (< (gnus-data-level (car data)) ; And it has to have a higher level.
3250             (gnus-data-level (nth 1 data))))))
3251
3252 (defun gnus-article-children (number)
3253   "Return a list of all children to NUMBER."
3254   (let* ((data (gnus-data-find-list number))
3255          (level (gnus-data-level (car data)))
3256          children)
3257     (setq data (cdr data))
3258     (while (and data
3259                 (= (gnus-data-level (car data)) (1+ level)))
3260       (push (gnus-data-number (car data)) children)
3261       (setq data (cdr data)))
3262     children))
3263
3264 (defmacro gnus-summary-skip-intangible ()
3265   "If the current article is intangible, then jump to a different article."
3266   '(let ((to (get-text-property (point) 'gnus-intangible)))
3267      (and to (gnus-summary-goto-subject to))))
3268
3269 (defmacro gnus-summary-article-intangible-p ()
3270   "Say whether this article is intangible or not."
3271   '(get-text-property (point) 'gnus-intangible))
3272
3273 (defun gnus-article-read-p (article)
3274   "Say whether ARTICLE is read or not."
3275   (not (or (memq article gnus-newsgroup-marked)
3276            (memq article gnus-newsgroup-spam-marked)
3277            (memq article gnus-newsgroup-unreads)
3278            (memq article gnus-newsgroup-unselected)
3279            (memq article gnus-newsgroup-dormant))))
3280
3281 ;; Some summary mode macros.
3282
3283 (defmacro gnus-summary-article-number ()
3284   "The article number of the article on the current line.
3285 If there isn't an article number here, then we return the current
3286 article number."
3287   '(progn
3288      (gnus-summary-skip-intangible)
3289      (or (get-text-property (point) 'gnus-number)
3290          (gnus-summary-last-subject))))
3291
3292 (defmacro gnus-summary-article-header (&optional number)
3293   "Return the header of article NUMBER."
3294   `(gnus-data-header (gnus-data-find
3295                       ,(or number '(gnus-summary-article-number)))))
3296
3297 (defmacro gnus-summary-thread-level (&optional number)
3298   "Return the level of thread that starts with article NUMBER."
3299   `(if (and (eq gnus-summary-make-false-root 'dummy)
3300             (get-text-property (point) 'gnus-intangible))
3301        0
3302      (gnus-data-level (gnus-data-find
3303                        ,(or number '(gnus-summary-article-number))))))
3304
3305 (defmacro gnus-summary-article-mark (&optional number)
3306   "Return the mark of article NUMBER."
3307   `(gnus-data-mark (gnus-data-find
3308                     ,(or number '(gnus-summary-article-number)))))
3309
3310 (defmacro gnus-summary-article-pos (&optional number)
3311   "Return the position of the line of article NUMBER."
3312   `(gnus-data-pos (gnus-data-find
3313                    ,(or number '(gnus-summary-article-number)))))
3314
3315 (defalias 'gnus-summary-subject-string 'gnus-summary-article-subject)
3316 (defmacro gnus-summary-article-subject (&optional number)
3317   "Return current subject string or nil if nothing."
3318   `(let ((headers
3319           ,(if number
3320                `(gnus-data-header (assq ,number gnus-newsgroup-data))
3321              '(gnus-data-header (assq (gnus-summary-article-number)
3322                                       gnus-newsgroup-data)))))
3323      (and headers
3324           (vectorp headers)
3325           (mail-header-subject headers))))
3326
3327 (defmacro gnus-summary-article-score (&optional number)
3328   "Return current article score."
3329   `(or (cdr (assq ,(or number '(gnus-summary-article-number))
3330                   gnus-newsgroup-scored))
3331        gnus-summary-default-score 0))
3332
3333 (defun gnus-summary-article-children (&optional number)
3334   "Return a list of article numbers that are children of article NUMBER."
3335   (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))))
3336          (level (gnus-data-level (car data)))
3337          l children)
3338     (while (and (setq data (cdr data))
3339                 (> (setq l (gnus-data-level (car data))) level))
3340       (and (= (1+ level) l)
3341            (push (gnus-data-number (car data))
3342                  children)))
3343     (nreverse children)))
3344
3345 (defun gnus-summary-article-parent (&optional number)
3346   "Return the article number of the parent of article NUMBER."
3347   (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))
3348                                     (gnus-data-list t)))
3349          (level (gnus-data-level (car data))))
3350     (if (zerop level)
3351         ()                              ; This is a root.
3352       ;; We search until we find an article with a level less than
3353       ;; this one.  That function has to be the parent.
3354       (while (and (setq data (cdr data))
3355                   (not (< (gnus-data-level (car data)) level))))
3356       (and data (gnus-data-number (car data))))))
3357
3358 (defun gnus-unread-mark-p (mark)
3359   "Say whether MARK is the unread mark."
3360   (= mark gnus-unread-mark))
3361
3362 (defun gnus-read-mark-p (mark)
3363   "Say whether MARK is one of the marks that mark as read.
3364 This is all marks except unread, ticked, dormant, and expirable."
3365   (not (or (= mark gnus-unread-mark)
3366            (= mark gnus-ticked-mark)
3367            (= mark gnus-spam-mark)
3368            (= mark gnus-dormant-mark)
3369            (= mark gnus-expirable-mark))))
3370
3371 (defmacro gnus-article-mark (number)
3372   "Return the MARK of article NUMBER.
3373 This macro should only be used when computing the mark the \"first\"
3374 time; i.e., when generating the summary lines.  After that,
3375 `gnus-summary-article-mark' should be used to examine the
3376 marks of articles."
3377   `(cond
3378     ((memq ,number gnus-newsgroup-unsendable) gnus-unsendable-mark)
3379     ((memq ,number gnus-newsgroup-downloadable) gnus-downloadable-mark)
3380     ((memq ,number gnus-newsgroup-unreads) gnus-unread-mark)
3381     ((memq ,number gnus-newsgroup-marked) gnus-ticked-mark)
3382     ((memq ,number gnus-newsgroup-spam-marked) gnus-spam-mark)
3383     ((memq ,number gnus-newsgroup-dormant) gnus-dormant-mark)
3384     ((memq ,number gnus-newsgroup-expirable) gnus-expirable-mark)
3385     (t (or (cdr (assq ,number gnus-newsgroup-reads))
3386            gnus-ancient-mark))))
3387
3388 ;; Saving hidden threads.
3389
3390 (defmacro gnus-save-hidden-threads (&rest forms)
3391   "Save hidden threads, eval FORMS, and restore the hidden threads."
3392   (let ((config (make-symbol "config")))
3393     `(let ((,config (gnus-hidden-threads-configuration)))
3394        (unwind-protect
3395            (save-excursion
3396              ,@forms)
3397          (gnus-restore-hidden-threads-configuration ,config)))))
3398 (put 'gnus-save-hidden-threads 'lisp-indent-function 0)
3399 (put 'gnus-save-hidden-threads 'edebug-form-spec '(body))
3400
3401 (defun gnus-data-compute-positions ()
3402   "Compute the positions of all articles."
3403   (setq gnus-newsgroup-data-reverse nil)
3404   (let ((data gnus-newsgroup-data))
3405     (save-excursion
3406       (gnus-save-hidden-threads
3407         (gnus-summary-show-all-threads)
3408         (goto-char (point-min))
3409         (while data
3410           (while (get-text-property (point) 'gnus-intangible)
3411             (forward-line 1))
3412           (gnus-data-set-pos (car data) (+ (point) 3))
3413           (setq data (cdr data))
3414           (forward-line 1))))))
3415
3416 (defun gnus-hidden-threads-configuration ()
3417   "Return the current hidden threads configuration."
3418   (save-excursion
3419     (let (config)
3420       (goto-char (point-min))
3421       (while (not (eobp))
3422         (when (eq (get-char-property (point-at-eol) 'invisible) 'gnus-sum)
3423           (push (save-excursion (forward-line 0) (point)) config))
3424         (forward-line 1))
3425       config)))
3426
3427 (defun gnus-restore-hidden-threads-configuration (config)
3428   "Restore hidden threads configuration from CONFIG."
3429   (save-excursion
3430     (let (point (inhibit-read-only t))
3431       (while (setq point (pop config))
3432         (goto-char point)
3433         (gnus-summary-hide-thread)))))
3434
3435 ;; Various summary mode internalish functions.
3436
3437 (defun gnus-mouse-pick-article (e)
3438   (interactive "e")
3439   (mouse-set-point e)
3440   (gnus-summary-next-page nil t))
3441
3442 (defun gnus-summary-set-display-table ()
3443   "Change the display table.
3444 Odd characters have a tendency to mess
3445 up nicely formatted displays - we make all possible glyphs
3446 display only a single character."
3447
3448   ;; We start from the standard display table, if any.
3449   (let ((table (or (copy-sequence standard-display-table)
3450                    (make-display-table)))
3451         (i 32))
3452     ;; Nix out all the control chars...
3453     (while (>= (setq i (1- i)) 0)
3454       (gnus-put-display-table i [??] table))
3455    ;; ... but not newline and cr, of course.  (cr is necessary for the
3456     ;; selective display).
3457     (gnus-put-display-table ?\n nil table)
3458     (gnus-put-display-table ?\r nil table)
3459     ;; We keep TAB as well.
3460     (gnus-put-display-table ?\t nil table)
3461     ;; We nix out any glyphs 127 through 255, or 127 through 159 in
3462     ;; Emacs 23 (unicode), that are not set already.
3463     (let ((i (if (ignore-errors (= (make-char 'latin-iso8859-1 160) 160))
3464                  160
3465                256)))
3466       (while (>= (setq i (1- i)) 127)
3467         ;; Only modify if the entry is nil.
3468         (unless (gnus-get-display-table i table)
3469           (gnus-put-display-table i [??] table))))
3470     (setq buffer-display-table table)))
3471
3472 (defun gnus-summary-set-article-display-arrow (pos)
3473   "Update the overlay arrow to point to line at position POS."
3474   (when gnus-summary-display-arrow
3475     (make-local-variable 'overlay-arrow-position)
3476     (make-local-variable 'overlay-arrow-string)
3477     (save-excursion
3478       (goto-char pos)
3479       (beginning-of-line)
3480       (unless overlay-arrow-position
3481         (setq overlay-arrow-position (make-marker)))
3482       (setq overlay-arrow-string "=>"
3483             overlay-arrow-position (set-marker overlay-arrow-position
3484                                                (point)
3485                                                (current-buffer))))))
3486
3487 (defun gnus-summary-setup-buffer (group)
3488   "Initialize summary buffer."
3489   (let ((buffer (gnus-summary-buffer-name group))
3490         (dead-name (concat "*Dead Summary "
3491                            (gnus-group-decoded-name group) "*")))
3492     ;; If a dead summary buffer exists, we kill it.
3493     (when (gnus-buffer-live-p dead-name)
3494       (gnus-kill-buffer dead-name))
3495     (if (get-buffer buffer)
3496         (progn
3497           (set-buffer buffer)
3498           (setq gnus-summary-buffer (current-buffer))
3499           (not gnus-newsgroup-prepared))
3500       ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
3501       (setq gnus-summary-buffer (set-buffer (gnus-get-buffer-create buffer)))
3502       (gnus-summary-mode group)
3503       (when (gnus-group-quit-config group)
3504         (set (make-local-variable 'gnus-single-article-buffer) nil))
3505       (make-local-variable 'gnus-article-buffer)
3506       (make-local-variable 'gnus-article-current)
3507       (make-local-variable 'gnus-original-article-buffer)
3508       (setq gnus-newsgroup-name group)
3509       ;; Set any local variables in the group parameters.
3510       (gnus-summary-set-local-parameters gnus-newsgroup-name)
3511       t)))
3512
3513 (defun gnus-set-global-variables ()
3514   "Set the global equivalents of the buffer-local variables.
3515 They are set to the latest values they had.  These reflect the summary
3516 buffer that was in action when the last article was fetched."
3517   (when (eq major-mode 'gnus-summary-mode)
3518     (setq gnus-summary-buffer (current-buffer))
3519     (let ((name gnus-newsgroup-name)
3520           (marked gnus-newsgroup-marked)
3521           (spam gnus-newsgroup-spam-marked)
3522           (unread gnus-newsgroup-unreads)
3523           (headers gnus-current-headers)
3524           (data gnus-newsgroup-data)
3525           (summary gnus-summary-buffer)
3526           (article-buffer gnus-article-buffer)
3527           (original gnus-original-article-buffer)
3528           (gac gnus-article-current)
3529           (reffed gnus-reffed-article-number)
3530           (score-file gnus-current-score-file)
3531           (default-charset gnus-newsgroup-charset)
3532           vlist)
3533       (let ((locals gnus-newsgroup-variables))
3534         (while locals
3535           (if (consp (car locals))
3536               (push (eval (caar locals)) vlist)
3537             (push (eval (car locals)) vlist))
3538           (setq locals (cdr locals)))
3539         (setq vlist (nreverse vlist)))
3540       (with-current-buffer gnus-group-buffer
3541         (setq gnus-newsgroup-name name
3542               gnus-newsgroup-marked marked
3543               gnus-newsgroup-spam-marked spam
3544               gnus-newsgroup-unreads unread
3545               gnus-current-headers headers
3546               gnus-newsgroup-data data
3547               gnus-article-current gac
3548               gnus-summary-buffer summary
3549               gnus-article-buffer article-buffer
3550               gnus-original-article-buffer original
3551               gnus-reffed-article-number reffed
3552               gnus-current-score-file score-file
3553               gnus-newsgroup-charset default-charset)
3554         (let ((locals gnus-newsgroup-variables))
3555           (while locals
3556             (if (consp (car locals))
3557                 (set (caar locals) (pop vlist))
3558               (set (car locals) (pop vlist)))
3559             (setq locals (cdr locals))))
3560         ;; The article buffer also has local variables.
3561         (when (gnus-buffer-live-p gnus-article-buffer)
3562           (set-buffer gnus-article-buffer)
3563           (setq gnus-summary-buffer summary))))))
3564
3565 (defun gnus-summary-article-unread-p (article)
3566   "Say whether ARTICLE is unread or not."
3567   (memq article gnus-newsgroup-unreads))
3568
3569 (defun gnus-summary-first-article-p (&optional article)
3570   "Return whether ARTICLE is the first article in the buffer."
3571   (if (not (setq article (or article (gnus-summary-article-number))))
3572       nil
3573     (eq article (caar gnus-newsgroup-data))))
3574
3575 (defun gnus-summary-last-article-p (&optional article)
3576   "Return whether ARTICLE is the last article in the buffer."
3577   (if (not (setq article (or article (gnus-summary-article-number))))
3578       ;; All non-existent numbers are the last article.  :-)
3579       t
3580     (not (cdr (gnus-data-find-list article)))))
3581
3582 (defun gnus-make-thread-indent-array (&optional n)
3583   (when (or n
3584             (progn (setq n 200) nil)
3585             (null gnus-thread-indent-array)
3586             (/= gnus-thread-indent-level gnus-thread-indent-array-level))
3587     (setq gnus-thread-indent-array (make-vector (1+ n) "")
3588           gnus-thread-indent-array-level gnus-thread-indent-level)
3589     (while (>= n 0)
3590       (aset gnus-thread-indent-array n
3591             (make-string (* n gnus-thread-indent-level) ? ))
3592       (setq n (1- n)))))
3593
3594 (defun gnus-update-summary-mark-positions ()
3595   "Compute where the summary marks are to go."
3596   (save-excursion
3597     (when (gnus-buffer-exists-p gnus-summary-buffer)
3598       (set-buffer gnus-summary-buffer))
3599     (let ((spec gnus-summary-line-format-spec)
3600           pos)
3601       (save-excursion
3602         (gnus-set-work-buffer)
3603         (let ((gnus-tmp-unread ?Z)
3604               (gnus-replied-mark ?Z)
3605               (gnus-score-below-mark ?Z)
3606               (gnus-score-over-mark ?Z)
3607               (gnus-undownloaded-mark ?Z)
3608               (gnus-summary-line-format-spec spec)
3609               (gnus-newsgroup-downloadable '(0))
3610               (header [0 "" "" "05 Apr 2001 23:33:09 +0400" "" "" 0 0 "" nil])
3611               case-fold-search ignores)
3612           ;; Here, all marks are bound to Z.
3613           (gnus-summary-insert-line header
3614                                     0 nil t gnus-tmp-unread t nil "" nil 1)
3615           (goto-char (point-min))
3616           ;; Memorize the positions of the same characters as dummy marks.
3617           (while (re-search-forward "[A-D]" nil t)
3618             (push (point) ignores))
3619           (erase-buffer)
3620           ;; We use A-D as dummy marks in order to know column positions
3621           ;; where marks should be inserted.
3622           (setq gnus-tmp-unread ?A
3623                 gnus-replied-mark ?B
3624                 gnus-score-below-mark ?C
3625                 gnus-score-over-mark ?C
3626                 gnus-undownloaded-mark ?D)
3627           (gnus-summary-insert-line header
3628                                     0 nil t gnus-tmp-unread t nil "" nil 1)
3629           ;; Ignore characters which aren't dummy marks.
3630           (dolist (p ignores)
3631             (delete-region (goto-char (1- p)) p)
3632             (insert ?Z))
3633           (goto-char (point-min))
3634           (setq pos (list (cons 'unread
3635                                 (and (search-forward "A" nil t)
3636                                      (- (point) (point-min) 1)))))
3637           (goto-char (point-min))
3638           (push (cons 'replied (and (search-forward "B" nil t)
3639                                     (- (point) (point-min) 1)))
3640                 pos)
3641           (goto-char (point-min))
3642           (push (cons 'score (and (search-forward "C" nil t)
3643                                   (- (point) (point-min) 1)))
3644                 pos)
3645           (goto-char (point-min))
3646           (push (cons 'download (and (search-forward "D" nil t)
3647                                      (- (point) (point-min) 1)))
3648                 pos)))
3649       (setq gnus-summary-mark-positions pos))))
3650
3651 (defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number)
3652   "Insert a dummy root in the summary buffer."
3653   (beginning-of-line)
3654   (gnus-add-text-properties
3655    (point) (progn (eval gnus-summary-dummy-line-format-spec) (point))
3656    (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number)))
3657
3658 (defun gnus-summary-extract-address-component (from)
3659   (or (car (funcall gnus-extract-address-components from))
3660       from))
3661
3662 (defun gnus-summary-from-or-to-or-newsgroups (header gnus-tmp-from)
3663   (let ((mail-parse-charset gnus-newsgroup-charset)
3664         (ignored-from-addresses (gnus-ignored-from-addresses))
3665         ; Is it really necessary to do this next part for each summary line?
3666         ; Luckily, doesn't seem to slow things down much.
3667         (mail-parse-ignored-charsets
3668          (with-current-buffer gnus-summary-buffer
3669            gnus-newsgroup-ignored-charsets)))
3670     (or
3671      (and ignored-from-addresses
3672           (string-match ignored-from-addresses gnus-tmp-from)
3673           (let ((extra-headers (mail-header-extra header))
3674                 to
3675                 newsgroups)
3676             (cond
3677              ((setq to (cdr (assq 'To extra-headers)))
3678               (concat gnus-summary-to-prefix
3679                       (inline
3680                         (gnus-summary-extract-address-component
3681                          (funcall gnus-decode-encoded-address-function to)))))
3682              ((setq newsgroups
3683                     (or
3684                      (cdr (assq 'Newsgroups extra-headers))
3685                      (and
3686                       (memq 'Newsgroups gnus-extra-headers)
3687                       (eq (car (gnus-find-method-for-group
3688                                 gnus-newsgroup-name)) 'nntp)
3689                       (gnus-group-real-name gnus-newsgroup-name))))
3690               (concat gnus-summary-newsgroup-prefix newsgroups)))))
3691      (inline (gnus-summary-extract-address-component gnus-tmp-from)))))
3692
3693 (defun gnus-summary-insert-line (gnus-tmp-header
3694                                  gnus-tmp-level gnus-tmp-current
3695                                  undownloaded gnus-tmp-unread gnus-tmp-replied
3696                                  gnus-tmp-expirable gnus-tmp-subject-or-nil
3697                                  &optional gnus-tmp-dummy gnus-tmp-score
3698                                  gnus-tmp-process)
3699   (if (>= gnus-tmp-level (length gnus-thread-indent-array))
3700       (gnus-make-thread-indent-array (max (* 2 (length gnus-thread-indent-array))
3701                                           gnus-tmp-level)))
3702   (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level))
3703          (gnus-tmp-lines (mail-header-lines gnus-tmp-header))
3704          (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0))
3705          (gnus-tmp-score-char
3706           (if (or (null gnus-summary-default-score)
3707                   (<= (abs (- gnus-tmp-score gnus-summary-default-score))
3708                       gnus-summary-zcore-fuzz))
3709               ?                         ;Whitespace
3710             (if (< gnus-tmp-score gnus-summary-default-score)
3711                 gnus-score-below-mark gnus-score-over-mark)))
3712          (gnus-tmp-number (mail-header-number gnus-tmp-header))
3713          (gnus-tmp-replied
3714           (cond (gnus-tmp-process gnus-process-mark)
3715                 ((memq gnus-tmp-current gnus-newsgroup-cached)
3716                  gnus-cached-mark)
3717                 (gnus-tmp-replied gnus-replied-mark)
3718                 ((memq gnus-tmp-current gnus-newsgroup-forwarded)
3719                  gnus-forwarded-mark)
3720                 ((memq gnus-tmp-current gnus-newsgroup-saved)
3721                  gnus-saved-mark)
3722                 ((memq gnus-tmp-number gnus-newsgroup-recent)
3723                  gnus-recent-mark)
3724                 ((memq gnus-tmp-number gnus-newsgroup-unseen)
3725                  gnus-unseen-mark)
3726                 (t gnus-no-mark)))
3727          (gnus-tmp-downloaded
3728           (cond (undownloaded
3729                  gnus-undownloaded-mark)
3730                 (gnus-newsgroup-agentized
3731                  gnus-downloaded-mark)
3732                 (t
3733                  gnus-no-mark)))
3734          (gnus-tmp-from (mail-header-from gnus-tmp-header))
3735          (gnus-tmp-name
3736           (cond
3737            ((string-match "<[^>]+> *$" gnus-tmp-from)
3738             (let ((beg (match-beginning 0)))
3739               (or (and (string-match "^\".+\"" gnus-tmp-from)
3740                        (substring gnus-tmp-from 1 (1- (match-end 0))))
3741                   (substring gnus-tmp-from 0 beg))))
3742            ((string-match "(.+)" gnus-tmp-from)
3743             (substring gnus-tmp-from
3744                        (1+ (match-beginning 0)) (1- (match-end 0))))
3745            (t gnus-tmp-from)))
3746          (gnus-tmp-subject (mail-header-subject gnus-tmp-header))
3747          (gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[))
3748          (gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\]))
3749          (inhibit-read-only t))
3750     (when (string= gnus-tmp-name "")
3751       (setq gnus-tmp-name gnus-tmp-from))
3752     (unless (numberp gnus-tmp-lines)
3753       (setq gnus-tmp-lines -1))
3754     (if (= gnus-tmp-lines -1)
3755         (setq gnus-tmp-lines "?")
3756       (setq gnus-tmp-lines (number-to-string gnus-tmp-lines)))
3757     (condition-case ()
3758         (gnus-put-text-property
3759          (point)
3760          (progn (eval gnus-summary-line-format-spec) (point))
3761          'gnus-number gnus-tmp-number)
3762       (error (gnus-message 5 "Error updating the summary line")))
3763     (when (gnus-visual-p 'summary-highlight 'highlight)
3764       (forward-line -1)
3765       (gnus-summary-highlight-line)
3766       (gnus-run-hooks 'gnus-summary-update-hook)
3767       (forward-line 1))))
3768
3769 (defun gnus-summary-update-line (&optional dont-update)
3770   "Update summary line after change."
3771   (when (and gnus-summary-default-score
3772              (not gnus-summary-inhibit-highlight))
3773     (let* ((gnus-summary-inhibit-highlight t) ; Prevent recursion.
3774            (article (gnus-summary-article-number))
3775            (score (gnus-summary-article-score article)))
3776       (unless dont-update
3777         (if (and gnus-summary-mark-below
3778                  (< (gnus-summary-article-score)
3779                     gnus-summary-mark-below))
3780             ;; This article has a low score, so we mark it as read.
3781             (when (memq article gnus-newsgroup-unreads)
3782               (gnus-summary-mark-article-as-read gnus-low-score-mark))
3783           (when (eq (gnus-summary-article-mark) gnus-low-score-mark)
3784             ;; This article was previously marked as read on account
3785             ;; of a low score, but now it has risen, so we mark it as
3786             ;; unread.
3787             (gnus-summary-mark-article-as-unread gnus-unread-mark)))
3788         (gnus-summary-update-mark
3789          (if (or (null gnus-summary-default-score)
3790                  (<= (abs (- score gnus-summary-default-score))
3791                      gnus-summary-zcore-fuzz))
3792              ?                          ;Whitespace
3793            (if (< score gnus-summary-default-score)
3794                gnus-score-below-mark gnus-score-over-mark))
3795          'score))
3796       ;; Do visual highlighting.
3797       (when (gnus-visual-p 'summary-highlight 'highlight)
3798         (gnus-summary-highlight-line)
3799         (gnus-run-hooks 'gnus-summary-update-hook)))))
3800
3801 (defvar gnus-tmp-new-adopts nil)
3802
3803 (defun gnus-summary-number-of-articles-in-thread (thread &optional level char)
3804   "Return the number of articles in THREAD.
3805 This may be 0 in some cases -- if none of the articles in
3806 the thread are to be displayed."
3807   (let* ((number
3808          ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
3809           (cond
3810            ((not (listp thread))
3811             1)
3812            ((and (consp thread) (cdr thread))
3813             (apply
3814              '+ 1 (mapcar
3815                    'gnus-summary-number-of-articles-in-thread (cdr thread))))
3816            ((null thread)
3817             1)
3818            ((memq (mail-header-number (car thread)) gnus-newsgroup-limit)
3819             1)
3820            (t 0))))
3821     (when (and level (zerop level) gnus-tmp-new-adopts)
3822       (incf number
3823             (apply '+ (mapcar
3824                        'gnus-summary-number-of-articles-in-thread
3825                        gnus-tmp-new-adopts))))
3826     (if char
3827         (if (> number 1) gnus-not-empty-thread-mark
3828           gnus-empty-thread-mark)
3829       number)))
3830
3831 (defsubst gnus-summary-line-message-size (head)
3832   "Return pretty-printed version of message size.
3833 This function is intended to be used in
3834 `gnus-summary-line-format-alist'."
3835   (let ((c (or (mail-header-chars head) -1)))
3836     (cond ((< c 0) "n/a")               ; chars not available
3837           ((< c (* 1000 10)) (format "%1.1fk" (/ c 1024.0)))
3838           ((< c (* 1000 100)) (format "%dk" (/ c 1024.0)))
3839           ((< c (* 1000 10000)) (format "%1.1fM" (/ c (* 1024.0 1024))))
3840           (t (format "%dM" (/ c (* 1024.0 1024)))))))
3841
3842
3843 (defun gnus-summary-set-local-parameters (group)
3844   "Go through the local params of GROUP and set all variable specs in that list."
3845   (let ((vars '(quit-config active)))   ; Ignore things that aren't
3846                                         ; really variables.
3847     (dolist (elem (gnus-group-find-parameter group))
3848       (and (consp elem)                 ; Has to be a cons.
3849            (consp (cdr elem))           ; The cdr has to be a list.
3850            (symbolp (car elem))         ; Has to be a symbol in there.
3851            (not (memq (car elem) vars))
3852            (ignore-errors
3853              (push (car elem) vars)
3854              ;; Variables like `gnus-show-threads' that are globally
3855              ;; bound, if used as group parameters, need to get to be
3856              ;; buffer-local, whereas just parameters like `gcc-self',
3857              ;; `timestamp', etc. should not be bound as variables.
3858              (if (boundp (car elem))
3859                  (set (make-local-variable (car elem)) (eval (nth 1 elem)))
3860                (eval (nth 1 elem))))))))
3861
3862 (defun gnus-summary-read-group (group &optional show-all no-article
3863                                       kill-buffer no-display backward
3864                                       select-articles)
3865   "Start reading news in newsgroup GROUP.
3866 If SHOW-ALL is non-nil, already read articles are also listed.
3867 If NO-ARTICLE is non-nil, no article is selected initially.
3868 If NO-DISPLAY, don't generate a summary buffer."
3869   (let (result)
3870     (while (and group
3871                 (null (setq result
3872                             (let ((gnus-auto-select-next nil))
3873                               (or (gnus-summary-read-group-1
3874                                    group show-all no-article
3875                                    kill-buffer no-display
3876                                    select-articles)
3877                                   (setq show-all nil
3878                                         select-articles nil)))))
3879                 (eq gnus-auto-select-next 'quietly))
3880       (set-buffer gnus-group-buffer)
3881       ;; The entry function called above goes to the next
3882       ;; group automatically, so we go two groups back
3883       ;; if we are searching for the previous group.
3884       (when backward
3885         (gnus-group-prev-unread-group 2))
3886       (if (not (equal group (gnus-group-group-name)))
3887           (setq group (gnus-group-group-name))
3888         (setq group nil)))
3889     result))
3890
3891 (defun gnus-summary-read-group-1 (group show-all no-article
3892                                         kill-buffer no-display
3893                                         &optional select-articles)
3894   ;; Killed foreign groups can't be entered.
3895   ;;  (when (and (not (gnus-group-native-p group))
3896   ;;         (not (gnus-gethash group gnus-newsrc-hashtb)))
3897   ;;    (error "Dead non-native groups can't be entered"))
3898   (gnus-message 5 "Retrieving newsgroup: %s..."
3899                 (gnus-group-decoded-name group))
3900   (let* ((new-group (gnus-summary-setup-buffer group))
3901          (quit-config (gnus-group-quit-config group))
3902          (did-select (and new-group (gnus-select-newsgroup
3903                                      group show-all select-articles))))
3904     (cond
3905      ;; This summary buffer exists already, so we just select it.
3906      ((not new-group)
3907       (gnus-set-global-variables)
3908       (when kill-buffer
3909         (gnus-kill-or-deaden-summary kill-buffer))
3910       (gnus-configure-windows 'summary 'force)
3911       (gnus-set-mode-line 'summary)
3912       (gnus-summary-position-point)
3913       (message "")
3914       t)
3915      ;; We couldn't select this group.
3916      ((null did-select)
3917       (when (and (eq major-mode 'gnus-summary-mode)
3918                  (not (equal (current-buffer) kill-buffer)))
3919         (kill-buffer (current-buffer))
3920         (if (not quit-config)
3921             (progn
3922               ;; Update the info -- marks might need to be removed,
3923               ;; for instance.
3924               (gnus-summary-update-info)
3925               (set-buffer gnus-group-buffer)
3926               (gnus-group-jump-to-group group)
3927               (gnus-group-next-unread-group 1))
3928           (gnus-handle-ephemeral-exit quit-config)))
3929       (let ((grpinfo (gnus-get-info group)))
3930         (if (null (gnus-info-read grpinfo))
3931             (gnus-message 3 "Group %s contains no messages"
3932                           (gnus-group-decoded-name group))
3933           (gnus-message 3 "Can't select group")))
3934       nil)
3935      ;; The user did a `C-g' while prompting for number of articles,
3936      ;; so we exit this group.
3937      ((eq did-select 'quit)
3938       (and (eq major-mode 'gnus-summary-mode)
3939            (not (equal (current-buffer) kill-buffer))
3940            (kill-buffer (current-buffer)))
3941       (when kill-buffer
3942         (gnus-kill-or-deaden-summary kill-buffer))
3943       (if (not quit-config)
3944           (progn
3945             (set-buffer gnus-group-buffer)
3946             (gnus-group-jump-to-group group)
3947             (gnus-configure-windows 'group 'force))
3948         (gnus-handle-ephemeral-exit quit-config))
3949       ;; Finally signal the quit.
3950       (signal 'quit nil))
3951      ;; The group was successfully selected.
3952      (t
3953       (gnus-set-global-variables)
3954       ;; Save the active value in effect when the group was entered.
3955       (setq gnus-newsgroup-active
3956             (gnus-copy-sequence
3957              (gnus-active gnus-newsgroup-name)))
3958       (setq gnus-newsgroup-highest (cdr gnus-newsgroup-active))
3959       ;; You can change the summary buffer in some way with this hook.
3960       (gnus-run-hooks 'gnus-select-group-hook)
3961       (when (memq 'summary (gnus-update-format-specifications
3962                             nil 'summary 'summary-mode 'summary-dummy))
3963         ;; The format specification for the summary line was updated,
3964         ;; so we need to update the mark positions as well.
3965         (gnus-update-summary-mark-positions))
3966       ;; Do score processing.
3967       (when gnus-use-scoring
3968         (gnus-possibly-score-headers))
3969       ;; Check whether to fill in the gaps in the threads.
3970       (when gnus-build-sparse-threads
3971         (gnus-build-sparse-threads))
3972       ;; Find the initial limit.
3973       (if show-all
3974           (let ((gnus-newsgroup-dormant nil))
3975             (gnus-summary-initial-limit show-all))
3976         (gnus-summary-initial-limit show-all))
3977       ;; Generate the summary buffer.
3978       (unless no-display
3979         (gnus-summary-prepare))
3980       (when gnus-use-trees
3981         (gnus-tree-open group)
3982         (setq gnus-summary-highlight-line-function
3983               'gnus-tree-highlight-article))
3984       ;; If the summary buffer is empty, but there are some low-scored
3985       ;; articles or some excluded dormants, we include these in the
3986       ;; buffer.
3987       (when (and (zerop (buffer-size))
3988                  (not no-display))
3989         (cond (gnus-newsgroup-dormant
3990                (gnus-summary-limit-include-dormant))
3991               ((and gnus-newsgroup-scored show-all)
3992                (gnus-summary-limit-include-expunged t))))
3993       ;; Function `gnus-apply-kill-file' must be called in this hook.
3994       (gnus-run-hooks 'gnus-apply-kill-hook)
3995       (if (and (zerop (buffer-size))
3996                (not no-display))
3997           (progn
3998             ;; This newsgroup is empty.
3999             (gnus-summary-catchup-and-exit nil t)
4000             (gnus-message 6 "No unread news")
4001             (when kill-buffer
4002               (gnus-kill-or-deaden-summary kill-buffer))
4003             ;; Return nil from this function.
4004             nil)
4005         ;; Hide conversation thread subtrees.  We cannot do this in
4006         ;; gnus-summary-prepare-hook since kill processing may not
4007         ;; work with hidden articles.
4008         (gnus-summary-maybe-hide-threads)
4009         (when kill-buffer
4010           (gnus-kill-or-deaden-summary kill-buffer))
4011         (gnus-summary-auto-select-subject)
4012         ;; Show first unread article if requested.
4013         (if (and (not no-article)
4014                  (not no-display)
4015                  gnus-newsgroup-unreads
4016                  gnus-auto-select-first)
4017             (progn
4018               (gnus-configure-windows 'summary)
4019               (let ((art (gnus-summary-article-number)))
4020                 (unless (and (not gnus-plugged)
4021                              (or (memq art gnus-newsgroup-undownloaded)
4022                                  (memq art gnus-newsgroup-downloadable)))
4023                   (gnus-summary-goto-article art))))
4024           ;; Don't select any articles.
4025           (gnus-summary-position-point)
4026           (gnus-configure-windows 'summary 'force)
4027           (gnus-set-mode-line 'summary))
4028         (when (and gnus-auto-center-group
4029                    (get-buffer-window gnus-group-buffer t))
4030           ;; Gotta use windows, because recenter does weird stuff if
4031           ;; the current buffer ain't the displayed window.
4032           (let ((owin (selected-window)))
4033             (select-window (get-buffer-window gnus-group-buffer t))
4034             (when (gnus-group-goto-group group)
4035               (recenter))
4036             (select-window owin)))
4037         ;; Mark this buffer as "prepared".
4038         (setq gnus-newsgroup-prepared t)
4039         (gnus-run-hooks 'gnus-summary-prepared-hook)
4040         (unless (gnus-ephemeral-group-p group)
4041           (gnus-group-update-group group))
4042         t)))))
4043
4044 (defun gnus-summary-auto-select-subject ()
4045   "Select the subject line on initial group entry."
4046   (goto-char (point-min))
4047   (cond
4048    ((eq gnus-auto-select-subject 'best)
4049     (gnus-summary-best-unread-subject))
4050    ((eq gnus-auto-select-subject 'unread)
4051     (gnus-summary-first-unread-subject))
4052    ((eq gnus-auto-select-subject 'unseen)
4053     (gnus-summary-first-unseen-subject))
4054    ((eq gnus-auto-select-subject 'unseen-or-unread)
4055     (gnus-summary-first-unseen-or-unread-subject))
4056    ((eq gnus-auto-select-subject 'first)
4057     ;; Do nothing.
4058     )
4059    ((functionp gnus-auto-select-subject)
4060     (funcall gnus-auto-select-subject))))
4061
4062 (defun gnus-summary-prepare ()
4063   "Generate the summary buffer."
4064   (interactive)
4065   (let ((inhibit-read-only t))
4066     (erase-buffer)
4067     (setq gnus-newsgroup-data nil
4068           gnus-newsgroup-data-reverse nil)
4069     (gnus-run-hooks 'gnus-summary-generate-hook)
4070     ;; Generate the buffer, either with threads or without.
4071     (when gnus-newsgroup-headers
4072       (gnus-summary-prepare-threads
4073        (if gnus-show-threads
4074            (gnus-sort-gathered-threads
4075             (funcall gnus-summary-thread-gathering-function
4076                      (gnus-sort-threads
4077                       (gnus-cut-threads (gnus-make-threads)))))
4078          ;; Unthreaded display.
4079          (gnus-sort-articles gnus-newsgroup-headers))))
4080     (setq gnus-newsgroup-data (nreverse gnus-newsgroup-data))
4081     ;; Call hooks for modifying summary buffer.
4082     (goto-char (point-min))
4083     (gnus-run-hooks 'gnus-summary-prepare-hook)))
4084
4085 (defsubst gnus-general-simplify-subject (subject)
4086   "Simplify subject by the same rules as `gnus-gather-threads-by-subject'."
4087   (setq subject
4088         (cond
4089          ;; Truncate the subject.
4090          (gnus-simplify-subject-functions
4091           (gnus-map-function gnus-simplify-subject-functions subject))
4092          ((numberp gnus-summary-gather-subject-limit)
4093           (setq subject (gnus-simplify-subject-re subject))
4094           (if (> (length subject) gnus-summary-gather-subject-limit)
4095               (substring subject 0 gnus-summary-gather-subject-limit)
4096             subject))
4097          ;; Fuzzily simplify it.
4098          ((eq 'fuzzy gnus-summary-gather-subject-limit)
4099           (gnus-simplify-subject-fuzzy subject))
4100          ;; Just remove the leading "Re:".
4101          (t
4102           (gnus-simplify-subject-re subject))))
4103
4104   (if (and gnus-summary-gather-exclude-subject
4105            (string-match gnus-summary-gather-exclude-subject subject))
4106       nil                         ; This article shouldn't be gathered
4107     subject))
4108
4109 (defun gnus-summary-simplify-subject-query ()
4110   "Query where the respool algorithm would put this article."
4111   (interactive)
4112   (gnus-summary-select-article)
4113   (message "%s" (gnus-general-simplify-subject (gnus-summary-article-subject))))
4114
4115 (defun gnus-gather-threads-by-subject (threads)
4116   "Gather threads by looking at Subject headers."
4117   (if (not gnus-summary-make-false-root)
4118       threads
4119     (let ((hashtb (gnus-make-hashtable 1024))
4120           (prev threads)
4121           (result threads)
4122           subject hthread whole-subject)
4123       (while threads
4124         (setq subject (gnus-general-simplify-subject
4125                        (setq whole-subject (mail-header-subject
4126                                             (caar threads)))))
4127         (when subject
4128           (if (setq hthread (gnus-gethash subject hashtb))
4129               (progn
4130                 ;; We enter a dummy root into the thread, if we
4131                 ;; haven't done that already.
4132                 (unless (stringp (caar hthread))
4133                   (setcar hthread (list whole-subject (car hthread))))
4134                 ;; We add this new gathered thread to this gathered
4135                 ;; thread.
4136                 (setcdr (car hthread)
4137                         (nconc (cdar hthread) (list (car threads))))
4138                 ;; Remove it from the list of threads.
4139                 (setcdr prev (cdr threads))
4140                 (setq threads prev))
4141             ;; Enter this thread into the hash table.
4142             (gnus-sethash subject
4143                           (if gnus-summary-make-false-root-always
4144                               (progn
4145                                 ;; If you want a dummy root above all
4146                                 ;; threads...
4147                                 (setcar threads (list whole-subject
4148                                                       (car threads)))
4149                                 threads)
4150                             threads)
4151                           hashtb)))
4152         (setq prev threads)
4153         (setq threads (cdr threads)))
4154       result)))
4155
4156 (defun gnus-gather-threads-by-references (threads)
4157   "Gather threads by looking at References headers."
4158   (let ((idhashtb (gnus-make-hashtable 1024))
4159         (thhashtb (gnus-make-hashtable 1024))
4160         (prev threads)
4161         (result threads)
4162         ids references id gthread gid entered ref)
4163     (while threads
4164       (when (setq references (mail-header-references (caar threads)))
4165         (setq id (mail-header-id (caar threads))
4166               ids (inline (gnus-split-references references))
4167               entered nil)
4168         (while (setq ref (pop ids))
4169           (setq ids (delete ref ids))
4170           (if (not (setq gid (gnus-gethash ref idhashtb)))
4171               (progn
4172                 (gnus-sethash ref id idhashtb)
4173                 (gnus-sethash id threads thhashtb))
4174             (setq gthread (gnus-gethash gid thhashtb))
4175             (unless entered
4176               ;; We enter a dummy root into the thread, if we
4177               ;; haven't done that already.
4178               (unless (stringp (caar gthread))
4179                 (setcar gthread (list (mail-header-subject (caar gthread))
4180                                       (car gthread))))
4181               ;; We add this new gathered thread to this gathered
4182               ;; thread.
4183               (setcdr (car gthread)
4184                       (nconc (cdar gthread) (list (car threads)))))
4185             ;; Add it into the thread hash table.
4186             (gnus-sethash id gthread thhashtb)
4187             (setq entered t)
4188             ;; Remove it from the list of threads.
4189             (setcdr prev (cdr threads))
4190             (setq threads prev))))
4191       (setq prev threads)
4192       (setq threads (cdr threads)))
4193     result))
4194
4195 (defun gnus-sort-gathered-threads (threads)
4196   "Sort subtreads inside each gathered thread by `gnus-sort-gathered-threads-function'."
4197   (let ((result threads))
4198     (while threads
4199       (when (stringp (caar threads))
4200         (setcdr (car threads)
4201                 (sort (cdar threads) gnus-sort-gathered-threads-function)))
4202       (setq threads (cdr threads)))
4203     result))
4204
4205 (defun gnus-thread-loop-p (root thread)
4206   "Say whether ROOT is in THREAD."
4207   (let ((stack (list thread))
4208         (infloop 0)
4209         th)
4210     (while (setq thread (pop stack))
4211       (setq th (cdr thread))
4212       (while (and th
4213                   (not (eq (caar th) root)))
4214         (pop th))
4215       (if th
4216           ;; We have found a loop.
4217           (let (ref-dep)
4218             (setcdr thread (delq (car th) (cdr thread)))
4219             (if (boundp (setq ref-dep (intern "none"
4220                                               gnus-newsgroup-dependencies)))
4221                 (setcdr (symbol-value ref-dep)
4222                         (nconc (cdr (symbol-value ref-dep))
4223                                (list (car th))))
4224               (set ref-dep (list nil (car th))))
4225             (setq infloop 1
4226                   stack nil))
4227         ;; Push all the subthreads onto the stack.
4228         (push (cdr thread) stack)))
4229     infloop))
4230
4231 (defun gnus-make-threads ()
4232   "Go through the dependency hashtb and find the roots.  Return all threads."
4233   (let (threads)
4234     (while (catch 'infloop
4235              (mapatoms
4236               (lambda (refs)
4237                 ;; Deal with self-referencing References loops.
4238                 (when (and (car (symbol-value refs))
4239                            (not (zerop
4240                                  (apply
4241                                   '+
4242                                   (mapcar
4243                                    (lambda (thread)
4244                                      (gnus-thread-loop-p
4245                                       (car (symbol-value refs)) thread))
4246                                    (cdr (symbol-value refs)))))))
4247                   (setq threads nil)
4248                   (throw 'infloop t))
4249                 (unless (car (symbol-value refs))
4250                   ;; These threads do not refer back to any other
4251                   ;; articles, so they're roots.
4252                   (setq threads (append (cdr (symbol-value refs)) threads))))
4253               gnus-newsgroup-dependencies)))
4254     threads))
4255
4256 ;; Build the thread tree.
4257 (defsubst gnus-dependencies-add-header (header dependencies force-new)
4258   "Enter HEADER into the DEPENDENCIES table if it is not already there.
4259
4260 If FORCE-NEW is not nil, enter HEADER into the DEPENDENCIES table even
4261 if it was already present.
4262
4263 If `gnus-summary-ignore-duplicates' is nil then duplicate Message-IDs
4264 will not be entered in the DEPENDENCIES table.  Otherwise duplicate
4265 Message-IDs will be renamed to a unique Message-ID before being
4266 entered.
4267
4268 Returns HEADER if it was entered in the DEPENDENCIES.  Returns nil otherwise."
4269   (let* ((id (mail-header-id header))
4270          (id-dep (and id (intern id dependencies)))
4271          parent-id ref ref-dep ref-header replaced)
4272     ;; Enter this `header' in the `dependencies' table.
4273     (cond
4274      ((not id-dep)
4275       (setq header nil))
4276      ;; The first two cases do the normal part: enter a new `header'
4277      ;; in the `dependencies' table.
4278      ((not (boundp id-dep))
4279       (set id-dep (list header)))
4280      ((null (car (symbol-value id-dep)))
4281       (setcar (symbol-value id-dep) header))
4282
4283      ;; From here the `header' was already present in the
4284      ;; `dependencies' table.
4285      (force-new
4286       ;; Overrides an existing entry;
4287       ;; just set the header part of the entry.
4288       (setcar (symbol-value id-dep) header)
4289       (setq replaced t))
4290
4291      ;; Renames the existing `header' to a unique Message-ID.
4292      ((not gnus-summary-ignore-duplicates)
4293       ;; An article with this Message-ID has already been seen.
4294       ;; We rename the Message-ID.
4295       (set (setq id-dep (intern (setq id (nnmail-message-id)) dependencies))
4296            (list header))
4297       (mail-header-set-id header id))
4298
4299      ;; The last case ignores an existing entry, except it adds any
4300      ;; additional Xrefs (in case the two articles came from different
4301      ;; servers.
4302      ;; Also sets `header' to `nil' meaning that the `dependencies'
4303      ;; table was *not* modified.
4304      (t
4305       (mail-header-set-xref
4306        (car (symbol-value id-dep))
4307        (concat (or (mail-header-xref (car (symbol-value id-dep)))
4308                    "")
4309                (or (mail-header-xref header) "")))
4310       (setq header nil)))
4311
4312     (when (and header (not replaced))
4313       ;; First check that we are not creating a References loop.
4314       (setq parent-id (gnus-parent-id (mail-header-references header)))
4315       (setq ref parent-id)
4316       (while (and ref
4317                   (setq ref-dep (intern-soft ref dependencies))
4318                   (boundp ref-dep)
4319                   (setq ref-header (car (symbol-value ref-dep))))
4320         (if (string= id ref)
4321             ;; Yuk!  This is a reference loop.  Make the article be a
4322             ;; root article.
4323             (progn
4324               (mail-header-set-references (car (symbol-value id-dep)) "none")
4325               (setq ref nil)
4326               (setq parent-id nil))
4327           (setq ref (gnus-parent-id (mail-header-references ref-header)))))
4328       (setq ref-dep (intern (or parent-id "none") dependencies))
4329       (if (boundp ref-dep)
4330           (setcdr (symbol-value ref-dep)
4331                   (nconc (cdr (symbol-value ref-dep))
4332                          (list (symbol-value id-dep))))
4333         (set ref-dep (list nil (symbol-value id-dep)))))
4334     header))
4335
4336 (defun gnus-extract-message-id-from-in-reply-to (string)
4337   (if (string-match "<[^>]+>" string)
4338       (substring string (match-beginning 0) (match-end 0))
4339     nil))
4340
4341 (defun gnus-build-sparse-threads ()
4342   (let ((headers gnus-newsgroup-headers)
4343         (mail-parse-charset gnus-newsgroup-charset)
4344         (gnus-summary-ignore-duplicates t)
4345         header references generation relations
4346         subject child end new-child date)
4347     ;; First we create an alist of generations/relations, where
4348     ;; generations is how much we trust the relation, and the relation
4349     ;; is parent/child.
4350     (gnus-message 7 "Making sparse threads...")
4351     (save-excursion
4352       (nnheader-set-temp-buffer " *gnus sparse threads*")
4353       (while (setq header (pop headers))
4354         (when (and (setq references (mail-header-references header))
4355                    (not (string= references "")))
4356           (insert references)
4357           (setq child (mail-header-id header)
4358                 subject (mail-header-subject header)
4359                 date (mail-header-date header)
4360                 generation 0)
4361           (while (search-backward ">" nil t)
4362             (setq end (1+ (point)))
4363             (when (search-backward "<" nil t)
4364               (setq new-child (buffer-substring (point) end))
4365               (push (list (incf generation)
4366                           child (setq child new-child)
4367                           subject date)
4368                     relations)))
4369           (when child
4370             (push (list (1+ generation) child nil subject) relations))
4371           (erase-buffer)))
4372       (kill-buffer (current-buffer)))
4373     ;; Sort over trustworthiness.
4374     (dolist (relation (sort relations 'car-less-than-car))
4375       (when (gnus-dependencies-add-header
4376              (make-full-mail-header
4377               gnus-reffed-article-number
4378               (nth 3 relation) "" (or (nth 4 relation) "")
4379               (nth 1 relation)
4380               (or (nth 2 relation) "") 0 0 "")
4381              gnus-newsgroup-dependencies nil)
4382         (push gnus-reffed-article-number gnus-newsgroup-limit)
4383         (push gnus-reffed-article-number gnus-newsgroup-sparse)
4384         (push (cons gnus-reffed-article-number gnus-sparse-mark)
4385               gnus-newsgroup-reads)
4386         (decf gnus-reffed-article-number)))
4387     (gnus-message 7 "Making sparse threads...done")))
4388
4389 (defun gnus-build-old-threads ()
4390   ;; Look at all the articles that refer back to old articles, and
4391   ;; fetch the headers for the articles that aren't there.  This will
4392   ;; build complete threads - if the roots haven't been expired by the
4393   ;; server, that is.
4394   (let ((mail-parse-charset gnus-newsgroup-charset)
4395         id heads)
4396     (mapatoms
4397      (lambda (refs)
4398        (when (not (car (symbol-value refs)))
4399          (setq heads (cdr (symbol-value refs)))
4400          (while heads
4401            (if (memq (mail-header-number (caar heads))
4402                      gnus-newsgroup-dormant)
4403                (setq heads (cdr heads))
4404              (setq id (symbol-name refs))
4405              (while (and (setq id (gnus-build-get-header id))
4406                          (not (car (gnus-id-to-thread id)))))
4407              (setq heads nil)))))
4408      gnus-newsgroup-dependencies)))
4409
4410 (defsubst gnus-remove-odd-characters (string)
4411   "Translate STRING into something that doesn't contain weird characters."
4412   (mm-subst-char-in-string
4413    ?\r ?\-
4414    (mm-subst-char-in-string ?\n ?\- string t) t))
4415
4416 ;; This function has to be called with point after the article number
4417 ;; on the beginning of the line.
4418 (defsubst gnus-nov-parse-line (number dependencies &optional force-new)
4419   (let ((eol (point-at-eol))
4420         (buffer (current-buffer))
4421         header references in-reply-to)
4422
4423     ;; overview: [num subject from date id refs chars lines misc]
4424     (unwind-protect
4425         (let (x)
4426           (narrow-to-region (point) eol)
4427           (unless (eobp)
4428             (forward-char))
4429
4430           (setq header
4431                 (make-full-mail-header
4432                  number                 ; number
4433                  (condition-case ()     ; subject
4434                      (gnus-remove-odd-characters
4435                       (funcall gnus-decode-encoded-word-function
4436                                (setq x (nnheader-nov-field))))
4437                    (error x))
4438                  (condition-case ()     ; from
4439                      (gnus-remove-odd-characters
4440                       (funcall gnus-decode-encoded-address-function
4441                                (setq x (nnheader-nov-field))))
4442                    (error x))
4443                  (nnheader-nov-field)   ; date
4444                  (nnheader-nov-read-message-id number)  ; id
4445                  (setq references (nnheader-nov-field)) ; refs
4446                  (nnheader-nov-read-integer) ; chars
4447                  (nnheader-nov-read-integer) ; lines
4448                  (unless (eobp)
4449                    (if (looking-at "Xref: ")
4450                        (goto-char (match-end 0)))
4451                    (nnheader-nov-field)) ; Xref
4452                  (nnheader-nov-parse-extra)))) ; extra
4453
4454       (widen))
4455
4456     (when (and (string= references "")
4457                (setq in-reply-to (mail-header-extra header))
4458                (setq in-reply-to (cdr (assq 'In-Reply-To in-reply-to))))
4459       (mail-header-set-references
4460        header (gnus-extract-message-id-from-in-reply-to in-reply-to)))
4461
4462     (when gnus-alter-header-function
4463       (funcall gnus-alter-header-function header))
4464     (gnus-dependencies-add-header header dependencies force-new)))
4465
4466 (defun gnus-build-get-header (id)
4467   "Look through the buffer of NOV lines and find the header to ID.
4468 Enter this line into the dependencies hash table, and return
4469 the id of the parent article (if any)."
4470   (let ((deps gnus-newsgroup-dependencies)
4471         found header)
4472     (prog1
4473         (with-current-buffer nntp-server-buffer
4474           (let ((case-fold-search nil))
4475             (goto-char (point-min))
4476             (while (and (not found)
4477                         (search-forward id nil t))
4478               (beginning-of-line)
4479               (setq found (looking-at
4480                            (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s"
4481                                    (regexp-quote id))))
4482               (or found (beginning-of-line 2)))
4483             (when found
4484               (beginning-of-line)
4485               (and
4486                (setq header (gnus-nov-parse-line
4487                              (read (current-buffer)) deps))
4488                (gnus-parent-id (mail-header-references header))))))
4489       (when header
4490         (let ((number (mail-header-number header)))
4491           (push number gnus-newsgroup-limit)
4492           (push header gnus-newsgroup-headers)
4493           (if (memq number gnus-newsgroup-unselected)
4494               (progn
4495                 (setq gnus-newsgroup-unreads
4496                       (gnus-add-to-sorted-list gnus-newsgroup-unreads
4497                                                number))
4498                 (setq gnus-newsgroup-unselected
4499                       (delq number gnus-newsgroup-unselected)))
4500             (push number gnus-newsgroup-ancient)))))))
4501
4502 (defun gnus-build-all-threads ()
4503   "Read all the headers."
4504   (let ((gnus-summary-ignore-duplicates t)
4505         (mail-parse-charset gnus-newsgroup-charset)
4506         (dependencies gnus-newsgroup-dependencies)
4507         header article)
4508     (with-current-buffer nntp-server-buffer
4509       (let ((case-fold-search nil))
4510         (goto-char (point-min))
4511         (while (not (eobp))
4512           (ignore-errors
4513             (setq article (read (current-buffer))
4514                   header (gnus-nov-parse-line article dependencies t)))
4515           (when header
4516             (with-current-buffer gnus-summary-buffer
4517               (push header gnus-newsgroup-headers)
4518               (if (memq (setq article (mail-header-number header))
4519                         gnus-newsgroup-unselected)
4520                   (progn
4521                     (setq gnus-newsgroup-unreads
4522                           (gnus-add-to-sorted-list
4523                            gnus-newsgroup-unreads article))
4524                     (setq gnus-newsgroup-unselected
4525                           (delq article gnus-newsgroup-unselected)))
4526                 (push article gnus-newsgroup-ancient)))
4527             (forward-line 1)))))))
4528
4529 (defun gnus-summary-update-article-line (article header)
4530   "Update the line for ARTICLE using HEADER."
4531   (let* ((id (mail-header-id header))
4532          (thread (gnus-id-to-thread id)))
4533     (unless thread
4534       (error "Article in no thread"))
4535     ;; Update the thread.
4536     (setcar thread header)
4537     (gnus-summary-goto-subject article)
4538     (let* ((datal (gnus-data-find-list article))
4539            (data (car datal))
4540            (inhibit-read-only t)
4541            (level (gnus-summary-thread-level)))
4542       (gnus-delete-line)
4543       (let ((inserted (- (point)
4544                          (progn
4545                            (gnus-summary-insert-line
4546                             header level nil
4547                             (memq article gnus-newsgroup-undownloaded)
4548                             (gnus-article-mark article)
4549                             (memq article gnus-newsgroup-replied)
4550                             (memq article gnus-newsgroup-expirable)
4551                             ;; Only insert the Subject string when it's different
4552                             ;; from the previous Subject string.
4553                             (if (and
4554                                  gnus-show-threads
4555                                  (gnus-subject-equal
4556                                   (condition-case ()
4557                                       (mail-header-subject
4558                                        (gnus-data-header
4559                                         (cadr
4560                                          (gnus-data-find-list
4561                                           article
4562                                           (gnus-data-list t)))))
4563                                     ;; Error on the side of excessive subjects.
4564                                     (error ""))
4565                                   (mail-header-subject header)))
4566                                 ""
4567                               (mail-header-subject header))
4568                             nil (cdr (assq article gnus-newsgroup-scored))
4569                             (memq article gnus-newsgroup-processable))
4570                            (point)))))
4571         (when (cdr datal)
4572           (gnus-data-update-list
4573            (cdr datal)
4574            (- (gnus-data-pos data) (gnus-data-pos (cadr datal)) inserted)))))))
4575
4576 (defun gnus-summary-update-article (article &optional iheader)
4577   "Update ARTICLE in the summary buffer."
4578   (set-buffer gnus-summary-buffer)
4579   (let* ((header (gnus-summary-article-header article))
4580          (id (mail-header-id header))
4581          (data (gnus-data-find article))
4582          (thread (gnus-id-to-thread id))
4583          (references (mail-header-references header))
4584          (parent
4585           (gnus-id-to-thread
4586            (or (gnus-parent-id
4587                 (when (and references
4588                            (not (equal "" references)))
4589                   references))
4590                "none")))
4591          (inhibit-read-only t)
4592          (old (car thread)))
4593     (when thread
4594       (unless iheader
4595         (setcar thread nil)
4596         (when parent
4597           (delq thread parent)))
4598       (if (gnus-summary-insert-subject id header)
4599           ;; Set the (possibly) new article number in the data structure.
4600           (gnus-data-set-number data (gnus-id-to-article id))
4601         (setcar thread old)
4602         nil))))
4603
4604 (defun gnus-rebuild-thread (id &optional line)
4605   "Rebuild the thread containing ID.
4606 If LINE, insert the rebuilt thread starting on line LINE."
4607   (let ((inhibit-read-only t)
4608         old-pos current thread data)
4609     (if (not gnus-show-threads)
4610         (setq thread (list (car (gnus-id-to-thread id))))
4611       ;; Get the thread this article is part of.
4612       (setq thread (gnus-remove-thread id)))
4613     (setq old-pos (point-at-bol))
4614     (setq current (save-excursion
4615                     (and (re-search-backward "[\r\n]" nil t)
4616                          (gnus-summary-article-number))))
4617     ;; If this is a gathered thread, we have to go some re-gathering.
4618     (when (stringp (car thread))
4619       (let ((subject (car thread))
4620             roots thr)
4621         (setq thread (cdr thread))
4622         (while thread
4623           (unless (memq (setq thr (gnus-id-to-thread
4624                                    (gnus-root-id
4625                                     (mail-header-id (caar thread)))))
4626                         roots)
4627             (push thr roots))
4628           (setq thread (cdr thread)))
4629         ;; We now have all (unique) roots.
4630         (if (= (length roots) 1)
4631             ;; All the loose roots are now one solid root.
4632             (setq thread (car roots))
4633           (setq thread (cons subject (gnus-sort-threads roots))))))
4634     (let (threads)
4635       ;; We then insert this thread into the summary buffer.
4636       (when line
4637         (goto-char (point-min))
4638         (forward-line (1- line)))
4639       (let (gnus-newsgroup-data gnus-newsgroup-threads)
4640         (if gnus-show-threads
4641             (gnus-summary-prepare-threads (gnus-cut-threads (list thread)))
4642           (gnus-summary-prepare-unthreaded thread))
4643         (setq data (nreverse gnus-newsgroup-data))
4644         (setq threads gnus-newsgroup-threads))
4645       ;; We splice the new data into the data structure.
4646       ;;!!! This is kinda bogus.  We assume that in LINE is non-nil,
4647       ;;!!! then we want to insert at the beginning of the buffer.
4648       ;;!!! That happens to be true with Gnus now, but that may
4649       ;;!!! change in the future.  Perhaps.
4650       (gnus-data-enter-list
4651        (if line nil current) data (- (point) old-pos))
4652       (setq gnus-newsgroup-threads
4653             (nconc threads gnus-newsgroup-threads))
4654       (gnus-data-compute-positions))))
4655
4656 (defun gnus-number-to-header (number)
4657   "Return the header for article NUMBER."
4658   (let ((headers gnus-newsgroup-headers))
4659     (while (and headers
4660                 (not (= number (mail-header-number (car headers)))))
4661       (pop headers))
4662     (when headers
4663       (car headers))))
4664
4665 (defun gnus-parent-headers (in-headers &optional generation)
4666   "Return the headers of the GENERATIONeth parent of HEADERS."
4667   (unless generation
4668     (setq generation 1))
4669   (let ((parent t)
4670         (headers in-headers)
4671         references)
4672     (while (and parent
4673                 (not (zerop generation))
4674                 (setq references (mail-header-references headers)))
4675       (setq headers (if (and references
4676                              (setq parent (gnus-parent-id references)))
4677                         (car (gnus-id-to-thread parent))
4678                       nil))
4679       (decf generation))
4680     (and (not (eq headers in-headers))
4681          headers)))
4682
4683 (defun gnus-id-to-thread (id)
4684   "Return the (sub-)thread where ID appears."
4685   (gnus-gethash id gnus-newsgroup-dependencies))
4686
4687 (defun gnus-id-to-article (id)
4688   "Return the article number of ID."
4689   (let ((thread (gnus-id-to-thread id)))
4690     (when (and thread
4691                (car thread))
4692       (mail-header-number (car thread)))))
4693
4694 (defun gnus-id-to-header (id)
4695   "Return the article headers of ID."
4696   (car (gnus-id-to-thread id)))
4697
4698 (defun gnus-article-displayed-root-p (article)
4699   "Say whether ARTICLE is a root(ish) article."
4700   (let ((level (gnus-summary-thread-level article))
4701         (refs (mail-header-references  (gnus-summary-article-header article)))
4702         particle)
4703     (cond
4704      ((null level) nil)
4705      ((zerop level) t)
4706      ((null refs) t)
4707      ((null (gnus-parent-id refs)) t)
4708      ((and (= 1 level)
4709            (null (setq particle (gnus-id-to-article
4710                                  (gnus-parent-id refs))))
4711            (null (gnus-summary-thread-level particle)))))))
4712
4713 (defun gnus-root-id (id)
4714   "Return the id of the root of the thread where ID appears."
4715   (let (last-id prev)
4716     (while (and id (setq prev (car (gnus-id-to-thread id))))
4717       (setq last-id id
4718             id (gnus-parent-id (mail-header-references prev))))
4719     last-id))
4720
4721 (defun gnus-articles-in-thread (thread)
4722   "Return the list of articles in THREAD."
4723   (cons (mail-header-number (car thread))
4724         (apply 'nconc (mapcar 'gnus-articles-in-thread (cdr thread)))))
4725
4726 (defun gnus-remove-thread (id &optional dont-remove)
4727   "Remove the thread that has ID in it."
4728   (let (headers thread last-id)
4729     ;; First go up in this thread until we find the root.
4730     (setq last-id (gnus-root-id id)
4731           headers (message-flatten-list (gnus-id-to-thread last-id)))
4732     ;; We have now found the real root of this thread.  It might have
4733     ;; been gathered into some loose thread, so we have to search
4734     ;; through the threads to find the thread we wanted.
4735     (let ((threads gnus-newsgroup-threads)
4736           sub)
4737       (while threads
4738         (setq sub (car threads))
4739         (if (stringp (car sub))
4740             ;; This is a gathered thread, so we look at the roots
4741             ;; below it to find whether this article is in this
4742             ;; gathered root.
4743             (progn
4744               (setq sub (cdr sub))
4745               (while sub
4746                 (when (member (caar sub) headers)
4747                   (setq thread (car threads)
4748                         threads nil
4749                         sub nil))
4750                 (setq sub (cdr sub))))
4751           ;; It's an ordinary thread, so we check it.
4752           (when (eq (car sub) (car headers))
4753             (setq thread sub
4754                   threads nil)))
4755         (setq threads (cdr threads)))
4756       ;; If this article is in no thread, then it's a root.
4757       (if thread
4758           (unless dont-remove
4759             (setq gnus-newsgroup-threads (delq thread gnus-newsgroup-threads)))
4760         (setq thread (gnus-id-to-thread last-id)))
4761       (when thread
4762         (prog1
4763             thread                      ; We return this thread.
4764           (unless dont-remove
4765             (if (stringp (car thread))
4766                 (progn
4767                   ;; If we use dummy roots, then we have to remove the
4768                   ;; dummy root as well.
4769                   (when (eq gnus-summary-make-false-root 'dummy)
4770                     ;; We go to the dummy root by going to
4771                     ;; the first sub-"thread", and then one line up.
4772                     (gnus-summary-goto-article
4773                      (mail-header-number (caadr thread)))
4774                     (forward-line -1)
4775                     (gnus-delete-line)
4776                     (gnus-data-compute-positions))
4777                   (setq thread (cdr thread))
4778                   (while thread
4779                     (gnus-remove-thread-1 (car thread))
4780                     (setq thread (cdr thread))))
4781               (gnus-remove-thread-1 thread))))))))
4782
4783 (defun gnus-remove-thread-1 (thread)
4784   "Remove the thread THREAD recursively."
4785   (let ((number (mail-header-number (pop thread)))
4786         d)
4787     (setq thread (reverse thread))
4788     (while thread
4789       (gnus-remove-thread-1 (pop thread)))
4790     (when (setq d (gnus-data-find number))
4791       (goto-char (gnus-data-pos d))
4792       (gnus-summary-show-thread)
4793       (gnus-data-remove
4794        number
4795        (- (point-at-bol)
4796           (prog1
4797               (1+ (point-at-eol))
4798             (gnus-delete-line)))))))
4799
4800 (defun gnus-sort-threads-recursive (threads func)
4801   (sort (mapcar (lambda (thread)
4802                   (cons (car thread)
4803                         (and (cdr thread)
4804                              (gnus-sort-threads-recursive (cdr thread) func))))
4805                 threads) func))
4806
4807 (defun gnus-sort-threads-loop (threads func)
4808   (let* ((superthread (cons nil threads))
4809          (stack (list (cons superthread threads)))
4810          remaining-threads thread)
4811     (while stack
4812       (setq remaining-threads (cdr (car stack)))
4813       (if remaining-threads
4814           (progn (setq thread (car remaining-threads))
4815                  (setcdr (car stack) (cdr remaining-threads))
4816                  (if (cdr thread)
4817                      (push (cons thread (cdr thread)) stack)))
4818         (setq thread (caar stack))
4819         (setcdr thread (sort (cdr thread) func))
4820         (pop stack)))
4821     (cdr superthread)))
4822
4823 (defun gnus-sort-threads (threads)
4824   "Sort THREADS."
4825   (if (not gnus-thread-sort-functions)
4826       threads
4827     (gnus-message 8 "Sorting threads...")
4828     (prog1
4829         (condition-case nil
4830             (let ((max-lisp-eval-depth (max max-lisp-eval-depth 5000)))
4831               (gnus-sort-threads-recursive
4832                threads (gnus-make-sort-function gnus-thread-sort-functions)))
4833           ;; Even after binding max-lisp-eval-depth, the recursive
4834           ;; sorter might fail for very long threads.  In that case,
4835           ;; try using a (less well-tested) non-recursive sorter.
4836           (error (gnus-message 9 "Sorting threads with loop...")
4837                  (gnus-sort-threads-loop
4838                   threads (gnus-make-sort-function
4839                            gnus-thread-sort-functions))))
4840       (gnus-message 8 "Sorting threads...done"))))
4841
4842 (defun gnus-sort-articles (articles)
4843   "Sort ARTICLES."
4844   (when gnus-article-sort-functions
4845     (gnus-message 7 "Sorting articles...")
4846     (prog1
4847         (setq gnus-newsgroup-headers
4848               (sort articles (gnus-make-sort-function
4849                               gnus-article-sort-functions)))
4850       (gnus-message 7 "Sorting articles...done"))))
4851
4852 ;; Written by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
4853 (defmacro gnus-thread-header (thread)
4854   "Return header of first article in THREAD.
4855 Note that THREAD must never, ever be anything else than a variable -
4856 using some other form will lead to serious barfage."
4857   (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread)))
4858   ;; (8% speedup to gnus-summary-prepare, just for fun :-)
4859   (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207"
4860         (vector thread) 2))
4861
4862 (defsubst gnus-article-sort-by-number (h1 h2)
4863   "Sort articles by article number."
4864   (< (mail-header-number h1)
4865      (mail-header-number h2)))
4866
4867 (defun gnus-thread-sort-by-number (h1 h2)
4868   "Sort threads by root article number."
4869   (gnus-article-sort-by-number
4870    (gnus-thread-header h1) (gnus-thread-header h2)))
4871
4872 (defsubst gnus-article-sort-by-random (h1 h2)
4873   "Sort articles randomly."
4874   (zerop (random 2)))
4875
4876 (defun gnus-thread-sort-by-random (h1 h2)
4877   "Sort threads randomly."
4878   (gnus-article-sort-by-random
4879    (gnus-thread-header h1) (gnus-thread-header h2)))
4880
4881 (defsubst gnus-article-sort-by-lines (h1 h2)
4882   "Sort articles by article Lines header."
4883   (< (mail-header-lines h1)
4884      (mail-header-lines h2)))
4885
4886 (defun gnus-thread-sort-by-lines (h1 h2)
4887   "Sort threads by root article Lines header."
4888   (gnus-article-sort-by-lines
4889    (gnus-thread-header h1) (gnus-thread-header h2)))
4890
4891 (defsubst gnus-article-sort-by-chars (h1 h2)
4892   "Sort articles by octet length."
4893   (< (mail-header-chars h1)
4894      (mail-header-chars h2)))
4895
4896 (defun gnus-thread-sort-by-chars (h1 h2)
4897   "Sort threads by root article octet length."
4898   (gnus-article-sort-by-chars
4899    (gnus-thread-header h1) (gnus-thread-header h2)))
4900
4901 (defsubst gnus-article-sort-by-author (h1 h2)
4902   "Sort articles by root author."
4903   (gnus-string<
4904    (let ((extract (funcall
4905                    gnus-extract-address-components
4906                    (mail-header-from h1))))
4907      (or (car extract) (cadr extract) ""))
4908    (let ((extract (funcall
4909                    gnus-extract-address-components
4910                    (mail-header-from h2))))
4911      (or (car extract) (cadr extract) ""))))
4912
4913 (defun gnus-thread-sort-by-author (h1 h2)
4914   "Sort threads by root author."
4915   (gnus-article-sort-by-author
4916    (gnus-thread-header h1)  (gnus-thread-header h2)))
4917
4918 (defsubst gnus-article-sort-by-recipient (h1 h2)
4919   "Sort articles by recipient."
4920   (gnus-string<
4921    (let ((extract (funcall
4922                    gnus-extract-address-components
4923                    (or (cdr (assq 'To (mail-header-extra h1))) ""))))
4924      (or (car extract) (cadr extract)))
4925    (let ((extract (funcall
4926                    gnus-extract-address-components
4927                    (or (cdr (assq 'To (mail-header-extra h2))) ""))))
4928      (or (car extract) (cadr extract)))))
4929
4930 (defun gnus-thread-sort-by-recipient (h1 h2)
4931   "Sort threads by root recipient."
4932   (gnus-article-sort-by-recipient
4933    (gnus-thread-header h1) (gnus-thread-header h2)))
4934
4935 (defsubst gnus-article-sort-by-subject (h1 h2)
4936   "Sort articles by root subject."
4937   (gnus-string<
4938    (downcase (gnus-simplify-subject-re (mail-header-subject h1)))
4939    (downcase (gnus-simplify-subject-re (mail-header-subject h2)))))
4940
4941 (defun gnus-thread-sort-by-subject (h1 h2)
4942   "Sort threads by root subject."
4943   (gnus-article-sort-by-subject
4944    (gnus-thread-header h1) (gnus-thread-header h2)))
4945
4946 (defsubst gnus-article-sort-by-date (h1 h2)
4947   "Sort articles by root article date."
4948   (time-less-p
4949    (gnus-date-get-time (mail-header-date h1))
4950    (gnus-date-get-time (mail-header-date h2))))
4951
4952 (defun gnus-thread-sort-by-date (h1 h2)
4953   "Sort threads by root article date."
4954   (gnus-article-sort-by-date
4955    (gnus-thread-header h1) (gnus-thread-header h2)))
4956
4957 (defsubst gnus-article-sort-by-score (h1 h2)
4958   "Sort articles by root article score.
4959 Unscored articles will be counted as having a score of zero."
4960   (> (or (cdr (assq (mail-header-number h1)
4961                     gnus-newsgroup-scored))
4962          gnus-summary-default-score 0)
4963      (or (cdr (assq (mail-header-number h2)
4964                     gnus-newsgroup-scored))
4965          gnus-summary-default-score 0)))
4966
4967 (defun gnus-thread-sort-by-score (h1 h2)
4968   "Sort threads by root article score."
4969   (gnus-article-sort-by-score
4970    (gnus-thread-header h1) (gnus-thread-header h2)))
4971
4972 (defun gnus-thread-sort-by-total-score (h1 h2)
4973   "Sort threads by the sum of all scores in the thread.
4974 Unscored articles will be counted as having a score of zero."
4975   (> (gnus-thread-total-score h1) (gnus-thread-total-score h2)))
4976
4977 (defun gnus-thread-total-score (thread)
4978   ;; This function find the total score of THREAD.
4979   (cond
4980    ((null thread)
4981     0)
4982    ((consp thread)
4983     (if (stringp (car thread))
4984         (apply gnus-thread-score-function 0
4985                (mapcar 'gnus-thread-total-score-1 (cdr thread)))
4986       (gnus-thread-total-score-1 thread)))
4987    (t
4988     (gnus-thread-total-score-1 (list thread)))))
4989
4990 (defun gnus-article-sort-by-most-recent-number (h1 h2)
4991   "Sort articles by number."
4992   (gnus-article-sort-by-number h1 h2))
4993
4994 (defun gnus-thread-sort-by-most-recent-number (h1 h2)
4995   "Sort threads such that the thread with the most recently arrived article comes first."
4996   (> (gnus-thread-highest-number h1) (gnus-thread-highest-number h2)))
4997
4998 (defun gnus-thread-highest-number (thread)
4999   "Return the highest article number in THREAD."
5000   (apply 'max (mapcar (lambda (header)
5001                         (mail-header-number header))
5002                       (message-flatten-list thread))))
5003
5004 (defun gnus-article-sort-by-most-recent-date (h1 h2)
5005   "Sort articles by number."
5006   (gnus-article-sort-by-date h1 h2))
5007
5008 (defun gnus-thread-sort-by-most-recent-date (h1 h2)
5009   "Sort threads such that the thread with the most recently dated article comes first."
5010   (> (gnus-thread-latest-date h1) (gnus-thread-latest-date h2)))
5011
5012 ; Since this is called not only to sort the top-level threads, but
5013 ; also in recursive sorts to order the articles within a thread, each
5014 ; article will be processed many times.  Thus it speeds things up
5015 ; quite a bit to use gnus-date-get-time, which caches the time value.
5016 (defun gnus-thread-latest-date (thread)
5017   "Return the highest article date in THREAD."
5018   (apply 'max
5019          (mapcar (lambda (header) (gnus-float-time
5020                                    (gnus-date-get-time
5021                                     (mail-header-date header))))
5022                  (message-flatten-list thread))))
5023
5024 (defun gnus-thread-total-score-1 (root)
5025   ;; This function find the total score of the thread below ROOT.
5026   (setq root (car root))
5027   (apply gnus-thread-score-function
5028          (or (append
5029               (mapcar 'gnus-thread-total-score
5030                       (cdr (gnus-id-to-thread (mail-header-id root))))
5031               (when (> (mail-header-number root) 0)
5032                 (list (or (cdr (assq (mail-header-number root)
5033                                      gnus-newsgroup-scored))
5034                           gnus-summary-default-score 0))))
5035              (list gnus-summary-default-score)
5036              '(0))))
5037
5038 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
5039 (defvar gnus-tmp-prev-subject nil)
5040 (defvar gnus-tmp-false-parent nil)
5041 (defvar gnus-tmp-root-expunged nil)
5042 (defvar gnus-tmp-dummy-line nil)
5043
5044 (defun gnus-extra-header (type &optional header)
5045   "Return the extra header of TYPE."
5046   (or (cdr (assq type (mail-header-extra (or header gnus-tmp-header))))
5047       ""))
5048
5049 (defvar gnus-tmp-thread-tree-header-string "")
5050
5051 (defcustom gnus-sum-thread-tree-root "> "
5052   "With %B spec, used for the root of a thread.
5053 If nil, use subject instead."
5054   :version "22.1"
5055   :type '(radio (const :format "%v  " nil) string)
5056   :group 'gnus-thread)
5057
5058 (defcustom gnus-sum-thread-tree-false-root "> "
5059   "With %B spec, used for a false root of a thread.
5060 If nil, use subject instead."
5061   :version "22.1"
5062   :type '(radio (const :format "%v  " nil) string)
5063   :group 'gnus-thread)
5064
5065 (defcustom gnus-sum-thread-tree-single-indent ""
5066   "With %B spec, used for a thread with just one message.
5067 If nil, use subject instead."
5068   :version "22.1"
5069   :type '(radio (const :format "%v  " nil) string)
5070   :group 'gnus-thread)
5071
5072 (defcustom gnus-sum-thread-tree-vertical "| "
5073   "With %B spec, used for drawing a vertical line."
5074   :version "22.1"
5075   :type 'string
5076   :group 'gnus-thread)
5077
5078 (defcustom gnus-sum-thread-tree-indent "  "
5079   "With %B spec, used for indenting."
5080   :version "22.1"
5081   :type 'string
5082   :group 'gnus-thread)
5083
5084 (defcustom gnus-sum-thread-tree-leaf-with-other "+-> "
5085   "With %B spec, used for a leaf with brothers."
5086   :version "22.1"
5087   :type 'string
5088   :group 'gnus-thread)
5089
5090 (defcustom gnus-sum-thread-tree-single-leaf "\\-> "
5091   "With %B spec, used for a leaf without brothers."
5092   :version "22.1"
5093   :type 'string
5094   :group 'gnus-thread)
5095
5096 (defcustom gnus-summary-display-while-building nil
5097   "If non-nil, show and update the summary buffer as it's being built.
5098 If the value is t, update the buffer after every line is inserted.  If
5099 the value is an integer (N), update the display every N lines."
5100   :version "22.1"
5101   :group 'gnus-thread
5102   :type '(choice (const :tag "off" nil)
5103                  number
5104                  (const :tag "frequently" t)))
5105
5106 (defun gnus-summary-prepare-threads (threads)
5107   "Prepare summary buffer from THREADS and indentation LEVEL.
5108 THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])'
5109 or a straight list of headers."
5110   (gnus-message 7 "Generating summary...")
5111
5112   (setq gnus-newsgroup-threads threads)
5113   (beginning-of-line)
5114
5115   (let ((gnus-tmp-level 0)
5116         (default-score (or gnus-summary-default-score 0))
5117         (gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight))
5118         (building-line-count gnus-summary-display-while-building)
5119         (building-count (integerp gnus-summary-display-while-building))
5120         thread number subject stack state gnus-tmp-gathered beg-match
5121         new-roots gnus-tmp-new-adopts thread-end simp-subject
5122         gnus-tmp-header gnus-tmp-unread gnus-tmp-downloaded
5123         gnus-tmp-replied gnus-tmp-subject-or-nil
5124         gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score
5125         gnus-tmp-score-char gnus-tmp-from gnus-tmp-name
5126         gnus-tmp-number gnus-tmp-opening-bracket gnus-tmp-closing-bracket
5127         tree-stack)
5128
5129     (setq gnus-tmp-prev-subject nil
5130           gnus-tmp-thread-tree-header-string "")
5131
5132     (if (vectorp (car threads))
5133         ;; If this is a straight (sic) list of headers, then a
5134         ;; threaded summary display isn't required, so we just create
5135         ;; an unthreaded one.
5136         (gnus-summary-prepare-unthreaded threads)
5137
5138       ;; Do the threaded display.
5139
5140       (if gnus-summary-display-while-building
5141           (switch-to-buffer (buffer-name)))
5142       (while (or threads stack gnus-tmp-new-adopts new-roots)
5143
5144         (if (and (= gnus-tmp-level 0)
5145                  (or (not stack)
5146                      (= (caar stack) 0))
5147                  (not gnus-tmp-false-parent)
5148                  (or gnus-tmp-new-adopts new-roots))
5149             (if gnus-tmp-new-adopts
5150                 (setq gnus-tmp-level (if gnus-tmp-root-expunged 0 1)
5151                       thread (list (car gnus-tmp-new-adopts))
5152                       gnus-tmp-header (caar thread)
5153                       gnus-tmp-new-adopts (cdr gnus-tmp-new-adopts))
5154               (when new-roots
5155                 (setq thread (list (car new-roots))
5156                       gnus-tmp-header (caar thread)
5157                       new-roots (cdr new-roots))))
5158
5159           (if threads
5160               ;; If there are some threads, we do them before the
5161               ;; threads on the stack.
5162               (setq thread threads
5163                     gnus-tmp-header (caar thread))
5164             ;; There were no current threads, so we pop something off
5165             ;; the stack.
5166             (setq state (car stack)
5167                   gnus-tmp-level (car state)
5168                   tree-stack (cadr state)
5169                   thread (caddr state)
5170                   stack (cdr stack)
5171                   gnus-tmp-header (caar thread))))
5172
5173         (setq gnus-tmp-false-parent nil)
5174         (setq gnus-tmp-root-expunged nil)
5175         (setq thread-end nil)
5176
5177         (if (stringp gnus-tmp-header)
5178             ;; The header is a dummy root.
5179             (cond
5180              ((eq gnus-summary-make-false-root 'adopt)
5181               ;; We let the first article adopt the rest.
5182               (setq gnus-tmp-new-adopts (nconc gnus-tmp-new-adopts
5183                                                (cddar thread)))
5184               (setq gnus-tmp-gathered
5185                     (nconc (mapcar
5186                             (lambda (h) (mail-header-number (car h)))
5187                             (cddar thread))
5188                            gnus-tmp-gathered))
5189               (setq thread (cons (list (caar thread)
5190                                        (cadar thread))
5191                                  (cdr thread)))
5192               (setq gnus-tmp-level -1
5193                     gnus-tmp-false-parent t))
5194              ((eq gnus-summary-make-false-root 'empty)
5195               ;; We print adopted articles with empty subject fields.
5196               (setq gnus-tmp-gathered
5197                     (nconc (mapcar
5198                             (lambda (h) (mail-header-number (car h)))
5199                             (cddar thread))
5200                            gnus-tmp-gathered))
5201               (setq gnus-tmp-level -1))
5202              ((eq gnus-summary-make-false-root 'dummy)
5203               ;; We remember that we probably want to output a dummy
5204               ;; root.
5205               (setq gnus-tmp-dummy-line gnus-tmp-header)
5206               (setq gnus-tmp-prev-subject gnus-tmp-header))
5207              (t
5208               ;; We do not make a root for the gathered
5209               ;; sub-threads at all.
5210               (setq gnus-tmp-level -1)))
5211
5212           (setq number (mail-header-number gnus-tmp-header)
5213                 subject (mail-header-subject gnus-tmp-header)
5214                 simp-subject (gnus-simplify-subject-fully subject))
5215
5216           (cond
5217            ;; If the thread has changed subject, we might want to make
5218            ;; this subthread into a root.
5219            ((and (null gnus-thread-ignore-subject)
5220                  (not (zerop gnus-tmp-level))
5221                  gnus-tmp-prev-subject
5222                  (not (string= gnus-tmp-prev-subject simp-subject)))
5223             (setq new-roots (nconc new-roots (list (car thread)))
5224                   thread-end t
5225                   gnus-tmp-header nil))
5226            ;; If the article lies outside the current limit,
5227            ;; then we do not display it.
5228            ((not (memq number gnus-newsgroup-limit))
5229             (setq gnus-tmp-gathered
5230                   (nconc (mapcar
5231                           (lambda (h) (mail-header-number (car h)))
5232                           (cdar thread))
5233                          gnus-tmp-gathered))
5234             (setq gnus-tmp-new-adopts (if (cdar thread)
5235                                           (append gnus-tmp-new-adopts
5236                                                   (cdar thread))
5237                                         gnus-tmp-new-adopts)
5238                   thread-end t
5239                   gnus-tmp-header nil)
5240             (when (zerop gnus-tmp-level)
5241               (setq gnus-tmp-root-expunged t)))
5242            ;; Perhaps this article is to be marked as read?
5243            ((and gnus-summary-mark-below
5244                  (< (or (cdr (assq number gnus-newsgroup-scored))
5245                         default-score)
5246                     gnus-summary-mark-below)
5247                  ;; Don't touch sparse articles.
5248                  (not (gnus-summary-article-sparse-p number))
5249                  (not (gnus-summary-article-ancient-p number)))
5250             (setq gnus-newsgroup-unreads
5251                   (delq number gnus-newsgroup-unreads))
5252             (if gnus-newsgroup-auto-expire
5253                 (setq gnus-newsgroup-expirable
5254                       (gnus-add-to-sorted-list
5255                        gnus-newsgroup-expirable number))
5256               (push (cons number gnus-low-score-mark)
5257                     gnus-newsgroup-reads))))
5258
5259           (when gnus-tmp-header
5260             ;; We may have an old dummy line to output before this
5261             ;; article.
5262             (when (and gnus-tmp-dummy-line
5263                        (gnus-subject-equal
5264                         gnus-tmp-dummy-line
5265                         (mail-header-subject gnus-tmp-header)))
5266               (gnus-summary-insert-dummy-line
5267                gnus-tmp-dummy-line (mail-header-number gnus-tmp-header))
5268               (setq gnus-tmp-dummy-line nil))
5269
5270             ;; Compute the mark.
5271             (setq gnus-tmp-unread (gnus-article-mark number))
5272
5273             (push (gnus-data-make number gnus-tmp-unread (1+ (point))
5274                                   gnus-tmp-header gnus-tmp-level)
5275                   gnus-newsgroup-data)
5276
5277             ;; Actually insert the line.
5278             (setq
5279              gnus-tmp-subject-or-nil
5280              (cond
5281               ((and gnus-thread-ignore-subject
5282                     gnus-tmp-prev-subject
5283                     (not (string= gnus-tmp-prev-subject simp-subject)))
5284                subject)
5285               ((zerop gnus-tmp-level)
5286                (if (and (eq gnus-summary-make-false-root 'empty)
5287                         (memq number gnus-tmp-gathered)
5288                         gnus-tmp-prev-subject
5289                         (string= gnus-tmp-prev-subject simp-subject))
5290                    gnus-summary-same-subject
5291                  subject))
5292               (t gnus-summary-same-subject)))
5293             (if (and (eq gnus-summary-make-false-root 'adopt)
5294                      (= gnus-tmp-level 1)
5295                      (memq number gnus-tmp-gathered))
5296                 (setq gnus-tmp-opening-bracket ?\<
5297                       gnus-tmp-closing-bracket ?\>)
5298               (setq gnus-tmp-opening-bracket ?\[
5299                     gnus-tmp-closing-bracket ?\]))
5300             (if (>= gnus-tmp-level (length gnus-thread-indent-array))
5301                 (gnus-make-thread-indent-array
5302                  (max (* 2 (length gnus-thread-indent-array))
5303                       gnus-tmp-level)))
5304             (setq
5305              gnus-tmp-indentation
5306              (aref gnus-thread-indent-array gnus-tmp-level)
5307              gnus-tmp-lines (mail-header-lines gnus-tmp-header)
5308              gnus-tmp-score (or (cdr (assq number gnus-newsgroup-scored))
5309                                 gnus-summary-default-score 0)
5310              gnus-tmp-score-char
5311              (if (or (null gnus-summary-default-score)
5312                      (<= (abs (- gnus-tmp-score gnus-summary-default-score))
5313                          gnus-summary-zcore-fuzz))
5314                  ?                      ;Whitespace
5315                (if (< gnus-tmp-score gnus-summary-default-score)
5316                    gnus-score-below-mark gnus-score-over-mark))
5317              gnus-tmp-replied
5318              (cond ((memq number gnus-newsgroup-processable)
5319                     gnus-process-mark)
5320                    ((memq number gnus-newsgroup-cached)
5321                     gnus-cached-mark)
5322                    ((memq number gnus-newsgroup-replied)
5323                     gnus-replied-mark)
5324                    ((memq number gnus-newsgroup-forwarded)
5325                     gnus-forwarded-mark)
5326                    ((memq number gnus-newsgroup-saved)
5327                     gnus-saved-mark)
5328                    ((memq number gnus-newsgroup-recent)
5329                     gnus-recent-mark)
5330                    ((memq number gnus-newsgroup-unseen)
5331                     gnus-unseen-mark)
5332                    (t gnus-no-mark))
5333              gnus-tmp-downloaded
5334              (cond ((memq number gnus-newsgroup-undownloaded)
5335                     gnus-undownloaded-mark)
5336                    (gnus-newsgroup-agentized
5337                     gnus-downloaded-mark)
5338                    (t
5339                     gnus-no-mark))
5340              gnus-tmp-from (mail-header-from gnus-tmp-header)
5341              gnus-tmp-name
5342              (cond
5343               ((string-match "<[^>]+> *$" gnus-tmp-from)
5344                (setq beg-match (match-beginning 0))
5345                (or (and (string-match "^\".+\"" gnus-tmp-from)
5346                         (substring gnus-tmp-from 1 (1- (match-end 0))))
5347                    (substring gnus-tmp-from 0 beg-match)))
5348               ((string-match "(.+)" gnus-tmp-from)
5349                (substring gnus-tmp-from
5350                           (1+ (match-beginning 0)) (1- (match-end 0))))
5351               (t gnus-tmp-from))
5352
5353              ;; Do the %B string
5354              gnus-tmp-thread-tree-header-string
5355              (cond
5356               ((not gnus-show-threads) "")
5357               ((zerop gnus-tmp-level)
5358                (cond ((cdar thread)
5359                       (or gnus-sum-thread-tree-root subject))
5360                      (gnus-tmp-new-adopts
5361                       (or gnus-sum-thread-tree-false-root subject))
5362                      (t
5363                       (or gnus-sum-thread-tree-single-indent subject))))
5364               (t
5365                (concat (apply 'concat
5366                               (mapcar (lambda (item)
5367                                         (if (= item 1)
5368                                             gnus-sum-thread-tree-vertical
5369                                           gnus-sum-thread-tree-indent))
5370                                       (cdr (reverse tree-stack))))
5371                        (if (nth 1 thread)
5372                            gnus-sum-thread-tree-leaf-with-other
5373                          gnus-sum-thread-tree-single-leaf)))))
5374             (when (string= gnus-tmp-name "")
5375               (setq gnus-tmp-name gnus-tmp-from))
5376             (unless (numberp gnus-tmp-lines)
5377               (setq gnus-tmp-lines -1))
5378             (if (= gnus-tmp-lines -1)
5379                 (setq gnus-tmp-lines "?")
5380               (setq gnus-tmp-lines (number-to-string gnus-tmp-lines)))
5381             (gnus-put-text-property
5382              (point)
5383              (progn (eval gnus-summary-line-format-spec) (point))
5384              'gnus-number number)
5385             (when gnus-visual-p
5386               (forward-line -1)
5387               (gnus-summary-highlight-line)
5388               (when gnus-summary-update-hook
5389                 (gnus-run-hooks 'gnus-summary-update-hook))
5390               (forward-line 1))
5391
5392             (setq gnus-tmp-prev-subject simp-subject)))
5393
5394         (when (nth 1 thread)
5395           (push (list (max 0 gnus-tmp-level)
5396                       (copy-sequence tree-stack)
5397                       (nthcdr 1 thread))
5398                 stack))
5399         (push (if (nth 1 thread) 1 0) tree-stack)
5400         (incf gnus-tmp-level)
5401         (setq threads (if thread-end nil (cdar thread)))
5402         (if gnus-summary-display-while-building
5403             (if building-count
5404                 (progn
5405                   ;; use a set frequency
5406                   (setq building-line-count (1- building-line-count))
5407                   (when (= building-line-count 0)
5408                     (sit-for 0)
5409                     (setq building-line-count
5410                           gnus-summary-display-while-building)))
5411               ;; always
5412               (sit-for 0)))
5413         (unless threads
5414           (setq gnus-tmp-level 0)))))
5415   (gnus-message 7 "Generating summary...done"))
5416
5417 (defun gnus-summary-prepare-unthreaded (headers)
5418   "Generate an unthreaded summary buffer based on HEADERS."
5419   (let (header number mark)
5420
5421     (beginning-of-line)
5422
5423     (while headers
5424       ;; We may have to root out some bad articles...
5425       (when (memq (setq number (mail-header-number
5426                                 (setq header (pop headers))))
5427                   gnus-newsgroup-limit)
5428         ;; Mark article as read when it has a low score.
5429         (when (and gnus-summary-mark-below
5430                    (< (or (cdr (assq number gnus-newsgroup-scored))
5431                           gnus-summary-default-score 0)
5432                       gnus-summary-mark-below)
5433                    (not (gnus-summary-article-ancient-p number)))
5434           (setq gnus-newsgroup-unreads
5435                 (delq number gnus-newsgroup-unreads))
5436           (if gnus-newsgroup-auto-expire
5437               (push number gnus-newsgroup-expirable)
5438             (push (cons number gnus-low-score-mark)
5439                   gnus-newsgroup-reads)))
5440
5441         (setq mark (gnus-article-mark number))
5442         (push (gnus-data-make number mark (1+ (point)) header 0)
5443               gnus-newsgroup-data)
5444         (gnus-summary-insert-line
5445          header 0 number
5446          (memq number gnus-newsgroup-undownloaded)
5447          mark (memq number gnus-newsgroup-replied)
5448          (memq number gnus-newsgroup-expirable)
5449          (mail-header-subject header) nil
5450          (cdr (assq number gnus-newsgroup-scored))
5451          (memq number gnus-newsgroup-processable))))))
5452
5453 (defun gnus-summary-remove-list-identifiers ()
5454   "Remove list identifiers in `gnus-list-identifiers' from articles in the current group."
5455   (let ((regexp (if (consp gnus-list-identifiers)
5456                     (mapconcat 'identity gnus-list-identifiers " *\\|")
5457                   gnus-list-identifiers))
5458         changed subject)
5459     (when regexp
5460       (setq regexp (concat "^\\(?:R[Ee]: +\\)*\\(" regexp " *\\)"))
5461       (dolist (header gnus-newsgroup-headers)
5462         (setq subject (mail-header-subject header)
5463               changed nil)
5464         (while (string-match regexp subject)
5465           (setq subject
5466                 (concat (substring subject 0 (match-beginning 1))
5467                         (substring subject (match-end 0)))
5468                 changed t))
5469         (when changed
5470           (when (string-match "^\\(\\(?:R[Ee]: +\\)+\\)R[Ee]: +" subject)
5471             (setq subject
5472                   (concat (substring subject 0 (match-beginning 1))
5473                           (substring subject (match-end 1)))))
5474           (mail-header-set-subject header subject))))))
5475
5476 (defun gnus-fetch-headers (articles &optional limit force-new dependencies)
5477   "Fetch headers of ARTICLES."
5478   (let ((name (gnus-group-decoded-name gnus-newsgroup-name)))
5479     (gnus-message 5 "Fetching headers for %s..." name)
5480     (prog1
5481         (if (eq 'nov
5482                 (setq gnus-headers-retrieved-by
5483                       (gnus-retrieve-headers
5484                        articles gnus-newsgroup-name
5485                        (or limit
5486                            ;; We might want to fetch old headers, but
5487                            ;; not if there is only 1 article.
5488                            (and (or (and
5489                                      (not (eq gnus-fetch-old-headers 'some))
5490                                      (not (numberp gnus-fetch-old-headers)))
5491                                     (> (length articles) 1))
5492                                 gnus-fetch-old-headers)))))
5493             (gnus-get-newsgroup-headers-xover
5494              articles force-new dependencies gnus-newsgroup-name t)
5495           (gnus-get-newsgroup-headers dependencies force-new))
5496       (gnus-message 5 "Fetching headers for %s...done" name))))
5497
5498 (defun gnus-select-newsgroup (group &optional read-all select-articles)
5499   "Select newsgroup GROUP.
5500 If READ-ALL is non-nil, all articles in the group are selected.
5501 If SELECT-ARTICLES, only select those articles from GROUP."
5502   (let* ((entry (gnus-group-entry group))
5503          ;;!!! Dirty hack; should be removed.
5504          (gnus-summary-ignore-duplicates
5505           (if (eq (car (gnus-find-method-for-group group)) 'nnvirtual)
5506               t
5507             gnus-summary-ignore-duplicates))
5508          (info (nth 2 entry))
5509          charset articles fetched-articles cached)
5510
5511     (unless (gnus-check-server
5512              (set (make-local-variable 'gnus-current-select-method)
5513                   (gnus-find-method-for-group group)))
5514       (error "Couldn't open server"))
5515     (setq charset (gnus-group-name-charset gnus-current-select-method group))
5516
5517     (or (and entry (not (eq (car entry) t))) ; Either it's active...
5518         (gnus-activate-group group)     ; Or we can activate it...
5519         (progn                          ; Or we bug out.
5520           (when (equal major-mode 'gnus-summary-mode)
5521             (gnus-kill-buffer (current-buffer)))
5522           (error
5523            "Couldn't activate group %s: %s"
5524            (mm-decode-coding-string group charset)
5525            (mm-decode-coding-string (gnus-status-message group) charset))))
5526
5527     (unless (gnus-request-group group t)
5528       (when (equal major-mode 'gnus-summary-mode)
5529         (gnus-kill-buffer (current-buffer)))
5530       (error "Couldn't request group %s: %s"
5531              (mm-decode-coding-string group charset)
5532              (mm-decode-coding-string (gnus-status-message group) charset)))
5533
5534     (when gnus-agent
5535       (gnus-agent-possibly-alter-active group (gnus-active group) info)
5536
5537       (setq gnus-summary-use-undownloaded-faces
5538             (gnus-agent-find-parameter
5539              group
5540              'agent-enable-undownloaded-faces)))
5541
5542     (setq gnus-newsgroup-name group
5543           gnus-newsgroup-unselected nil
5544           gnus-newsgroup-unreads (gnus-list-of-unread-articles group))
5545
5546     (let ((display (gnus-group-find-parameter group 'display)))
5547       (setq gnus-newsgroup-display
5548             (cond
5549              ((not (zerop (or (car-safe read-all) 0)))
5550               ;; The user entered the group with C-u SPC/RET, let's show
5551               ;; all articles.
5552               'gnus-not-ignore)
5553              ((eq display 'all)
5554               'gnus-not-ignore)
5555              ((arrayp display)
5556               (gnus-summary-display-make-predicate (mapcar 'identity display)))
5557              ((numberp display)
5558               ;; The following is probably the "correct" solution, but
5559               ;; it makes Gnus fetch all headers and then limit the
5560               ;; articles (which is slow), so instead we hack the
5561               ;; select-articles parameter instead. -- Simon Josefsson
5562               ;; <jas@kth.se>
5563               ;;
5564               ;; (gnus-byte-compile
5565               ;;  `(lambda () (> number ,(- (cdr (gnus-active group))
5566               ;;                         display)))))
5567               (setq select-articles
5568                     (gnus-uncompress-range
5569                      (cons (let ((tmp (- (cdr (gnus-active group)) display)))
5570                              (if (> tmp 0)
5571                                  tmp
5572                                1))
5573                            (cdr (gnus-active group)))))
5574               nil)
5575              (t
5576               nil))))
5577
5578     (gnus-summary-setup-default-charset)
5579
5580     ;; Kludge to avoid having cached articles nixed out in virtual groups.
5581     (when (gnus-virtual-group-p group)
5582       (setq cached gnus-newsgroup-cached))
5583
5584     (setq gnus-newsgroup-unreads
5585           (gnus-sorted-ndifference
5586            (gnus-sorted-ndifference gnus-newsgroup-unreads
5587                                     gnus-newsgroup-marked)
5588            gnus-newsgroup-dormant))
5589
5590     (setq gnus-newsgroup-processable nil)
5591
5592     (gnus-update-read-articles group gnus-newsgroup-unreads)
5593
5594     ;; Adjust and set lists of article marks.
5595     (when info
5596       (gnus-adjust-marked-articles info))
5597     (if (setq articles select-articles)
5598         (setq gnus-newsgroup-unselected
5599               (gnus-sorted-difference gnus-newsgroup-unreads articles))
5600       (setq articles (gnus-articles-to-read group read-all)))
5601
5602     (cond
5603      ((null articles)
5604       ;;(gnus-message 3 "Couldn't select newsgroup -- no articles to display")
5605       'quit)
5606      ((eq articles 0) nil)
5607      (t
5608       ;; Init the dependencies hash table.
5609       (setq gnus-newsgroup-dependencies
5610             (gnus-make-hashtable (length articles)))
5611       (gnus-set-global-variables)
5612       ;; Retrieve the headers and read them in.
5613
5614       (setq gnus-newsgroup-headers (gnus-fetch-headers articles))
5615
5616       ;; Kludge to avoid having cached articles nixed out in virtual groups.
5617       (when cached
5618         (setq gnus-newsgroup-cached cached))
5619
5620       ;; Suppress duplicates?
5621       (when gnus-suppress-duplicates
5622         (gnus-dup-suppress-articles))
5623
5624       ;; Set the initial limit.
5625       (setq gnus-newsgroup-limit (copy-sequence articles))
5626       ;; Remove canceled articles from the list of unread articles.
5627       (setq fetched-articles
5628             (mapcar (lambda (headers) (mail-header-number headers))
5629                     gnus-newsgroup-headers))
5630       (setq gnus-newsgroup-articles fetched-articles)
5631       (setq gnus-newsgroup-unreads
5632             (gnus-sorted-nintersection
5633              gnus-newsgroup-unreads fetched-articles))
5634       (gnus-compute-unseen-list)
5635
5636       ;; Removed marked articles that do not exist.
5637       (gnus-update-missing-marks
5638        (gnus-sorted-difference articles fetched-articles))
5639       ;; We might want to build some more threads first.
5640       (when (and gnus-fetch-old-headers
5641                  (eq gnus-headers-retrieved-by 'nov))
5642         (if (eq gnus-fetch-old-headers 'invisible)
5643             (gnus-build-all-threads)
5644           (gnus-build-old-threads)))
5645       ;; Let the Gnus agent mark articles as read.
5646       (when gnus-agent
5647         (gnus-agent-get-undownloaded-list))
5648       ;; Remove list identifiers from subject
5649       (when gnus-list-identifiers
5650         (gnus-summary-remove-list-identifiers))
5651       ;; Check whether auto-expire is to be done in this group.
5652       (setq gnus-newsgroup-auto-expire
5653             (gnus-group-auto-expirable-p group))
5654       ;; Set up the article buffer now, if necessary.
5655       (unless (and gnus-single-article-buffer
5656                    (equal gnus-article-buffer "*Article*"))
5657         (gnus-article-setup-buffer))
5658       ;; First and last article in this newsgroup.
5659       (when gnus-newsgroup-headers
5660         (setq gnus-newsgroup-begin
5661               (mail-header-number (car gnus-newsgroup-headers))
5662               gnus-newsgroup-end
5663               (mail-header-number
5664                (gnus-last-element gnus-newsgroup-headers))))
5665       ;; GROUP is successfully selected.
5666       (or gnus-newsgroup-headers t)))))
5667
5668 (defun gnus-compute-unseen-list ()
5669   ;; The `seen' marks are treated specially.
5670   (if (not gnus-newsgroup-seen)
5671       (setq gnus-newsgroup-unseen gnus-newsgroup-articles)
5672     (setq gnus-newsgroup-unseen
5673           (gnus-inverse-list-range-intersection
5674            gnus-newsgroup-articles gnus-newsgroup-seen))))
5675
5676 (declare-function gnus-get-predicate "gnus-agent" (predicate))
5677
5678 (defun gnus-summary-display-make-predicate (display)
5679   (require 'gnus-agent)
5680   (when (= (length display) 1)
5681     (setq display (car display)))
5682   (unless gnus-summary-display-cache
5683     (dolist (elem (append '((unread . unread)
5684                             (read . read)
5685                             (unseen . unseen))
5686                           gnus-article-mark-lists))
5687       (push (cons (cdr elem)
5688                   (gnus-byte-compile    ;Why bother?
5689                    `(lambda () (gnus-article-marked-p ',(cdr elem)))))
5690             gnus-summary-display-cache)))
5691   (let ((gnus-category-predicate-alist gnus-summary-display-cache)
5692         (gnus-category-predicate-cache gnus-summary-display-cache))
5693     (gnus-get-predicate display)))
5694
5695 ;; Uses the dynamically bound `gnus-number' variable.
5696 (defvar gnus-number)
5697 (defun gnus-article-marked-p (type &optional article)
5698   (let ((article (or article gnus-number)))
5699     (cond
5700      ((eq type 'tick)
5701       (memq article gnus-newsgroup-marked))
5702      ((eq type 'spam)
5703       (memq article gnus-newsgroup-spam-marked))
5704      ((eq type 'unsend)
5705       (memq article gnus-newsgroup-unsendable))
5706      ((eq type 'undownload)
5707       (memq article gnus-newsgroup-undownloaded))
5708      ((eq type 'download)
5709       (memq article gnus-newsgroup-downloadable))
5710      ((eq type 'unread)
5711       (memq article gnus-newsgroup-unreads))
5712      ((eq type 'read)
5713       (memq article gnus-newsgroup-reads))
5714      ((eq type 'dormant)
5715       (memq article gnus-newsgroup-dormant) )
5716      ((eq type 'expire)
5717       (memq article gnus-newsgroup-expirable))
5718      ((eq type 'reply)
5719       (memq article gnus-newsgroup-replied))
5720      ((eq type 'killed)
5721       (memq article gnus-newsgroup-killed))
5722      ((eq type 'bookmark)
5723       (assq article gnus-newsgroup-bookmarks))
5724      ((eq type 'score)
5725       (assq article gnus-newsgroup-scored))
5726      ((eq type 'save)
5727       (memq article gnus-newsgroup-saved))
5728      ((eq type 'cache)
5729       (memq article gnus-newsgroup-cached))
5730      ((eq type 'forward)
5731       (memq article gnus-newsgroup-forwarded))
5732      ((eq type 'seen)
5733       (not (memq article gnus-newsgroup-unseen)))
5734      ((eq type 'recent)
5735       (memq article gnus-newsgroup-recent))
5736      (t t))))
5737
5738 (defun gnus-articles-to-read (group &optional read-all)
5739   "Find out what articles the user wants to read."
5740   (let* ((articles
5741           ;; Select all articles if `read-all' is non-nil, or if there
5742           ;; are no unread articles.
5743           (if (or read-all
5744                   (and (zerop (length gnus-newsgroup-marked))
5745                        (zerop (length gnus-newsgroup-unreads)))
5746                   ;; Fetch all if the predicate is non-nil.
5747                   gnus-newsgroup-display)
5748               ;; We want to select the headers for all the articles in
5749               ;; the group, so we select either all the active
5750               ;; articles in the group, or (if that's nil), the
5751               ;; articles in the cache.
5752               (or
5753                (if gnus-newsgroup-maximum-articles
5754                    (let ((active (gnus-active group)))
5755                      (gnus-uncompress-range
5756                       (cons (max (car active)
5757                                  (- (cdr active)
5758                                     gnus-newsgroup-maximum-articles
5759                                     -1))
5760                             (cdr active))))
5761                  (gnus-uncompress-range (gnus-active group)))
5762                (gnus-cache-articles-in-group group))
5763             ;; Select only the "normal" subset of articles.
5764             (gnus-sorted-nunion
5765              (gnus-sorted-union gnus-newsgroup-dormant gnus-newsgroup-marked)
5766              gnus-newsgroup-unreads)))
5767          (scored-list (gnus-killed-articles gnus-newsgroup-killed articles))
5768          (scored (length scored-list))
5769          (number (length articles))
5770          (marked (+ (length gnus-newsgroup-marked)
5771                     (length gnus-newsgroup-dormant)))
5772          (select
5773           (cond
5774            ((numberp read-all)
5775             read-all)
5776            ((numberp gnus-newsgroup-display)
5777             gnus-newsgroup-display)
5778            (t
5779             (condition-case ()
5780                 (cond
5781                  ((and (or (<= scored marked) (= scored number))
5782                        (numberp gnus-large-newsgroup)
5783                        (> number gnus-large-newsgroup))
5784                   (let* ((cursor-in-echo-area nil)
5785                          (initial (gnus-parameter-large-newsgroup-initial
5786                                    gnus-newsgroup-name))
5787                          (input
5788                           (read-string
5789                            (format
5790                             "How many articles from %s (%s %d): "
5791                             (gnus-group-decoded-name gnus-newsgroup-name)
5792                             (if initial "max" "default")
5793                             number)
5794                            (if initial
5795                                (cons (number-to-string initial)
5796                                      0)))))
5797                     (if (string-match "^[ \t]*$" input) number input)))
5798                  ((and (> scored marked) (< scored number)
5799                        (> (- scored number) 20))
5800                   (let ((input
5801                          (read-string
5802                           (format "%s %s (%d scored, %d total): "
5803                                   "How many articles from"
5804                                   (gnus-group-decoded-name group)
5805                                   scored number))))
5806                     (if (string-match "^[ \t]*$" input)
5807                         number input)))
5808                  (t number))
5809               (quit
5810                (message "Quit getting the articles to read")
5811                nil))))))
5812     (setq select (if (stringp select) (string-to-number select) select))
5813     (if (or (null select) (zerop select))
5814         select
5815       (if (and (not (zerop scored)) (<= (abs select) scored))
5816           (progn
5817             (setq articles (sort scored-list '<))
5818             (setq number (length articles)))
5819         (setq articles (copy-sequence articles)))
5820
5821       (when (< (abs select) number)
5822         (if (< select 0)
5823             ;; Select the N oldest articles.
5824             (setcdr (nthcdr (1- (abs select)) articles) nil)
5825           ;; Select the N most recent articles.
5826           (setq articles (nthcdr (- number select) articles))))
5827       (setq gnus-newsgroup-unselected
5828             (gnus-sorted-difference gnus-newsgroup-unreads articles))
5829       (when gnus-alter-articles-to-read-function
5830         (setq articles
5831               (sort
5832                (funcall gnus-alter-articles-to-read-function
5833                         gnus-newsgroup-name articles)
5834                '<)))
5835       articles)))
5836
5837 (defun gnus-killed-articles (killed articles)
5838   (let (out)
5839     (while articles
5840       (when (inline (gnus-member-of-range (car articles) killed))
5841         (push (car articles) out))
5842       (setq articles (cdr articles)))
5843     out))
5844
5845 (defun gnus-uncompress-marks (marks)
5846   "Uncompress the mark ranges in MARKS."
5847   (let ((uncompressed '(score bookmark))
5848         out)
5849     (while marks
5850       (if (memq (caar marks) uncompressed)
5851           (push (car marks) out)
5852         (push (cons (caar marks) (gnus-uncompress-range (cdar marks))) out))
5853       (setq marks (cdr marks)))
5854     out))
5855
5856 (defun gnus-article-mark-to-type (mark)
5857   "Return the type of MARK."
5858   (or (cadr (assq mark gnus-article-special-mark-lists))
5859       'list))
5860
5861 (defun gnus-article-unpropagatable-p (mark)
5862   "Return whether MARK should be propagated to back end."
5863   (memq mark gnus-article-unpropagated-mark-lists))
5864
5865 (defun gnus-adjust-marked-articles (info)
5866   "Set all article lists and remove all marks that are no longer valid."
5867   (let* ((marked-lists (gnus-info-marks info))
5868          (active (gnus-active (gnus-info-group info)))
5869          (min (car active))
5870          (max (cdr active))
5871          (types gnus-article-mark-lists)
5872          marks var articles article mark mark-type
5873          bgn end)
5874     ;; Hack to avoid adjusting marks for imap.
5875     (when (eq (car (gnus-find-method-for-group (gnus-info-group info)))
5876               'nnimap)
5877       (setq min 1))
5878
5879     (dolist (marks marked-lists)
5880       (setq mark (car marks)
5881             mark-type (gnus-article-mark-to-type mark)
5882             var (intern (format "gnus-newsgroup-%s" (car (rassq mark types)))))
5883
5884       ;; We set the variable according to the type of the marks list,
5885       ;; and then adjust the marks to a subset of the active articles.
5886       (cond
5887        ;; Adjust "simple" lists - compressed yet unsorted
5888        ((eq mark-type 'list)
5889         ;; Simultaneously uncompress and clip to active range
5890         ;; See gnus-uncompress-range for a description of possible marks
5891         (let (l lh)
5892           (if (not (cadr marks))
5893               (set var nil)
5894             (setq articles (if (numberp (cddr marks))
5895                                (list (cdr marks))
5896                              (cdr marks))
5897                   lh (cons nil nil)
5898                   l lh)
5899
5900             (while (setq article (pop articles))
5901               (cond ((consp article)
5902                      (setq bgn (max (car article) min)
5903                            end (min (cdr article) max))
5904                      (while (<= bgn end)
5905                        (setq l (setcdr l (cons bgn nil))
5906                              bgn (1+ bgn))))
5907                     ((and (<= min article)
5908                           (>= max article))
5909                      (setq l (setcdr l (cons article nil))))))
5910             (set var (cdr lh)))))
5911        ;; Adjust assocs.
5912        ((eq mark-type 'tuple)
5913         (set var (setq articles (cdr marks)))
5914         (when (not (listp (cdr (symbol-value var))))
5915           (set var (list (symbol-value var))))
5916         (when (not (listp (cdr articles)))
5917           (setq articles (list articles)))
5918         (while articles
5919           (when (or (not (consp (setq article (pop articles))))
5920                     (< (car article) min)
5921                     (> (car article) max))
5922             (set var (delq article (symbol-value var))))))
5923        ;; Adjust ranges (sloppily).
5924        ((eq mark-type 'range)
5925         (cond
5926          ((eq mark 'seen)
5927           ;; Fix the record for `seen' if it looks like (seen NUM1 . NUM2).
5928           ;; It should be (seen (NUM1 . NUM2)).
5929           (when (numberp (cddr marks))
5930             (setcdr marks (list (cdr marks))))
5931           (setq articles (cdr marks))
5932           (while (and articles
5933                       (or (and (consp (car articles))
5934                                (> min (cdar articles)))
5935                           (and (numberp (car articles))
5936                                (> min (car articles)))))
5937             (pop articles))
5938           (set var articles))))))))
5939
5940 (defun gnus-update-missing-marks (missing)
5941   "Go through the list of MISSING articles and remove them from the mark lists."
5942   (when missing
5943     (let (var m)
5944       ;; Go through all types.
5945       (dolist (elem gnus-article-mark-lists)
5946         (when (eq (gnus-article-mark-to-type (cdr elem)) 'list)
5947           (setq var (intern (format "gnus-newsgroup-%s" (car elem))))
5948           (when (symbol-value var)
5949             ;; This list has articles.  So we delete all missing
5950             ;; articles from it.
5951             (setq m missing)
5952             (while m
5953               (set var (delq (pop m) (symbol-value var))))))))))
5954
5955 (defun gnus-update-marks ()
5956   "Enter the various lists of marked articles into the newsgroup info list."
5957   (let ((types gnus-article-mark-lists)
5958         (info (gnus-get-info gnus-newsgroup-name))
5959         type list newmarked symbol delta-marks)
5960     (when info
5961       ;; Add all marks lists to the list of marks lists.
5962       (while (setq type (pop types))
5963         (setq list (symbol-value
5964                     (setq symbol
5965                           (intern (format "gnus-newsgroup-%s" (car type))))))
5966
5967         (when list
5968           ;; Get rid of the entries of the articles that have the
5969           ;; default score.
5970           (when (and (eq (cdr type) 'score)
5971                      gnus-save-score
5972                      list)
5973             (let* ((arts list)
5974                    (prev (cons nil list))
5975                    (all prev))
5976               (while arts
5977                 (if (or (not (consp (car arts)))
5978                         (= (cdar arts) gnus-summary-default-score))
5979                     (setcdr prev (cdr arts))
5980                   (setq prev arts))
5981                 (setq arts (cdr arts)))
5982               (setq list (cdr all)))))
5983
5984         (when (eq (cdr type) 'seen)
5985           (setq list (gnus-range-add list gnus-newsgroup-unseen)))
5986
5987         (when (eq (gnus-article-mark-to-type (cdr type)) 'list)
5988           (setq list (gnus-compress-sequence (set symbol (sort list '<)) t)))
5989
5990         (when (and (gnus-check-backend-function
5991                     'request-set-mark gnus-newsgroup-name)
5992                    (not (gnus-article-unpropagatable-p (cdr type))))
5993           (let* ((old (cdr (assq (cdr type) (gnus-info-marks info))))
5994                  (del (gnus-remove-from-range (gnus-copy-sequence old) list))
5995                  (add (gnus-remove-from-range
5996                        (gnus-copy-sequence list) old)))
5997             (when add
5998               (push (list add 'add (list (cdr type))) delta-marks))
5999             (when del
6000               ;; Don't delete marks from outside the active range.  This
6001               ;; shouldn't happen, but is a sanity check.
6002               (setq del (gnus-sorted-range-intersection
6003                          (gnus-active gnus-newsgroup-name) del))
6004               (push (list del 'del (list (cdr type))) delta-marks))))
6005
6006         (when list
6007           (push (cons (cdr type) list) newmarked)))
6008
6009       (when delta-marks
6010         (unless (gnus-check-group gnus-newsgroup-name)
6011           (error "Can't open server for %s" gnus-newsgroup-name))
6012         (gnus-request-set-mark gnus-newsgroup-name delta-marks))
6013
6014       ;; Enter these new marks into the info of the group.
6015       (if (nthcdr 3 info)
6016           (setcar (nthcdr 3 info) newmarked)
6017         ;; Add the marks lists to the end of the info.
6018         (when newmarked
6019           (setcdr (nthcdr 2 info) (list newmarked))))
6020
6021       ;; Cut off the end of the info if there's nothing else there.
6022       (let ((i 5))
6023         (while (and (> i 2)
6024                     (not (nth i info)))
6025           (when (nthcdr (decf i) info)
6026             (setcdr (nthcdr i info) nil)))))))
6027
6028 (defun gnus-set-mode-line (where)
6029   "Set the mode line of the article or summary buffers.
6030 If WHERE is `summary', the summary mode line format will be used."
6031   ;; Is this mode line one we keep updated?
6032   (when (and (memq where gnus-updated-mode-lines)
6033              (symbol-value
6034               (intern (format "gnus-%s-mode-line-format-spec" where))))
6035     (let (mode-string)
6036       ;; We evaluate this in the summary buffer since these
6037       ;; variables are buffer-local to that buffer.
6038       (with-current-buffer gnus-summary-buffer
6039         ;; We bind all these variables that are used in the `eval' form
6040         ;; below.
6041         (let* ((mformat (symbol-value
6042                          (intern
6043                           (format "gnus-%s-mode-line-format-spec" where))))
6044                (gnus-tmp-group-name (gnus-mode-string-quote
6045                                      (gnus-group-decoded-name
6046                                       gnus-newsgroup-name)))
6047                (gnus-tmp-article-number (or gnus-current-article 0))
6048                (gnus-tmp-unread gnus-newsgroup-unreads)
6049                (gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads))
6050                (gnus-tmp-unselected (length gnus-newsgroup-unselected))
6051                (gnus-tmp-unread-and-unselected
6052                 (cond ((and (zerop gnus-tmp-unread-and-unticked)
6053                             (zerop gnus-tmp-unselected))
6054                        "")
6055                       ((zerop gnus-tmp-unselected)
6056                        (format "{%d more}" gnus-tmp-unread-and-unticked))
6057                       (t (format "{%d(+%d) more}"
6058                                  gnus-tmp-unread-and-unticked
6059                                  gnus-tmp-unselected))))
6060                (gnus-tmp-subject
6061                 (if (and gnus-current-headers
6062                          (vectorp gnus-current-headers))
6063                     (gnus-mode-string-quote
6064                      (mail-header-subject gnus-current-headers))
6065                   ""))
6066                bufname-length max-len
6067                gnus-tmp-header) ;; passed as argument to any user-format-funcs
6068           (setq mode-string (eval mformat))
6069           (setq bufname-length (if (string-match "%b" mode-string)
6070                                    (- (length
6071                                        (buffer-name
6072                                         (if (eq where 'summary)
6073                                             nil
6074                                           (get-buffer gnus-article-buffer))))
6075                                       2)
6076                                  0))
6077           (setq max-len (max 4 (if gnus-mode-non-string-length
6078                                    (- (window-width)
6079                                       gnus-mode-non-string-length
6080                                       bufname-length)
6081                                  (length mode-string))))
6082           ;; We might have to chop a bit of the string off...
6083           (when (> (length mode-string) max-len)
6084             (setq mode-string
6085                   (concat (truncate-string-to-width mode-string (- max-len 3))
6086                           "...")))))
6087       ;; Update the mode line.
6088       (setq mode-line-buffer-identification
6089             (gnus-mode-line-buffer-identification (list mode-string)))
6090       (set-buffer-modified-p t))))
6091
6092 (defun gnus-create-xref-hashtb (from-newsgroup headers unreads)
6093   "Go through the HEADERS list and add all Xrefs to a hash table.
6094 The resulting hash table is returned, or nil if no Xrefs were found."
6095   (let* ((virtual (gnus-virtual-group-p from-newsgroup))
6096          (prefix (if virtual "" (gnus-group-real-prefix from-newsgroup)))
6097          (xref-hashtb (gnus-make-hashtable))
6098          start group entry number xrefs header)
6099     (while headers
6100       (setq header (pop headers))
6101       (when (and (setq xrefs (mail-header-xref header))
6102                  (not (memq (setq number (mail-header-number header))
6103                             unreads)))
6104         (setq start 0)
6105         (while (string-match "\\([^ ]+\\)[:/]\\([0-9]+\\)" xrefs start)
6106           (setq start (match-end 0))
6107           (setq group (if prefix
6108                           (concat prefix (substring xrefs (match-beginning 1)
6109                                                     (match-end 1)))
6110                         (substring xrefs (match-beginning 1) (match-end 1))))
6111           (setq number
6112                 (string-to-number (substring xrefs (match-beginning 2)
6113                                           (match-end 2))))
6114           (if (setq entry (gnus-gethash group xref-hashtb))
6115               (setcdr entry (cons number (cdr entry)))
6116             (gnus-sethash group (cons number nil) xref-hashtb)))))
6117     (and start xref-hashtb)))
6118
6119 (defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads)
6120   "Look through all the headers and mark the Xrefs as read."
6121   (let ((virtual (gnus-virtual-group-p from-newsgroup))
6122         name info xref-hashtb idlist method nth4)
6123     (with-current-buffer gnus-group-buffer
6124       (when (setq xref-hashtb
6125                   (gnus-create-xref-hashtb from-newsgroup headers unreads))
6126         (mapatoms
6127          (lambda (group)
6128            (unless (string= from-newsgroup (setq name (symbol-name group)))
6129              (setq idlist (symbol-value group))
6130              ;; Dead groups are not updated.
6131              (and (prog1
6132                       (setq info (gnus-get-info name))
6133                     (when (stringp (setq nth4 (gnus-info-method info)))
6134                       (setq nth4 (gnus-server-to-method nth4))))
6135                   ;; Only do the xrefs if the group has the same
6136                   ;; select method as the group we have just read.
6137                   (or (gnus-methods-equal-p
6138                        nth4 (gnus-find-method-for-group from-newsgroup))
6139                       virtual
6140                       (equal nth4 (setq method (gnus-find-method-for-group
6141                                                 from-newsgroup)))
6142                       (and (equal (car nth4) (car method))
6143                            (equal (nth 1 nth4) (nth 1 method))))
6144                   gnus-use-cross-reference
6145                   (or (not (eq gnus-use-cross-reference t))
6146                       virtual
6147                       ;; Only do cross-references on subscribed
6148                       ;; groups, if that is what is wanted.
6149                       (<= (gnus-info-level info) gnus-level-subscribed))
6150                   (gnus-group-make-articles-read name idlist))))
6151          xref-hashtb)))))
6152
6153 (defun gnus-compute-read-articles (group articles)
6154   (let* ((entry (gnus-group-entry group))
6155          (info (nth 2 entry))
6156          (active (gnus-active group))
6157          ninfo)
6158     (when entry
6159       ;; First peel off all invalid article numbers.
6160       (when active
6161         (let ((ids articles)
6162               id first)
6163           (while (setq id (pop ids))
6164             (when (and first (> id (cdr active)))
6165               ;; We'll end up in this situation in one particular
6166               ;; obscure situation.  If you re-scan a group and get
6167               ;; a new article that is cross-posted to a different
6168               ;; group that has not been re-scanned, you might get
6169               ;; crossposted article that has a higher number than
6170               ;; Gnus believes possible.  So we re-activate this
6171               ;; group as well.  This might mean doing the
6172               ;; crossposting thingy will *increase* the number
6173               ;; of articles in some groups.  Tsk, tsk.
6174               (setq active (or (gnus-activate-group group) active)))
6175             (when (or (> id (cdr active))
6176                       (< id (car active)))
6177               (setq articles (delq id articles))))))
6178       ;; If the read list is nil, we init it.
6179       (if (and active
6180                (null (gnus-info-read info))
6181                (> (car active) 1))
6182           (setq ninfo (cons 1 (1- (car active))))
6183         (setq ninfo (gnus-info-read info)))
6184       ;; Then we add the read articles to the range.
6185       (gnus-add-to-range
6186        ninfo (setq articles (sort articles '<))))))
6187
6188 (defun gnus-group-make-articles-read (group articles)
6189   "Update the info of GROUP to say that ARTICLES are read."
6190   (let* ((num 0)
6191          (entry (gnus-group-entry group))
6192          (info (nth 2 entry))
6193          (active (gnus-active group))
6194          range)
6195     (if (not entry)
6196         ;; Group that Gnus doesn't know exists, but still allow the
6197         ;; backend to set marks.
6198         (gnus-request-set-mark
6199          group (list (list (gnus-compress-sequence (sort articles #'<))
6200                            'add '(read))))
6201       ;; Normal, subscribed groups.
6202       (setq range (gnus-compute-read-articles group articles))
6203       (with-current-buffer gnus-group-buffer
6204         (gnus-undo-register
6205           `(progn
6206              (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
6207              (gnus-info-set-read ',info ',(gnus-info-read info))
6208              (gnus-get-unread-articles-in-group ',info (gnus-active ,group))
6209              (gnus-request-set-mark ,group (list (list ',range 'del '(read))))
6210              (gnus-group-update-group ,group t))))
6211       ;; Add the read articles to the range.
6212       (gnus-info-set-read info range)
6213       (gnus-request-set-mark group (list (list range 'add '(read))))
6214       ;; Then we have to re-compute how many unread
6215       ;; articles there are in this group.
6216       (when active
6217         (cond
6218          ((not range)
6219           (setq num (- (1+ (cdr active)) (car active))))
6220          ((not (listp (cdr range)))
6221           (setq num (- (cdr active) (- (1+ (cdr range))
6222                                        (car range)))))
6223          (t
6224           (while range
6225             (if (numberp (car range))
6226                 (setq num (1+ num))
6227               (setq num (+ num (- (1+ (cdar range)) (caar range)))))
6228             (setq range (cdr range)))
6229           (setq num (- (cdr active) num))))
6230         ;; Update the number of unread articles.
6231         (setcar entry num)
6232         ;; Update the group buffer.
6233         (unless (gnus-ephemeral-group-p group)
6234           (gnus-group-update-group group t))))))
6235
6236 (defun gnus-get-newsgroup-headers (&optional dependencies force-new)
6237   (let ((cur nntp-server-buffer)
6238         (dependencies
6239          (or dependencies
6240              (with-current-buffer gnus-summary-buffer
6241                gnus-newsgroup-dependencies)))
6242         headers id end ref number
6243         (mail-parse-charset gnus-newsgroup-charset)
6244         (mail-parse-ignored-charsets
6245          (save-current-buffer (condition-case nil
6246                                   (set-buffer gnus-summary-buffer)
6247                                 (error))
6248                               gnus-newsgroup-ignored-charsets)))
6249     (with-current-buffer nntp-server-buffer
6250       ;; Translate all TAB characters into SPACE characters.
6251       (subst-char-in-region (point-min) (point-max) ?\t ?  t)
6252       (subst-char-in-region (point-min) (point-max) ?\r ?  t)
6253       (ietf-drums-unfold-fws)
6254       (gnus-run-hooks 'gnus-parse-headers-hook)
6255       (let ((case-fold-search t)
6256             in-reply-to header p lines chars)
6257         (goto-char (point-min))
6258         ;; Search to the beginning of the next header.  Error messages
6259         ;; do not begin with 2 or 3.
6260         (while (re-search-forward "^[23][0-9]+ " nil t)
6261           (setq id nil
6262                 ref nil)
6263           ;; This implementation of this function, with nine
6264           ;; search-forwards instead of the one re-search-forward and
6265           ;; a case (which basically was the old function) is actually
6266           ;; about twice as fast, even though it looks messier.  You
6267           ;; can't have everything, I guess.  Speed and elegance
6268           ;; doesn't always go hand in hand.
6269           (setq
6270            header
6271            (vector
6272             ;; Number.
6273             (prog1
6274                 (setq number (read cur))
6275               (end-of-line)
6276               (setq p (point))
6277               (narrow-to-region (point)
6278                                 (or (and (search-forward "\n.\n" nil t)
6279                                          (- (point) 2))
6280                                     (point))))
6281             ;; Subject.
6282             (progn
6283               (goto-char p)
6284               (if (search-forward "\nsubject:" nil t)
6285                   (funcall gnus-decode-encoded-word-function
6286                            (nnheader-header-value))
6287                 "(none)"))
6288             ;; From.
6289             (progn
6290               (goto-char p)
6291               (if (search-forward "\nfrom:" nil t)
6292                   (funcall gnus-decode-encoded-address-function
6293                            (nnheader-header-value))
6294                 "(nobody)"))
6295             ;; Date.
6296             (progn
6297               (goto-char p)
6298               (if (search-forward "\ndate:" nil t)
6299                   (nnheader-header-value) ""))
6300             ;; Message-ID.
6301             (progn
6302               (goto-char p)
6303               (setq id (if (re-search-forward
6304                             "^message-id: *\\(<[^\n\t> ]+>\\)" nil t)
6305                            ;; We do it this way to make sure the Message-ID
6306                            ;; is (somewhat) syntactically valid.
6307                            (buffer-substring (match-beginning 1)
6308                                              (match-end 1))
6309                          ;; If there was no message-id, we just fake one
6310                          ;; to make subsequent routines simpler.
6311                          (nnheader-generate-fake-message-id number))))
6312             ;; References.
6313             (progn
6314               (goto-char p)
6315               (if (search-forward "\nreferences:" nil t)
6316                   (progn
6317                     (setq end (point))
6318                     (prog1
6319                         (nnheader-header-value)
6320                       (setq ref
6321                             (buffer-substring
6322                              (progn
6323                                (end-of-line)
6324                                (search-backward ">" end t)
6325                                (1+ (point)))
6326                              (progn
6327                                (search-backward "<" end t)
6328                                (point))))))
6329                 ;; Get the references from the in-reply-to header if there
6330                 ;; were no references and the in-reply-to header looks
6331                 ;; promising.
6332                 (if (and (search-forward "\nin-reply-to:" nil t)
6333                          (setq in-reply-to (nnheader-header-value))
6334                          (string-match "<[^>]+>" in-reply-to))
6335                     (let (ref2)
6336                       (setq ref (substring in-reply-to (match-beginning 0)
6337                                            (match-end 0)))
6338                       (while (string-match "<[^>]+>" in-reply-to (match-end 0))
6339                         (setq ref2 (substring in-reply-to (match-beginning 0)
6340                                               (match-end 0)))
6341                         (when (> (length ref2) (length ref))
6342                           (setq ref ref2)))
6343                       ref)
6344                   (setq ref nil))))
6345             ;; Chars.
6346             (progn
6347               (goto-char p)
6348               (if (search-forward "\nchars: " nil t)
6349                   (if (numberp (setq chars (ignore-errors (read cur))))
6350                       chars -1)
6351                 -1))
6352             ;; Lines.
6353             (progn
6354               (goto-char p)
6355               (if (search-forward "\nlines: " nil t)
6356                   (if (numberp (setq lines (ignore-errors (read cur))))
6357                       lines -1)
6358                 -1))
6359             ;; Xref.
6360             (progn
6361               (goto-char p)
6362               (and (search-forward "\nxref:" nil t)
6363                    (nnheader-header-value)))
6364             ;; Extra.
6365             (when gnus-extra-headers
6366               (let ((extra gnus-extra-headers)
6367                     out)
6368                 (while extra
6369                   (goto-char p)
6370                   (when (search-forward
6371                          (concat "\n" (symbol-name (car extra)) ":") nil t)
6372                     (push (cons (car extra) (nnheader-header-value))
6373                           out))
6374                   (pop extra))
6375                 out))))
6376           (when (equal id ref)
6377             (setq ref nil))
6378
6379           (when gnus-alter-header-function
6380             (funcall gnus-alter-header-function header)
6381             (setq id (mail-header-id header)
6382                   ref (gnus-parent-id (mail-header-references header))))
6383
6384           (when (setq header
6385                       (gnus-dependencies-add-header
6386                        header dependencies force-new))
6387             (push header headers))
6388           (goto-char (point-max))
6389           (widen))
6390         (nreverse headers)))))
6391
6392 ;; Goes through the xover lines and returns a list of vectors
6393 (defun gnus-get-newsgroup-headers-xover (sequence &optional
6394                                                   force-new dependencies
6395                                                   group also-fetch-heads)
6396   "Parse the news overview data in the server buffer.
6397 Return a list of headers that match SEQUENCE (see
6398 `nntp-retrieve-headers')."
6399   ;; Get the Xref when the users reads the articles since most/some
6400   ;; NNTP servers do not include Xrefs when using XOVER.
6401   (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
6402   (let ((mail-parse-charset gnus-newsgroup-charset)
6403         (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)
6404         (cur nntp-server-buffer)
6405         (dependencies (or dependencies gnus-newsgroup-dependencies))
6406         (allp (cond
6407                ((eq gnus-read-all-available-headers t)
6408                 t)
6409                ((and (stringp gnus-read-all-available-headers)
6410                      group)
6411                 (string-match gnus-read-all-available-headers group))
6412                (t
6413                 nil)))
6414         number headers header)
6415     (with-current-buffer nntp-server-buffer
6416       (subst-char-in-region (point-min) (point-max) ?\r ?  t)
6417       ;; Allow the user to mangle the headers before parsing them.
6418       (gnus-run-hooks 'gnus-parse-headers-hook)
6419       (goto-char (point-min))
6420       (gnus-parse-without-error
6421         (while (and (or sequence allp)
6422                     (not (eobp)))
6423           (setq number (read cur))
6424           (when (not allp)
6425             (while (and sequence
6426                         (< (car sequence) number))
6427               (setq sequence (cdr sequence))))
6428           (when (and (or allp
6429                          (and sequence
6430                               (eq number (car sequence))))
6431                      (progn
6432                        (setq sequence (cdr sequence))
6433                        (setq header (inline
6434                                       (gnus-nov-parse-line
6435                                        number dependencies force-new)))))
6436             (push header headers))
6437           (forward-line 1)))
6438       ;; A common bug in inn is that if you have posted an article and
6439       ;; then retrieves the active file, it will answer correctly --
6440       ;; the new article is included.  However, a NOV entry for the
6441       ;; article may not have been generated yet, so this may fail.
6442       ;; We work around this problem by retrieving the last few
6443       ;; headers using HEAD.
6444       (if (or (not also-fetch-heads)
6445               (not sequence))
6446           ;; We (probably) got all the headers.
6447           (nreverse headers)
6448         (let ((gnus-nov-is-evil t))
6449           (nconc
6450            (nreverse headers)
6451            (when (eq (gnus-retrieve-headers sequence group) 'headers)
6452              (gnus-get-newsgroup-headers))))))))
6453
6454 (defun gnus-article-get-xrefs ()
6455   "Fill in the Xref value in `gnus-current-headers', if necessary.
6456 This is meant to be called in `gnus-article-internal-prepare-hook'."
6457   (let ((headers (with-current-buffer gnus-summary-buffer
6458                    gnus-current-headers)))
6459     (or (not gnus-use-cross-reference)
6460         (not headers)
6461         (and (mail-header-xref headers)
6462              (not (string= (mail-header-xref headers) "")))
6463         (let ((case-fold-search t)
6464               xref)
6465           (save-restriction
6466             (nnheader-narrow-to-headers)
6467             (goto-char (point-min))
6468             (when (or (and (not (eobp))
6469                            (eq (downcase (char-after)) ?x)
6470                            (looking-at "Xref:"))
6471                       (search-forward "\nXref:" nil t))
6472               (goto-char (1+ (match-end 0)))
6473               (setq xref (buffer-substring (point) (point-at-eol)))
6474               (mail-header-set-xref headers xref)))))))
6475
6476 (defun gnus-summary-insert-subject (id &optional old-header use-old-header)
6477   "Find article ID and insert the summary line for that article.
6478 OLD-HEADER can either be a header or a line number to insert
6479 the subject line on."
6480   (let* ((line (and (numberp old-header) old-header))
6481          (old-header (and (vectorp old-header) old-header))
6482          (header (cond ((and old-header use-old-header)
6483                         old-header)
6484                        ((and (numberp id)
6485                              (gnus-number-to-header id))
6486                         (gnus-number-to-header id))
6487                        (t
6488                         (gnus-read-header id))))
6489          (number (and (numberp id) id))
6490          d)
6491     (when header
6492       ;; Rebuild the thread that this article is part of and go to the
6493       ;; article we have fetched.
6494       (when (and (not gnus-show-threads)
6495                  old-header)
6496         (when (and number
6497                    (setq d (gnus-data-find (mail-header-number old-header))))
6498           (goto-char (gnus-data-pos d))
6499           (gnus-data-remove
6500            number
6501            (- (point-at-bol)
6502               (prog1
6503                   (1+ (point-at-eol))
6504                 (gnus-delete-line))))))
6505       ;; Remove list identifiers from subject.
6506       (when gnus-list-identifiers
6507         (let ((gnus-newsgroup-headers (list header)))
6508           (gnus-summary-remove-list-identifiers)))
6509       (when old-header
6510         (mail-header-set-number header (mail-header-number old-header)))
6511       (setq gnus-newsgroup-sparse
6512             (delq (setq number (mail-header-number header))
6513                   gnus-newsgroup-sparse))
6514       (setq gnus-newsgroup-ancient (delq number gnus-newsgroup-ancient))
6515       (push number gnus-newsgroup-limit)
6516       (gnus-rebuild-thread (mail-header-id header) line)
6517       (gnus-summary-goto-subject number nil t))
6518     (when (and (numberp number)
6519                (> number 0))
6520       ;; We have to update the boundaries even if we can't fetch the
6521       ;; article if ID is a number -- so that the next `P' or `N'
6522       ;; command will fetch the previous (or next) article even
6523       ;; if the one we tried to fetch this time has been canceled.
6524       (when (> number gnus-newsgroup-end)
6525         (setq gnus-newsgroup-end number))
6526       (when (< number gnus-newsgroup-begin)
6527         (setq gnus-newsgroup-begin number))
6528       (setq gnus-newsgroup-unselected
6529             (delq number gnus-newsgroup-unselected)))
6530     ;; Report back a success?
6531     (and header (mail-header-number header))))
6532
6533 ;;; Process/prefix in the summary buffer
6534
6535 (defun gnus-summary-work-articles (n)
6536   "Return a list of articles to be worked upon.
6537 The prefix argument, the list of process marked articles, and the
6538 current article will be taken into consideration."
6539   (with-current-buffer gnus-summary-buffer
6540     (cond
6541      (n
6542       ;; A numerical prefix has been given.
6543       (setq n (prefix-numeric-value n))
6544       (let ((backward (< n 0))
6545             (n (abs (prefix-numeric-value n)))
6546             articles article)
6547         (save-excursion
6548           (while
6549               (and (> n 0)
6550                    (push (setq article (gnus-summary-article-number))
6551                          articles)
6552                    (if backward
6553                        (gnus-summary-find-prev nil article)
6554                      (gnus-summary-find-next nil article)))
6555             (decf n)))
6556         (nreverse articles)))
6557      ((and (gnus-region-active-p) (mark))
6558       (message "region active")
6559       ;; Work on the region between point and mark.
6560       (let ((max (max (point) (mark)))
6561             articles article)
6562         (save-excursion
6563           (goto-char (min (point) (mark)))
6564           (while
6565               (and
6566                (push (setq article (gnus-summary-article-number)) articles)
6567                (gnus-summary-find-next nil article)
6568                (< (point) max)))
6569           (nreverse articles))))
6570      (gnus-newsgroup-processable
6571       ;; There are process-marked articles present.
6572       ;; Save current state.
6573       (gnus-summary-save-process-mark)
6574       ;; Return the list.
6575       (reverse gnus-newsgroup-processable))
6576      (t
6577       ;; Just return the current article.
6578       (list (gnus-summary-article-number))))))
6579
6580 (defmacro gnus-summary-iterate (arg &rest forms)
6581   "Iterate over the process/prefixed articles and do FORMS.
6582 ARG is the interactive prefix given to the command.  FORMS will be
6583 executed with point over the summary line of the articles."
6584   (let ((articles (make-symbol "gnus-summary-iterate-articles")))
6585     `(let ((,articles (gnus-summary-work-articles ,arg)))
6586        (while ,articles
6587          (gnus-summary-goto-subject (car ,articles))
6588          ,@forms
6589          (pop ,articles)))))
6590
6591 (put 'gnus-summary-iterate 'lisp-indent-function 1)
6592 (put 'gnus-summary-iterate 'edebug-form-spec '(form body))
6593
6594 (defun gnus-summary-save-process-mark ()
6595   "Push the current set of process marked articles on the stack."
6596   (interactive)
6597   (push (copy-sequence gnus-newsgroup-processable)
6598         gnus-newsgroup-process-stack))
6599
6600 (defun gnus-summary-kill-process-mark ()
6601   "Push the current set of process marked articles on the stack and unmark."
6602   (interactive)
6603   (gnus-summary-save-process-mark)
6604   (gnus-summary-unmark-all-processable))
6605
6606 (defun gnus-summary-yank-process-mark ()
6607   "Pop the last process mark state off the stack and restore it."
6608   (interactive)
6609   (unless gnus-newsgroup-process-stack
6610     (error "Empty mark stack"))
6611   (gnus-summary-process-mark-set (pop gnus-newsgroup-process-stack)))
6612
6613 (defun gnus-summary-process-mark-set (set)
6614   "Make SET into the current process marked articles."
6615   (gnus-summary-unmark-all-processable)
6616   (mapc 'gnus-summary-set-process-mark set))
6617
6618 ;;; Searching and stuff
6619
6620 (defun gnus-summary-search-group (&optional backward use-level)
6621   "Search for next unread newsgroup.
6622 If optional argument BACKWARD is non-nil, search backward instead."
6623   (with-current-buffer gnus-group-buffer
6624     (when (gnus-group-search-forward
6625            backward nil (if use-level (gnus-group-group-level) nil))
6626       (gnus-group-group-name))))
6627
6628 (defun gnus-summary-best-group (&optional exclude-group)
6629   "Find the name of the best unread group.
6630 If EXCLUDE-GROUP, do not go to this group."
6631   (with-current-buffer gnus-group-buffer
6632     (save-excursion
6633       (gnus-group-best-unread-group exclude-group))))
6634
6635 (defun gnus-summary-find-next (&optional unread article backward)
6636   (if backward
6637       (gnus-summary-find-prev unread article)
6638     (let* ((dummy (gnus-summary-article-intangible-p))
6639            (article (or article (gnus-summary-article-number)))
6640            (data (gnus-data-find-list article))
6641            result)
6642       (when (and (not dummy)
6643                  (or (not gnus-summary-check-current)
6644                      (not unread)
6645                      (not (gnus-data-unread-p (car data)))))
6646         (setq data (cdr data)))
6647       (when (setq result
6648                   (if unread
6649                       (progn
6650                         (while data
6651                           (unless (memq (gnus-data-number (car data))
6652                                         (cond
6653                                          ((eq gnus-auto-goto-ignores
6654                                               'always-undownloaded)
6655                                           gnus-newsgroup-undownloaded)
6656                                          (gnus-plugged
6657                                           nil)
6658                                          ((eq gnus-auto-goto-ignores
6659                                               'unfetched)
6660                                           gnus-newsgroup-unfetched)
6661                                          ((eq gnus-auto-goto-ignores
6662                                               'undownloaded)
6663                                           gnus-newsgroup-undownloaded)))
6664                             (when (gnus-data-unread-p (car data))
6665                               (setq result (car data)
6666                                     data nil)))
6667                           (setq data (cdr data)))
6668                         result)
6669                     (car data)))
6670         (goto-char (gnus-data-pos result))
6671         (gnus-data-number result)))))
6672
6673 (defun gnus-summary-find-prev (&optional unread article)
6674   (let* ((eobp (eobp))
6675          (article (or article (gnus-summary-article-number)))
6676          (data (gnus-data-find-list article (gnus-data-list 'rev)))
6677          result)
6678     (when (and (not eobp)
6679                (or (not gnus-summary-check-current)
6680                    (not unread)
6681                    (not (gnus-data-unread-p (car data)))))
6682       (setq data (cdr data)))
6683     (when (setq result
6684                 (if unread
6685                     (progn
6686                       (while data
6687                         (unless (memq (gnus-data-number (car data))
6688                                       (cond
6689                                        ((eq gnus-auto-goto-ignores
6690                                             'always-undownloaded)
6691                                         gnus-newsgroup-undownloaded)
6692                                        (gnus-plugged
6693                                         nil)
6694                                        ((eq gnus-auto-goto-ignores
6695                                             'unfetched)
6696                                         gnus-newsgroup-unfetched)
6697                                        ((eq gnus-auto-goto-ignores
6698                                             'undownloaded)
6699                                         gnus-newsgroup-undownloaded)))
6700                           (when (gnus-data-unread-p (car data))
6701                             (setq result (car data)
6702                                   data nil)))
6703                         (setq data (cdr data)))
6704                       result)
6705                   (car data)))
6706       (goto-char (gnus-data-pos result))
6707       (gnus-data-number result))))
6708
6709 (defun gnus-summary-find-subject (subject &optional unread backward article)
6710   (let* ((simp-subject (gnus-simplify-subject-fully subject))
6711          (article (or article (gnus-summary-article-number)))
6712          (articles (gnus-data-list backward))
6713          (arts (gnus-data-find-list article articles))
6714          result)
6715     (when (or (not gnus-summary-check-current)
6716               (not unread)
6717               (not (gnus-data-unread-p (car arts))))
6718       (setq arts (cdr arts)))
6719     (while arts
6720       (and (or (not unread)
6721                (gnus-data-unread-p (car arts)))
6722            (vectorp (gnus-data-header (car arts)))
6723            (gnus-subject-equal
6724             simp-subject (mail-header-subject (gnus-data-header (car arts))) t)
6725            (setq result (car arts)
6726                  arts nil))
6727       (setq arts (cdr arts)))
6728     (and result
6729          (goto-char (gnus-data-pos result))
6730          (gnus-data-number result))))
6731
6732 (defun gnus-summary-search-forward (&optional unread subject backward)
6733   "Search forward for an article.
6734 If UNREAD, look for unread articles.  If SUBJECT, look for
6735 articles with that subject.  If BACKWARD, search backward instead."
6736   (cond (subject (gnus-summary-find-subject subject unread backward))
6737         (backward (gnus-summary-find-prev unread))
6738         (t (gnus-summary-find-next unread))))
6739
6740 (defun gnus-recenter (&optional n)
6741   "Center point in window and redisplay frame.
6742 Also do horizontal recentering."
6743   (interactive "P")
6744   (when (and gnus-auto-center-summary
6745              (not (eq gnus-auto-center-summary 'vertical)))
6746     (gnus-horizontal-recenter))
6747   (if (fboundp 'recenter-top-bottom)
6748       (recenter-top-bottom n)
6749     (recenter n)))
6750
6751 (put 'gnus-recenter 'isearch-scroll t)
6752
6753 (defun gnus-forward-line-ignore-invisible (n)
6754   "Move N lines forward (backward if N is negative).
6755 Like forward-line, but skip over (and don't count) invisible lines."
6756   (let (done)
6757     (while (and (> n 0) (not done))
6758       ;; If the following character is currently invisible,
6759       ;; skip all characters with that same `invisible' property value.
6760       (while (gnus-invisible-p (point))
6761         (goto-char (gnus-next-char-property-change (point))))
6762       (forward-line 1)
6763       (if (eobp)
6764           (setq done t)
6765         (setq n (1- n))))
6766     (while (and (< n 0) (not done))
6767       (forward-line -1)
6768       (if (bobp) (setq done t)
6769         (setq n (1+ n))
6770         (while (and (not (bobp)) (gnus-invisible-p (1- (point))))
6771           (goto-char (gnus-previous-char-property-change (point))))))))
6772
6773 (defun gnus-summary-recenter ()
6774   "Center point in the summary window.
6775 If `gnus-auto-center-summary' is nil, or the article buffer isn't
6776 displayed, no centering will be performed."
6777   ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
6778   ;; Recenter only when requested.  Suggested by popovich@park.cs.columbia.edu.
6779   (interactive)
6780   ;; The user has to want it.
6781   (when gnus-auto-center-summary
6782     (let* ((top (cond ((< (window-height) 4) 0)
6783                       ((< (window-height) 7) 1)
6784                       (t (if (numberp gnus-auto-center-summary)
6785                              gnus-auto-center-summary
6786                            (/ (1- (window-height)) 2)))))
6787            (height (1- (window-height)))
6788            (bottom (save-excursion
6789                      (goto-char (point-max))
6790                      (gnus-forward-line-ignore-invisible (- height))
6791                      (point)))
6792            (window (get-buffer-window (current-buffer))))
6793       (when (get-buffer-window gnus-article-buffer)
6794         ;; Only do recentering when the article buffer is displayed,
6795         ;; Set the window start to either `bottom', which is the biggest
6796         ;; possible valid number, or the second line from the top,
6797         ;; whichever is the least.
6798         (let ((top-pos (save-excursion
6799                          (gnus-forward-line-ignore-invisible (- top))
6800                          (point))))
6801           (if (> bottom top-pos)
6802               ;; Keep the second line from the top visible
6803               (set-window-start window top-pos)
6804             ;; Try to keep the bottom line visible; if it's partially
6805             ;; obscured, either scroll one more line to make it fully
6806             ;; visible, or revert to using TOP-POS.
6807             (save-excursion
6808               (goto-char (point-max))
6809               (gnus-forward-line-ignore-invisible -1)
6810               (let ((last-line-start (point)))
6811                 (goto-char bottom)
6812                 (set-window-start window (point) t)
6813                 (when (not (pos-visible-in-window-p last-line-start window))
6814                   (gnus-forward-line-ignore-invisible 1)
6815                   (set-window-start window (min (point) top-pos) t)))))))
6816       ;; Do horizontal recentering while we're at it.
6817       (when (and (get-buffer-window (current-buffer) t)
6818                  (not (eq gnus-auto-center-summary 'vertical)))
6819         (let ((selected (selected-window)))
6820           (select-window (get-buffer-window (current-buffer) t))
6821           (gnus-summary-position-point)
6822           (gnus-horizontal-recenter)
6823           (select-window selected))))))
6824
6825 (defun gnus-summary-jump-to-group (newsgroup)
6826   "Move point to NEWSGROUP in group mode buffer."
6827   ;; Keep update point of group mode buffer if visible.
6828   (if (eq (current-buffer) (get-buffer gnus-group-buffer))
6829       (save-window-excursion
6830         ;; Take care of tree window mode.
6831         (when (get-buffer-window gnus-group-buffer)
6832           (pop-to-buffer gnus-group-buffer))
6833         (gnus-group-jump-to-group newsgroup))
6834     (save-excursion
6835       ;; Take care of tree window mode.
6836       (if (get-buffer-window gnus-group-buffer 0)
6837           (pop-to-buffer gnus-group-buffer)
6838         (set-buffer gnus-group-buffer))
6839       (gnus-group-jump-to-group newsgroup))))
6840
6841 ;; This function returns a list of article numbers based on the
6842 ;; difference between the ranges of read articles in this group and
6843 ;; the range of active articles.
6844 (defun gnus-list-of-unread-articles (group)
6845   (let* ((read (gnus-info-read (gnus-get-info group)))
6846          (active (or (gnus-active group) (gnus-activate-group group)))
6847          (last (or (cdr active)
6848                    (error "Group %s couldn't be activated " group)))
6849          (bottom (if gnus-newsgroup-maximum-articles
6850                      (max (car active)
6851                           (- last gnus-newsgroup-maximum-articles -1))
6852                    (car active)))
6853          first nlast unread)
6854     ;; If none are read, then all are unread.
6855     (if (not read)
6856         (setq first bottom)
6857       ;; If the range of read articles is a single range, then the
6858       ;; first unread article is the article after the last read
6859       ;; article.  Sounds logical, doesn't it?
6860       (if (and (not (listp (cdr read)))
6861                (or (< (car read) bottom)
6862                    (progn (setq read (list read))
6863                           nil)))
6864           (setq first (max bottom (1+ (cdr read))))
6865         ;; `read' is a list of ranges.
6866         (when (/= (setq nlast (or (and (numberp (car read)) (car read))
6867                                   (caar read)))
6868                   1)
6869           (setq first bottom))
6870         (while read
6871           (when first
6872             (while (< first nlast)
6873               (setq unread (cons first unread)
6874                     first (1+ first))))
6875           (setq first (1+ (if (atom (car read)) (car read) (cdar read))))
6876           (setq nlast (if (atom (cadr read)) (cadr read) (caadr read)))
6877           (setq read (cdr read)))))
6878     ;; And add the last unread articles.
6879     (while (<= first last)
6880       (setq unread (cons first unread)
6881             first (1+ first)))
6882     ;; Return the list of unread articles.
6883     (delq 0 (nreverse unread))))
6884
6885 (defun gnus-list-of-read-articles (group)
6886   "Return a list of unread, unticked and non-dormant articles."
6887   (let* ((info (gnus-get-info group))
6888          (marked (gnus-info-marks info))
6889          (active (gnus-active group)))
6890     (and info active
6891          (gnus-list-range-difference
6892           (gnus-list-range-difference
6893            (gnus-sorted-complement
6894             (gnus-uncompress-range
6895              (if gnus-newsgroup-maximum-articles
6896                  (cons (max (car active)
6897                             (- (cdr active)
6898                                gnus-newsgroup-maximum-articles
6899                                -1))
6900                        (cdr active))
6901                active))
6902             (gnus-list-of-unread-articles group))
6903            (cdr (assq 'dormant marked)))
6904           (cdr (assq 'tick marked))))))
6905
6906 ;; This function returns a sequence of article numbers based on the
6907 ;; difference between the ranges of read articles in this group and
6908 ;; the range of active articles.
6909 (defun gnus-sequence-of-unread-articles (group)
6910   (let* ((read (gnus-info-read (gnus-get-info group)))
6911          (active (or (gnus-active group) (gnus-activate-group group)))
6912          (last (cdr active))
6913          (bottom (if gnus-newsgroup-maximum-articles
6914                      (max (car active)
6915                           (- last gnus-newsgroup-maximum-articles -1))
6916                    (car active)))
6917          first nlast unread)
6918     ;; If none are read, then all are unread.
6919     (if (not read)
6920         (setq first bottom)
6921       ;; If the range of read articles is a single range, then the
6922       ;; first unread article is the article after the last read
6923       ;; article.  Sounds logical, doesn't it?
6924       (if (and (not (listp (cdr read)))
6925                (or (< (car read) bottom)
6926                    (progn (setq read (list read))
6927                           nil)))
6928           (setq first (max bottom (1+ (cdr read))))
6929         ;; `read' is a list of ranges.
6930         (when (/= (setq nlast (or (and (numberp (car read)) (car read))
6931                                   (caar read)))
6932                   1)
6933           (setq first bottom))
6934         (while read
6935           (when first
6936             (push (cons first nlast) unread))
6937           (setq first (1+ (if (atom (car read)) (car read) (cdar read))))
6938           (setq nlast (if (atom (cadr read)) (cadr read) (caadr read)))
6939           (setq read (cdr read)))))
6940     ;; And add the last unread articles.
6941     (cond ((not (and first last))
6942            nil)
6943           ((< first last)
6944            (push (cons first last) unread))
6945           ((= first last)
6946            (push first unread)))
6947     ;; Return the sequence of unread articles.
6948     (delq 0 (nreverse unread))))
6949
6950 ;; Various summary commands
6951
6952 (defun gnus-summary-select-article-buffer ()
6953   "Reconfigure windows to show the article buffer.
6954 If `gnus-widen-article-buffer' is set, show only the article
6955 buffer."
6956   (interactive)
6957   (if (not (gnus-buffer-live-p gnus-article-buffer))
6958       (error "There is no article buffer for this summary buffer")
6959     (unless (get-buffer-window gnus-article-buffer)
6960       (gnus-summary-show-article))
6961     (gnus-configure-windows
6962      (if gnus-widen-article-window
6963          'only-article
6964        'article)
6965      t)
6966     (select-window (get-buffer-window gnus-article-buffer))))
6967
6968 (defun gnus-summary-universal-argument (arg)
6969   "Perform any operation on all articles that are process/prefixed."
6970   (interactive "P")
6971   (let ((articles (gnus-summary-work-articles arg))
6972         func article)
6973     (if (eq
6974          (setq
6975           func
6976           (key-binding
6977            (read-key-sequence
6978             (substitute-command-keys
6979              "\\<gnus-summary-mode-map>\\[gnus-summary-universal-argument]"))))
6980          'undefined)
6981         (gnus-error 1 "Undefined key")
6982       (save-excursion
6983         (while articles
6984           (gnus-summary-goto-subject (setq article (pop articles)))
6985           (let (gnus-newsgroup-processable)
6986             (command-execute func))
6987           (gnus-summary-remove-process-mark article)))))
6988   (gnus-summary-position-point))
6989
6990 (defun gnus-summary-toggle-truncation (&optional arg)
6991   "Toggle truncation of summary lines.
6992 With ARG, turn line truncation on if ARG is positive."
6993   (interactive "P")
6994   (setq truncate-lines
6995         (if (null arg) (not truncate-lines)
6996           (> (prefix-numeric-value arg) 0)))
6997   (redraw-display))
6998
6999 (defun gnus-summary-find-for-reselect ()
7000   "Return the number of an article to stay on across a reselect.
7001 The current article is considered, then following articles, then previous
7002 articles.  An article is sought which is not cancelled and isn't a temporary
7003 insertion from another group.  If there's no such then return a dummy 0."
7004   (let (found)
7005     (dolist (rev '(nil t))
7006       (unless found      ; don't demand the reverse list if we don't need it
7007         (let ((data (gnus-data-find-list
7008                      (gnus-summary-article-number) (gnus-data-list rev))))
7009           (while (and data (not found))
7010             (if (and (< 0 (gnus-data-number (car data)))
7011                      (not (eq gnus-canceled-mark (gnus-data-mark (car data)))))
7012                 (setq found (gnus-data-number (car data))))
7013             (setq data (cdr data))))))
7014     (or found 0)))
7015
7016 (defun gnus-summary-reselect-current-group (&optional all rescan)
7017   "Exit and then reselect the current newsgroup.
7018 The prefix argument ALL means to select all articles."
7019   (interactive "P")
7020   (when (gnus-ephemeral-group-p gnus-newsgroup-name)
7021     (error "Ephemeral groups can't be reselected"))
7022   (let ((current-subject (gnus-summary-find-for-reselect))
7023         (group gnus-newsgroup-name))
7024     (setq gnus-newsgroup-begin nil)
7025     (gnus-summary-exit nil 'leave-hidden)
7026     ;; We have to adjust the point of group mode buffer because
7027     ;; point was moved to the next unread newsgroup by exiting.
7028     (gnus-summary-jump-to-group group)
7029     (when rescan
7030       (save-excursion
7031         (gnus-group-get-new-news-this-group 1)))
7032     (gnus-group-read-group all t)
7033     (gnus-summary-goto-subject current-subject nil t)))
7034
7035 (defun gnus-summary-rescan-group (&optional all)
7036   "Exit the newsgroup, ask for new articles, and select the newsgroup."
7037   (interactive "P")
7038   (let ((config gnus-current-window-configuration))
7039     (gnus-summary-reselect-current-group all t)
7040     (gnus-configure-windows config)
7041     (when (eq config 'article)
7042       (gnus-summary-select-article))))
7043
7044 (defun gnus-summary-update-info (&optional non-destructive)
7045   (save-excursion
7046     (let ((group gnus-newsgroup-name))
7047       (when group
7048         (when gnus-newsgroup-kill-headers
7049           (setq gnus-newsgroup-killed
7050                 (gnus-compress-sequence
7051                  (gnus-sorted-union
7052                   (gnus-list-range-intersection
7053                    gnus-newsgroup-unselected gnus-newsgroup-killed)
7054                   gnus-newsgroup-unreads)
7055                  t)))
7056         (unless (listp (cdr gnus-newsgroup-killed))
7057           (setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
7058         (let ((headers gnus-newsgroup-headers))
7059           ;; Set the new ranges of read articles.
7060           (with-current-buffer gnus-group-buffer
7061             (gnus-undo-force-boundary))
7062           (gnus-update-read-articles
7063            group (gnus-sorted-union
7064                   gnus-newsgroup-unreads gnus-newsgroup-unselected))
7065           ;; Set the current article marks.
7066           (let ((gnus-newsgroup-scored
7067                  (if (and (not gnus-save-score)
7068                           (not non-destructive))
7069                      nil
7070                    gnus-newsgroup-scored)))
7071             (save-excursion
7072               (gnus-update-marks)))
7073           ;; Do the cross-ref thing.
7074           (when gnus-use-cross-reference
7075             (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads))
7076           ;; Do not switch windows but change the buffer to work.
7077           (set-buffer gnus-group-buffer)
7078           (unless (gnus-ephemeral-group-p group)
7079             (gnus-group-update-group group)))))))
7080
7081 (defun gnus-summary-save-newsrc (&optional force)
7082   "Save the current number of read/marked articles in the dribble buffer.
7083 The dribble buffer will then be saved.
7084 If FORCE (the prefix), also save the .newsrc file(s)."
7085   (interactive "P")
7086   (gnus-summary-update-info t)
7087   (if force
7088       (gnus-save-newsrc-file)
7089     (gnus-dribble-save)))
7090
7091 (declare-function gnus-cache-write-active "gnus-cache" (&optional force))
7092
7093 (defun gnus-summary-exit (&optional temporary leave-hidden)
7094   "Exit reading current newsgroup, and then return to group selection mode.
7095 `gnus-exit-group-hook' is called with no arguments if that value is non-nil."
7096   (interactive)
7097   (gnus-set-global-variables)
7098   (when (gnus-buffer-live-p gnus-article-buffer)
7099     (with-current-buffer gnus-article-buffer
7100       (mm-destroy-parts gnus-article-mime-handles)
7101       ;; Set it to nil for safety reason.
7102       (setq gnus-article-mime-handle-alist nil)
7103       (setq gnus-article-mime-handles nil)))
7104   (gnus-kill-save-kill-buffer)
7105   (gnus-async-halt-prefetch)
7106   (let* ((group gnus-newsgroup-name)
7107          (quit-config (gnus-group-quit-config gnus-newsgroup-name))
7108          (gnus-group-is-exiting-p t)
7109          (mode major-mode)
7110          (group-point nil)
7111          (buf (current-buffer)))
7112     (unless quit-config
7113       ;; Do adaptive scoring, and possibly save score files.
7114       (when gnus-newsgroup-adaptive
7115         (gnus-score-adaptive))
7116       (when gnus-use-scoring
7117         (gnus-score-save)))
7118     (gnus-run-hooks 'gnus-summary-prepare-exit-hook)
7119     (when gnus-use-cache
7120       (gnus-cache-possibly-remove-articles)
7121       (gnus-cache-save-buffers))
7122     (gnus-async-prefetch-remove-group group)
7123     (when gnus-suppress-duplicates
7124       (gnus-dup-enter-articles))
7125     (when gnus-use-trees
7126       (gnus-tree-close group))
7127     (when gnus-use-cache
7128       (gnus-cache-write-active))
7129     ;; Remove entries for this group.
7130     (nnmail-purge-split-history (gnus-group-real-name group))
7131     ;; Make all changes in this group permanent.
7132     (unless quit-config
7133       (gnus-run-hooks 'gnus-exit-group-hook)
7134       (gnus-summary-update-info))
7135     (gnus-close-group group)
7136     ;; Make sure where we were, and go to next newsgroup.
7137     (set-buffer gnus-group-buffer)
7138     (unless quit-config
7139       (gnus-group-jump-to-group group))
7140     (gnus-run-hooks 'gnus-summary-exit-hook)
7141     (unless (or quit-config
7142                 (not gnus-summary-next-group-on-exit)
7143                 ;; If this group has disappeared from the summary
7144                 ;; buffer, don't skip forwards.
7145                 (not (string= group (gnus-group-group-name))))
7146       (gnus-group-next-unread-group 1))
7147     (setq group-point (point))
7148     (if temporary
7149         nil                             ;Nothing to do.
7150       (set-buffer buf)
7151       (if (not gnus-kill-summary-on-exit)
7152           (progn
7153             (gnus-deaden-summary)
7154             (setq mode nil))
7155         (when (get-buffer gnus-article-buffer)
7156           (bury-buffer gnus-article-buffer))
7157         ;; Return to group mode buffer.
7158         (when (eq mode 'gnus-summary-mode)
7159           (gnus-kill-buffer buf)))
7160
7161       ;; If we have several article buffers, we kill them at exit.
7162       (unless gnus-single-article-buffer
7163         (when (gnus-buffer-live-p gnus-article-buffer)
7164           (with-current-buffer gnus-article-buffer
7165             ;; Don't kill sticky article buffers
7166             (unless (eq major-mode 'gnus-sticky-article-mode)
7167               (gnus-kill-buffer gnus-article-buffer)
7168               (setq gnus-article-current nil))))
7169         (gnus-kill-buffer gnus-original-article-buffer))
7170
7171       (setq gnus-current-select-method gnus-select-method)
7172       (set-buffer gnus-group-buffer)
7173       (if quit-config
7174           (gnus-handle-ephemeral-exit quit-config)
7175         (goto-char group-point)
7176         ;; If gnus-group-buffer is already displayed, make sure we also move
7177         ;; the cursor in the window that displays it.
7178         (let ((win (get-buffer-window (current-buffer) 0)))
7179           (if win (set-window-point win (point))))
7180         (unless leave-hidden
7181           (gnus-configure-windows 'group 'force)))
7182       ;; Clear the current group name.
7183       (unless quit-config
7184         (setq gnus-newsgroup-name nil)))))
7185
7186 (defalias 'gnus-summary-quit 'gnus-summary-exit-no-update)
7187 (defun gnus-summary-exit-no-update (&optional no-questions)
7188   "Quit reading current newsgroup without updating read article info."
7189   (interactive)
7190   (let* ((group gnus-newsgroup-name)
7191          (gnus-group-is-exiting-p t)
7192          (gnus-group-is-exiting-without-update-p t)
7193          (quit-config (gnus-group-quit-config group)))
7194     (when (or no-questions
7195               gnus-expert-user
7196               (gnus-y-or-n-p "Discard changes to this group and exit? "))
7197       (gnus-async-halt-prefetch)
7198       (run-hooks 'gnus-summary-prepare-exit-hook)
7199       (when (gnus-buffer-live-p gnus-article-buffer)
7200         (with-current-buffer gnus-article-buffer
7201           (mm-destroy-parts gnus-article-mime-handles)
7202           ;; Set it to nil for safety reason.
7203           (setq gnus-article-mime-handle-alist nil)
7204           (setq gnus-article-mime-handles nil)))
7205       ;; If we have several article buffers, we kill them at exit.
7206       (unless gnus-single-article-buffer
7207         (gnus-kill-buffer gnus-article-buffer)
7208         (gnus-kill-buffer gnus-original-article-buffer)
7209         (setq gnus-article-current nil))
7210       (if (not gnus-kill-summary-on-exit)
7211           (gnus-deaden-summary)
7212         (gnus-close-group group)
7213         (gnus-kill-buffer gnus-summary-buffer))
7214       (unless gnus-single-article-buffer
7215         (setq gnus-article-current nil))
7216       (when gnus-use-trees
7217         (gnus-tree-close group))
7218       (gnus-async-prefetch-remove-group group)
7219       (when (get-buffer gnus-article-buffer)
7220         (bury-buffer gnus-article-buffer))
7221       ;; Return to the group buffer.
7222       (gnus-configure-windows 'group 'force)
7223       ;; Clear the current group name.
7224       (setq gnus-newsgroup-name nil)
7225       (unless (gnus-ephemeral-group-p group)
7226         (gnus-group-update-group group))
7227       (when (equal (gnus-group-group-name) group)
7228         (gnus-group-next-unread-group 1))
7229       (when quit-config
7230         (gnus-handle-ephemeral-exit quit-config)))))
7231
7232 (defun gnus-handle-ephemeral-exit (quit-config)
7233   "Handle movement when leaving an ephemeral group.
7234 The state which existed when entering the ephemeral is reset."
7235   (if (not (buffer-name (car quit-config)))
7236       (gnus-configure-windows 'group 'force)
7237     (set-buffer (car quit-config))
7238     (cond ((eq major-mode 'gnus-summary-mode)
7239            (gnus-set-global-variables))
7240           ((eq major-mode 'gnus-article-mode)
7241            (save-current-buffer
7242              ;; The `gnus-summary-buffer' variable may point
7243              ;; to the old summary buffer when using a single
7244              ;; article buffer.
7245              (unless (gnus-buffer-live-p gnus-summary-buffer)
7246                (set-buffer gnus-group-buffer))
7247              (set-buffer gnus-summary-buffer)
7248              (gnus-set-global-variables))))
7249     (if (or (eq (cdr quit-config) 'article)
7250             (eq (cdr quit-config) 'pick))
7251         (if (and (boundp 'gnus-pick-mode) (symbol-value 'gnus-pick-mode))
7252             (gnus-configure-windows 'pick 'force)
7253           (gnus-configure-windows (cdr quit-config) 'force))
7254       (gnus-configure-windows (cdr quit-config) 'force))
7255     (when (eq major-mode 'gnus-summary-mode)
7256       (if (memq gnus-auto-select-on-ephemeral-exit '(next-noselect
7257                                                      next-unread-noselect))
7258           (when (zerop (cond ((eq gnus-auto-select-on-ephemeral-exit
7259                                   'next-noselect)
7260                               (gnus-summary-next-subject 1 nil t))
7261                              ((eq gnus-auto-select-on-ephemeral-exit
7262                                   'next-unread-noselect)
7263                               (gnus-summary-next-subject 1 t t))))
7264             ;; Hide the article buffer which displays the article different
7265             ;; from the one that the cursor points to in the summary buffer.
7266             (gnus-configure-windows 'summary 'force))
7267         (cond ((eq gnus-auto-select-on-ephemeral-exit 'next)
7268                (gnus-summary-next-subject 1))
7269               ((eq gnus-auto-select-on-ephemeral-exit 'next-unread)
7270                (gnus-summary-next-subject 1 t))))
7271       (gnus-summary-recenter)
7272       (gnus-summary-position-point))))
7273
7274 ;;; Dead summaries.
7275
7276 (defvar gnus-dead-summary-mode-map
7277   (let ((map (make-keymap)))
7278     (suppress-keymap map)
7279     (substitute-key-definition 'undefined 'gnus-summary-wake-up-the-dead map)
7280     (dolist (key '("\C-d" "\r" "\177" [delete]))
7281       (define-key map key 'gnus-summary-wake-up-the-dead))
7282     (dolist (key '("q" "Q"))
7283       (define-key map key 'bury-buffer))
7284     map))
7285
7286 (define-minor-mode gnus-dead-summary-mode
7287   "Minor mode for Gnus summary buffers."
7288   :lighter " Dead" :keymap gnus-dead-summary-mode-map
7289   (unless (derived-mode-p 'gnus-summary-mode)
7290     (setq gnus-dead-summary-mode nil)))
7291
7292 (defun gnus-deaden-summary ()
7293   "Make the current summary buffer into a dead summary buffer."
7294   ;; Kill any previous dead summary buffer.
7295   (when (and gnus-dead-summary
7296              (buffer-name gnus-dead-summary))
7297     (with-current-buffer gnus-dead-summary
7298       (when gnus-dead-summary-mode
7299         (kill-buffer (current-buffer)))))
7300   ;; Make this the current dead summary.
7301   (setq gnus-dead-summary (current-buffer))
7302   (gnus-dead-summary-mode 1)
7303   (let ((name (buffer-name)))
7304     (when (string-match "Summary" name)
7305       (rename-buffer
7306        (concat (substring name 0 (match-beginning 0)) "Dead "
7307                (substring name (match-beginning 0)))
7308        t)
7309       (bury-buffer))))
7310
7311 (defun gnus-kill-or-deaden-summary (buffer)
7312   "Kill or deaden the summary BUFFER."
7313   (save-excursion
7314     (when (and (buffer-name buffer)
7315                (not gnus-single-article-buffer))
7316       (with-current-buffer buffer
7317         (gnus-kill-buffer gnus-article-buffer)
7318         (gnus-kill-buffer gnus-original-article-buffer)))
7319     (cond
7320      ;; Kill the buffer.
7321      (gnus-kill-summary-on-exit
7322       (when (and gnus-use-trees
7323                  (gnus-buffer-exists-p buffer))
7324         (with-current-buffer buffer
7325           (gnus-tree-close gnus-newsgroup-name)))
7326       (gnus-kill-buffer buffer))
7327      ;; Deaden the buffer.
7328      ((gnus-buffer-exists-p buffer)
7329       (with-current-buffer buffer
7330         (gnus-deaden-summary))))))
7331
7332 (defun gnus-summary-wake-up-the-dead (&rest args)
7333   "Wake up the dead summary buffer."
7334   (interactive)
7335   (gnus-dead-summary-mode -1)
7336   (let ((name (buffer-name)))
7337     (when (string-match "Dead " name)
7338       (rename-buffer
7339        (concat (substring name 0 (match-beginning 0))
7340                (substring name (match-end 0)))
7341        t)))
7342   (gnus-message 3 "This dead summary is now alive again"))
7343
7344 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
7345 (defun gnus-summary-describe-group (&optional force)
7346   "Describe the current newsgroup."
7347   (interactive "P")
7348   (gnus-group-describe-group force gnus-newsgroup-name))
7349
7350 (defun gnus-summary-describe-briefly ()
7351   "Describe summary mode commands briefly."
7352   (interactive)
7353   (gnus-message 6 "%s" (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")))
7354
7355 ;; Walking around group mode buffer from summary mode.
7356
7357 (defun gnus-summary-next-group (&optional no-article target-group backward)
7358   "Exit current newsgroup and then select next unread newsgroup.
7359 If prefix argument NO-ARTICLE is non-nil, no article is selected
7360 initially.  If TARGET-GROUP, go to this group.  If BACKWARD, go to
7361 previous group instead."
7362   (interactive "P")
7363   ;; Stop pre-fetching.
7364   (gnus-async-halt-prefetch)
7365   (let ((current-group gnus-newsgroup-name)
7366         (current-buffer (current-buffer))
7367         entered)
7368     ;; First we semi-exit this group to update Xrefs and all variables.
7369     ;; We can't do a real exit, because the window conf must remain
7370     ;; the same in case the user is prompted for info, and we don't
7371     ;; want the window conf to change before that...
7372     (gnus-summary-exit t)
7373     (while (not entered)
7374       ;; Then we find what group we are supposed to enter.
7375       (set-buffer gnus-group-buffer)
7376       (gnus-group-jump-to-group current-group)
7377       (setq target-group
7378             (or target-group
7379                 (if (eq gnus-keep-same-level 'best)
7380                     (gnus-summary-best-group gnus-newsgroup-name)
7381                   (gnus-summary-search-group backward gnus-keep-same-level))))
7382       (if (not target-group)
7383           ;; There are no further groups, so we return to the group
7384           ;; buffer.
7385           (progn
7386             (gnus-message 5 "Returning to the group buffer")
7387             (setq entered t)
7388             (when (gnus-buffer-live-p current-buffer)
7389               (set-buffer current-buffer)
7390               (gnus-summary-exit))
7391             (gnus-run-hooks 'gnus-group-no-more-groups-hook))
7392         ;; We try to enter the target group.
7393         (gnus-group-jump-to-group target-group)
7394         (let ((unreads (gnus-group-group-unread)))
7395           (if (and (or (eq t unreads)
7396                        (and unreads (not (zerop unreads))))
7397                    (gnus-summary-read-group
7398                     target-group nil no-article
7399                     (and (buffer-name current-buffer) current-buffer)
7400                     nil backward))
7401               (setq entered t)
7402             (setq current-group target-group
7403                   target-group nil)))))))
7404
7405 (defun gnus-summary-prev-group (&optional no-article)
7406   "Exit current newsgroup and then select previous unread newsgroup.
7407 If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
7408   (interactive "P")
7409   (gnus-summary-next-group no-article nil t))
7410
7411 ;; Walking around summary lines.
7412
7413 (defun gnus-summary-first-subject (&optional unread undownloaded unseen)
7414   "Go to the first subject satisfying any non-nil constraint.
7415 If UNREAD is non-nil, the article should be unread.
7416 If UNDOWNLOADED is non-nil, the article should be undownloaded.
7417 If UNSEEN is non-nil, the article should be unseen as well as unread.
7418 Returns the article selected or nil if there are no matching articles."
7419   (interactive "P")
7420   (cond
7421    ;; Empty summary.
7422    ((null gnus-newsgroup-data)
7423     (gnus-message 3 "No articles in the group")
7424     nil)
7425    ;; Pick the first article.
7426    ((not (or unread undownloaded unseen))
7427     (goto-char (gnus-data-pos (car gnus-newsgroup-data)))
7428     (gnus-data-number (car gnus-newsgroup-data)))
7429    ;; Find the first unread article.
7430    (t
7431     (let ((data gnus-newsgroup-data))
7432       (while (and data
7433                   (let ((num (gnus-data-number (car data))))
7434                     (or (memq num gnus-newsgroup-unfetched)
7435                         (not (or (and unread
7436                                       (memq num gnus-newsgroup-unreads))
7437                                  (and undownloaded
7438                                       (memq num gnus-newsgroup-undownloaded))
7439                                  (and unseen
7440                                       (memq num gnus-newsgroup-unseen)
7441                                       (memq num gnus-newsgroup-unreads)))))))
7442         (setq data (cdr data)))
7443       (prog1
7444           (if data
7445               (progn
7446                 (goto-char (gnus-data-pos (car data)))
7447                 (gnus-data-number (car data)))
7448             (gnus-message 3 "No more%s articles"
7449                           (let* ((r (when unread " unread"))
7450                                  (d (when undownloaded " undownloaded"))
7451                                  (s (when unseen " unseen"))
7452                                  (l (delq nil (list r d s))))
7453                             (cond ((= 3 (length l))
7454                                    (concat r "," d ", or" s))
7455                                   ((= 2 (length l))
7456                                    (concat (car l) ", or" (cadr l)))
7457                                   ((= 1 (length l))
7458                                    (car l))
7459                                   (t
7460                                    ""))))
7461             nil
7462             )
7463         (gnus-summary-position-point))))))
7464
7465 (defun gnus-summary-next-subject (n &optional unread dont-display)
7466   "Go to next N'th summary line.
7467 If N is negative, go to the previous N'th subject line.
7468 If UNREAD is non-nil, only unread articles are selected.
7469 The difference between N and the actual number of steps taken is
7470 returned."
7471   (interactive "p")
7472   (let ((backward (< n 0))
7473         (n (abs n)))
7474     (while (and (> n 0)
7475                 (if backward
7476                     (gnus-summary-find-prev unread)
7477                   (gnus-summary-find-next unread)))
7478       (unless (zerop (setq n (1- n)))
7479         (gnus-summary-show-thread)))
7480     (when (/= 0 n)
7481       (gnus-message 7 "No more%s articles"
7482                     (if unread " unread" "")))
7483     (unless dont-display
7484       (gnus-summary-recenter)
7485       (gnus-summary-position-point))
7486     n))
7487
7488 (defun gnus-summary-next-unread-subject (n)
7489   "Go to next N'th unread summary line."
7490   (interactive "p")
7491   (gnus-summary-next-subject n t))
7492
7493 (defun gnus-summary-prev-subject (n &optional unread)
7494   "Go to previous N'th summary line.
7495 If optional argument UNREAD is non-nil, only unread article is selected."
7496   (interactive "p")
7497   (gnus-summary-next-subject (- n) unread))
7498
7499 (defun gnus-summary-prev-unread-subject (n)
7500   "Go to previous N'th unread summary line."
7501   (interactive "p")
7502   (gnus-summary-next-subject (- n) t))
7503
7504 (defun gnus-summary-goto-subjects (articles)
7505   "Insert the subject header for ARTICLES in the current buffer."
7506   (save-excursion
7507     (dolist (article articles)
7508       (gnus-summary-goto-subject article t)))
7509   (gnus-summary-limit (append articles gnus-newsgroup-limit))
7510   (gnus-summary-position-point))
7511
7512 (defun gnus-summary-goto-subject (article &optional force silent)
7513   "Go to the subject line of ARTICLE.
7514 If FORCE, also allow jumping to articles not currently shown."
7515   (interactive "nArticle number: ")
7516   (unless (numberp article)
7517     (error "Article %s is not a number" article))
7518   (let ((b (point))
7519         (data (gnus-data-find article)))
7520     ;; We read in the article if we have to.
7521     (and (not data)
7522          force
7523          (gnus-summary-insert-subject
7524           article
7525           (if (or (numberp force) (vectorp force)) force)
7526           t)
7527          (setq data (gnus-data-find article)))
7528     (goto-char b)
7529     (if (not data)
7530         (progn
7531           (unless silent
7532             (gnus-message 3 "Can't find article %d" article))
7533           nil)
7534       (let ((pt (gnus-data-pos data)))
7535         (goto-char pt)
7536         (gnus-summary-set-article-display-arrow pt))
7537       (gnus-summary-position-point)
7538       article)))
7539
7540 ;; Walking around summary lines with displaying articles.
7541
7542 (defun gnus-summary-expand-window (&optional arg)
7543   "Make the summary buffer take up the entire Emacs frame.
7544 Given a prefix, will force an `article' buffer configuration."
7545   (interactive "P")
7546   (if arg
7547       (gnus-configure-windows 'article 'force)
7548     (gnus-configure-windows 'summary 'force)))
7549
7550 (defun gnus-summary-display-article (article &optional all-header)
7551   "Display ARTICLE in article buffer."
7552   (unless (and (gnus-buffer-live-p gnus-article-buffer)
7553                (with-current-buffer gnus-article-buffer
7554                  (eq major-mode 'gnus-article-mode)))
7555     (gnus-article-setup-buffer))
7556   (gnus-set-global-variables)
7557   (with-current-buffer gnus-article-buffer
7558     (setq gnus-article-charset gnus-newsgroup-charset)
7559     (setq gnus-article-ignored-charsets gnus-newsgroup-ignored-charsets)
7560     (mm-enable-multibyte))
7561   (if (null article)
7562       nil
7563     (prog1
7564         (if gnus-summary-display-article-function
7565             (funcall gnus-summary-display-article-function article all-header)
7566           (gnus-article-prepare article all-header))
7567       (gnus-run-hooks 'gnus-select-article-hook)
7568       (when (and gnus-current-article
7569                  (not (zerop gnus-current-article)))
7570         (gnus-summary-goto-subject gnus-current-article))
7571       (gnus-summary-recenter)
7572       (when (and gnus-use-trees gnus-show-threads)
7573         (gnus-possibly-generate-tree article)
7574         (gnus-highlight-selected-tree article))
7575       ;; Successfully display article.
7576       (gnus-article-set-window-start
7577        (cdr (assq article gnus-newsgroup-bookmarks))))))
7578
7579 (defun gnus-summary-select-article (&optional all-headers force pseudo article)
7580   "Select the current article.
7581 If ALL-HEADERS is non-nil, show all header fields.  If FORCE is
7582 non-nil, the article will be re-fetched even if it already present in
7583 the article buffer.  If PSEUDO is non-nil, pseudo-articles will also
7584 be displayed."
7585   ;; Make sure we are in the summary buffer to work around bbdb bug.
7586   (unless (eq major-mode 'gnus-summary-mode)
7587     (set-buffer gnus-summary-buffer))
7588   (let ((article (or article (gnus-summary-article-number)))
7589         (all-headers (not (not all-headers))) ;Must be t or nil.
7590         gnus-summary-display-article-function)
7591     (and (not pseudo)
7592          (gnus-summary-article-pseudo-p article)
7593          (error "This is a pseudo-article"))
7594     (with-current-buffer gnus-summary-buffer
7595       (if (or (and gnus-single-article-buffer
7596                    (or (null gnus-current-article)
7597                        (null gnus-article-current)
7598                        (null (get-buffer gnus-article-buffer))
7599                        (not (eq article (cdr gnus-article-current)))
7600                        (not (equal (car gnus-article-current)
7601                                    gnus-newsgroup-name))
7602                        (not (get-buffer gnus-original-article-buffer))))
7603               (and (not gnus-single-article-buffer)
7604                    (or (null gnus-current-article)
7605                        (not (get-buffer gnus-original-article-buffer))
7606                        (not (eq gnus-current-article article))))
7607               force)
7608           ;; The requested article is different from the current article.
7609           (progn
7610             (gnus-summary-display-article article all-headers)
7611             (when (gnus-buffer-live-p gnus-article-buffer)
7612               (with-current-buffer gnus-article-buffer
7613                 (if (not gnus-article-decoded-p) ;; a local variable
7614                     (mm-disable-multibyte))))
7615             (gnus-article-set-window-start
7616              (cdr (assq article gnus-newsgroup-bookmarks)))
7617             article)
7618         'old))))
7619
7620 (defun gnus-summary-force-verify-and-decrypt ()
7621   "Display buttons for signed/encrypted parts and verify/decrypt them."
7622   (interactive)
7623   (let ((mm-verify-option 'known)
7624         (mm-decrypt-option 'known)
7625         (gnus-article-emulate-mime t)
7626         (gnus-buttonized-mime-types (append (list "multipart/signed"
7627                                                   "multipart/encrypted")
7628                                             gnus-buttonized-mime-types)))
7629     (gnus-summary-select-article nil 'force)))
7630
7631 (defun gnus-summary-set-current-mark (&optional current-mark)
7632   "Obsolete function."
7633   nil)
7634
7635 (defun gnus-summary-next-article (&optional unread subject backward push)
7636   "Select the next article.
7637 If UNREAD, only unread articles are selected.
7638 If SUBJECT, only articles with SUBJECT are selected.
7639 If BACKWARD, the previous article is selected instead of the next."
7640   (interactive "P")
7641   ;; Make sure we are in the summary buffer.
7642   (unless (eq major-mode 'gnus-summary-mode)
7643     (set-buffer gnus-summary-buffer))
7644   (cond
7645    ;; Is there such an article?
7646    ((and (gnus-summary-search-forward unread subject backward)
7647          (or (gnus-summary-display-article (gnus-summary-article-number))
7648              (eq (gnus-summary-article-mark) gnus-canceled-mark)))
7649     (gnus-summary-position-point))
7650    ;; If not, we try the first unread, if that is wanted.
7651    ((and subject
7652          gnus-auto-select-same
7653          (gnus-summary-first-unread-article))
7654     (gnus-summary-position-point)
7655     (gnus-message 6 "Wrapped"))
7656    ;; Try to get next/previous article not displayed in this group.
7657    ((and gnus-auto-extend-newsgroup
7658          (not unread) (not subject))
7659     (gnus-summary-goto-article
7660      (if backward (1- gnus-newsgroup-begin) (1+ gnus-newsgroup-end))
7661      nil (count-lines (point-min) (point))))
7662    ;; Go to next/previous group.
7663    (t
7664     (unless (gnus-ephemeral-group-p gnus-newsgroup-name)
7665       (gnus-summary-jump-to-group gnus-newsgroup-name))
7666     (let ((cmd (if (featurep 'xemacs)
7667                    last-command-char
7668                  last-command-event))
7669           (point
7670            (with-current-buffer gnus-group-buffer
7671              (point)))
7672           (group
7673            (if (eq gnus-keep-same-level 'best)
7674                (gnus-summary-best-group gnus-newsgroup-name)
7675              (gnus-summary-search-group backward gnus-keep-same-level))))
7676       ;; For some reason, the group window gets selected.  We change
7677       ;; it back.
7678       (select-window (get-buffer-window (current-buffer)))
7679       ;; Select next unread newsgroup automagically.
7680       (cond
7681        ((or (not gnus-auto-select-next)
7682             (not cmd))
7683         (gnus-message 7 "No more%s articles" (if unread " unread" "")))
7684        ((or (eq gnus-auto-select-next 'quietly)
7685             (and (eq gnus-auto-select-next 'slightly-quietly)
7686                  push)
7687             (and (eq gnus-auto-select-next 'almost-quietly)
7688                  (gnus-summary-last-article-p)))
7689         ;; Select quietly.
7690         (if (gnus-ephemeral-group-p gnus-newsgroup-name)
7691             (gnus-summary-exit)
7692           (gnus-message 7 "No more%s articles (%s)..."
7693                         (if unread " unread" "")
7694                         (if group (concat "selecting " group)
7695                           "exiting"))
7696           (gnus-summary-next-group nil group backward)))
7697        (t
7698         (when (gnus-key-press-event-p last-input-event)
7699           (gnus-summary-walk-group-buffer
7700            gnus-newsgroup-name cmd unread backward point))))))))
7701
7702 (defun gnus-summary-walk-group-buffer (from-group cmd unread backward start)
7703   (let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1))
7704                       (?\C-p (gnus-group-prev-unread-group 1))))
7705         (cursor-in-echo-area t)
7706         keve key group ended prompt)
7707     (with-current-buffer gnus-group-buffer
7708       (goto-char start)
7709       (setq group
7710             (if (eq gnus-keep-same-level 'best)
7711                 (gnus-summary-best-group gnus-newsgroup-name)
7712               (gnus-summary-search-group backward gnus-keep-same-level))))
7713     (while (not ended)
7714       (setq prompt
7715             (format
7716              "No more%s articles%s " (if unread " unread" "")
7717              (if (and group
7718                       (not (gnus-ephemeral-group-p gnus-newsgroup-name)))
7719                  (format " (Type %s for %s [%s])"
7720                          (single-key-description cmd)
7721                          (gnus-group-decoded-name group)
7722                          (gnus-group-unread group))
7723                (format " (Type %s to exit %s)"
7724                        (single-key-description cmd)
7725                        (gnus-group-decoded-name gnus-newsgroup-name)))))
7726       ;; Confirm auto selection.
7727       (setq key (car (setq keve (gnus-read-event-char prompt)))
7728             ended t)
7729       (cond
7730        ((assq key keystrokes)
7731         (let ((obuf (current-buffer)))
7732           (switch-to-buffer gnus-group-buffer)
7733           (when group
7734             (gnus-group-jump-to-group group))
7735           (eval (cadr (assq key keystrokes)))
7736           (setq group (gnus-group-group-name))
7737           (switch-to-buffer obuf))
7738         (setq ended nil))
7739        ((equal key cmd)
7740         (if (or (not group)
7741                 (gnus-ephemeral-group-p gnus-newsgroup-name))
7742             (gnus-summary-exit)
7743           (gnus-summary-next-group nil group backward)))
7744        (t
7745         (push (cdr keve) unread-command-events))))))
7746
7747 (defun gnus-summary-next-unread-article ()
7748   "Select unread article after current one."
7749   (interactive)
7750   (gnus-summary-next-article
7751    (or (not (eq gnus-summary-goto-unread 'never))
7752        (gnus-summary-last-article-p (gnus-summary-article-number)))
7753    (and gnus-auto-select-same
7754         (gnus-summary-article-subject))))
7755
7756 (defun gnus-summary-prev-article (&optional unread subject)
7757   "Select the article before the current one.
7758 If UNREAD is non-nil, only unread articles are selected."
7759   (interactive "P")
7760   (gnus-summary-next-article unread subject t))
7761
7762 (defun gnus-summary-prev-unread-article ()
7763   "Select unread article before current one."
7764   (interactive)
7765   (gnus-summary-prev-article
7766    (or (not (eq gnus-summary-goto-unread 'never))
7767        (gnus-summary-first-article-p (gnus-summary-article-number)))
7768    (and gnus-auto-select-same
7769         (gnus-summary-article-subject))))
7770
7771 (defun gnus-summary-next-page (&optional lines circular stop)
7772   "Show next page of the selected article.
7773 If at the end of the current article, select the next article.
7774 LINES says how many lines should be scrolled up.
7775
7776 If CIRCULAR is non-nil, go to the start of the article instead of
7777 selecting the next article when reaching the end of the current
7778 article.
7779
7780 If STOP is non-nil, just stop when reaching the end of the message.
7781
7782 Also see the variable `gnus-article-skip-boring'."
7783   (interactive "P")
7784   (setq gnus-summary-buffer (current-buffer))
7785   (gnus-set-global-variables)
7786   (let ((article (gnus-summary-article-number))
7787         (article-window (get-buffer-window gnus-article-buffer t))
7788         endp)
7789     ;; If the buffer is empty, we have no article.
7790     (unless article
7791       (error "No article to select"))
7792     (gnus-configure-windows 'article)
7793     (if (eq (cdr (assq article gnus-newsgroup-reads)) gnus-canceled-mark)
7794         (if (and (eq gnus-summary-goto-unread 'never)
7795                  (not (gnus-summary-last-article-p article)))
7796             (gnus-summary-next-article)
7797           (gnus-summary-next-unread-article))
7798       (if (or (null gnus-current-article)
7799               (null gnus-article-current)
7800               (/= article (cdr gnus-article-current))
7801               (not (equal (car gnus-article-current) gnus-newsgroup-name)))
7802           ;; Selected subject is different from current article's.
7803           (gnus-summary-display-article article)
7804         (when article-window
7805           (gnus-eval-in-buffer-window gnus-article-buffer
7806             (setq endp (or (gnus-article-next-page lines)
7807                            (gnus-article-only-boring-p))))
7808           (when endp
7809             (cond ((or stop gnus-summary-stop-at-end-of-message)
7810                    (gnus-message 3 "End of message"))
7811                   (circular
7812                    (gnus-summary-beginning-of-article))
7813                   (lines
7814                    (gnus-message 3 "End of message"))
7815                   ((null lines)
7816                    (if (and (eq gnus-summary-goto-unread 'never)
7817                             (not (gnus-summary-last-article-p article)))
7818                        (gnus-summary-next-article)
7819                      (gnus-summary-next-unread-article))))))))
7820     (gnus-summary-recenter)
7821     (gnus-summary-position-point)))
7822
7823 (defun gnus-summary-prev-page (&optional lines move)
7824   "Show previous page of selected article.
7825 Argument LINES specifies lines to be scrolled down.
7826 If MOVE, move to the previous unread article if point is at
7827 the beginning of the buffer."
7828   (interactive "P")
7829   (let ((article (gnus-summary-article-number))
7830         (article-window (get-buffer-window gnus-article-buffer t))
7831         endp)
7832     (gnus-configure-windows 'article)
7833     (if (or (null gnus-current-article)
7834             (null gnus-article-current)
7835             (/= article (cdr gnus-article-current))
7836             (not (equal (car gnus-article-current) gnus-newsgroup-name)))
7837         ;; Selected subject is different from current article's.
7838         (gnus-summary-display-article article)
7839       (gnus-summary-recenter)
7840       (when article-window
7841         (gnus-eval-in-buffer-window gnus-article-buffer
7842           (setq endp (gnus-article-prev-page lines)))
7843         (when (and move endp)
7844           (cond (lines
7845                  (gnus-message 3 "Beginning of message"))
7846                 ((null lines)
7847                  (if (and (eq gnus-summary-goto-unread 'never)
7848                           (not (gnus-summary-first-article-p article)))
7849                      (gnus-summary-prev-article)
7850                    (gnus-summary-prev-unread-article))))))))
7851   (gnus-summary-position-point))
7852
7853 (defun gnus-summary-prev-page-or-article (&optional lines)
7854   "Show previous page of selected article.
7855 Argument LINES specifies lines to be scrolled down.
7856 If at the beginning of the article, go to the next article."
7857   (interactive "P")
7858   (gnus-summary-prev-page lines t))
7859
7860 (defun gnus-summary-scroll-up (lines)
7861   "Scroll up (or down) one line current article.
7862 Argument LINES specifies lines to be scrolled up (or down if negative).
7863 If no article is selected, then the current article will be selected first."
7864   (interactive "p")
7865   (gnus-configure-windows 'article)
7866   (gnus-summary-show-thread)
7867   (when (eq (gnus-summary-select-article nil nil 'pseudo) 'old)
7868     (gnus-eval-in-buffer-window gnus-article-buffer
7869       (cond ((> lines 0)
7870              (when (gnus-article-next-page lines)
7871                (gnus-message 3 "End of message")))
7872             ((< lines 0)
7873              (gnus-article-prev-page (- lines))))))
7874   (gnus-summary-recenter)
7875   (gnus-summary-position-point))
7876
7877 (defun gnus-summary-scroll-down (lines)
7878   "Scroll down (or up) one line current article.
7879 Argument LINES specifies lines to be scrolled down (or up if negative).
7880 If no article is selected, then the current article will be selected first."
7881   (interactive "p")
7882   (gnus-summary-scroll-up (- lines)))
7883
7884 (defun gnus-summary-next-same-subject ()
7885   "Select next article which has the same subject as current one."
7886   (interactive)
7887   (gnus-summary-next-article nil (gnus-summary-article-subject)))
7888
7889 (defun gnus-summary-prev-same-subject ()
7890   "Select previous article which has the same subject as current one."
7891   (interactive)
7892   (gnus-summary-prev-article nil (gnus-summary-article-subject)))
7893
7894 (defun gnus-summary-next-unread-same-subject ()
7895   "Select next unread article which has the same subject as current one."
7896   (interactive)
7897   (gnus-summary-next-article t (gnus-summary-article-subject)))
7898
7899 (defun gnus-summary-prev-unread-same-subject ()
7900   "Select previous unread article which has the same subject as current one."
7901   (interactive)
7902   (gnus-summary-prev-article t (gnus-summary-article-subject)))
7903
7904 (defun gnus-summary-first-unread-article ()
7905   "Select the first unread article.
7906 Return nil if there are no unread articles."
7907   (interactive)
7908   (prog1
7909       (when (gnus-summary-first-subject t)
7910         (gnus-summary-show-thread)
7911         (gnus-summary-first-subject t)
7912         (gnus-summary-display-article (gnus-summary-article-number)))
7913     (gnus-summary-position-point)))
7914
7915 (defun gnus-summary-first-unread-subject ()
7916   "Place the point on the subject line of the first unread article.
7917 Return nil if there are no unread articles."
7918   (interactive)
7919   (prog1
7920       (when (gnus-summary-first-subject t)
7921         (gnus-summary-show-thread)
7922         (gnus-summary-first-subject t))
7923     (gnus-summary-position-point)))
7924
7925 (defun gnus-summary-first-unseen-subject ()
7926   "Place the point on the subject line of the first unseen article.
7927 Return nil if there are no unseen articles."
7928   (interactive)
7929   (prog1
7930       (when (gnus-summary-first-subject nil nil t)
7931         (gnus-summary-show-thread)
7932         (gnus-summary-first-subject nil nil t))
7933     (gnus-summary-position-point)))
7934
7935 (defun gnus-summary-first-unseen-or-unread-subject ()
7936   "Place the point on the subject line of the first unseen and unread article.
7937 If all article have been seen, on the subject line of the first unread
7938 article."
7939   (interactive)
7940   (prog1
7941       (unless (when (gnus-summary-first-subject nil nil t)
7942                 (gnus-summary-show-thread)
7943                 (gnus-summary-first-subject nil nil t))
7944         (when (gnus-summary-first-subject t)
7945           (gnus-summary-show-thread)
7946           (gnus-summary-first-subject t)))
7947     (gnus-summary-position-point)))
7948
7949 (defun gnus-summary-first-article ()
7950   "Select the first article.
7951 Return nil if there are no articles."
7952   (interactive)
7953   (prog1
7954       (when (gnus-summary-first-subject)
7955         (gnus-summary-show-thread)
7956         (gnus-summary-first-subject)
7957         (gnus-summary-display-article (gnus-summary-article-number)))
7958     (gnus-summary-position-point)))
7959
7960 (defun gnus-summary-best-unread-article (&optional arg)
7961   "Select the unread article with the highest score.
7962 If given a prefix argument, select the next unread article that has a
7963 score higher than the default score."
7964   (interactive "P")
7965   (let ((article (if arg
7966                      (gnus-summary-better-unread-subject)
7967                    (gnus-summary-best-unread-subject))))
7968     (if article
7969         (gnus-summary-goto-article article)
7970       (error "No unread articles"))))
7971
7972 (defun gnus-summary-best-unread-subject ()
7973   "Select the unread subject with the highest score."
7974   (interactive)
7975   (let ((best -1000000)
7976         (data gnus-newsgroup-data)
7977         article score)
7978     (while data
7979       (and (gnus-data-unread-p (car data))
7980            (> (setq score
7981                     (gnus-summary-article-score (gnus-data-number (car data))))
7982               best)
7983            (setq best score
7984                  article (gnus-data-number (car data))))
7985       (setq data (cdr data)))
7986     (when article
7987       (gnus-summary-goto-subject article))
7988     (gnus-summary-position-point)
7989     article))
7990
7991 (defun gnus-summary-better-unread-subject ()
7992   "Select the first unread subject that has a score over the default score."
7993   (interactive)
7994   (let ((data gnus-newsgroup-data)
7995         article score)
7996     (while (and (setq article (gnus-data-number (car data)))
7997                 (or (gnus-data-read-p (car data))
7998                     (not (> (gnus-summary-article-score article)
7999                             gnus-summary-default-score))))
8000       (setq data (cdr data)))
8001     (when article
8002       (gnus-summary-goto-subject article))
8003     (gnus-summary-position-point)
8004     article))
8005
8006 (defun gnus-summary-last-subject ()
8007   "Go to the last displayed subject line in the group."
8008   (let ((article (gnus-data-number (car (gnus-data-list t)))))
8009     (when article
8010       (gnus-summary-goto-subject article))))
8011
8012 (defun gnus-summary-goto-article (article &optional all-headers force)
8013   "Fetch ARTICLE (article number or Message-ID) and display it if it exists.
8014 If ALL-HEADERS is non-nil, no header lines are hidden.
8015 If FORCE, go to the article even if it isn't displayed.  If FORCE
8016 is a number, it is the line the article is to be displayed on."
8017   (interactive
8018    (list
8019     (gnus-completing-read
8020      "Article number or Message-ID"
8021      (mapcar 'int-to-string gnus-newsgroup-limit))
8022     current-prefix-arg
8023     t))
8024   (prog1
8025       (if (and (stringp article)
8026                (string-match "@\\|%40" article))
8027           (gnus-summary-refer-article article)
8028         (when (stringp article)
8029           (setq article (string-to-number article)))
8030         (if (gnus-summary-goto-subject article force)
8031             (gnus-summary-display-article article all-headers)
8032           (gnus-message 4 "Couldn't go to article %s" article) nil))
8033     (gnus-summary-position-point)))
8034
8035 (defun gnus-summary-goto-last-article ()
8036   "Go to the previously read article."
8037   (interactive)
8038   (prog1
8039       (when gnus-last-article
8040         (gnus-summary-goto-article gnus-last-article nil t))
8041     (gnus-summary-position-point)))
8042
8043 (defun gnus-summary-pop-article (number)
8044   "Pop one article off the history and go to the previous.
8045 NUMBER articles will be popped off."
8046   (interactive "p")
8047   (let (to)
8048     (setq gnus-newsgroup-history
8049           (cdr (setq to (nthcdr number gnus-newsgroup-history))))
8050     (if to
8051         (gnus-summary-goto-article (car to) nil t)
8052       (error "Article history empty")))
8053   (gnus-summary-position-point))
8054
8055 ;; Summary commands and functions for limiting the summary buffer.
8056
8057 (defun gnus-summary-limit-to-articles (n)
8058   "Limit the summary buffer to the next N articles.
8059 If not given a prefix, use the process marked articles instead."
8060   (interactive "P")
8061   (prog1
8062       (let ((articles (gnus-summary-work-articles n)))
8063         (setq gnus-newsgroup-processable nil)
8064         (gnus-summary-limit articles))
8065     (gnus-summary-position-point)))
8066
8067 (defun gnus-summary-pop-limit (&optional total)
8068   "Restore the previous limit.
8069 If given a prefix, remove all limits."
8070   (interactive "P")
8071   (when total
8072     (setq gnus-newsgroup-limits
8073           (list (mapcar (lambda (h) (mail-header-number h))
8074                         gnus-newsgroup-headers))))
8075   (unless gnus-newsgroup-limits
8076     (error "No limit to pop"))
8077   (prog1
8078       (gnus-summary-limit nil 'pop)
8079     (gnus-summary-position-point)))
8080
8081 (defun gnus-summary-limit-to-subject (subject &optional header not-matching)
8082   "Limit the summary buffer to articles that have subjects that match a regexp.
8083 If NOT-MATCHING, excluding articles that have subjects that match a regexp."
8084   (interactive
8085    (list (read-string (if current-prefix-arg
8086                           "Exclude subject (regexp): "
8087                         "Limit to subject (regexp): "))
8088          nil current-prefix-arg))
8089   (unless header
8090     (setq header "subject"))
8091   (when (not (equal "" subject))
8092     (prog1
8093         (let ((articles (gnus-summary-find-matching
8094                          (or header "subject") subject 'all nil nil
8095                          not-matching)))
8096           (unless articles
8097             (error "Found no matches for \"%s\"" subject))
8098           (gnus-summary-limit articles))
8099       (gnus-summary-position-point))))
8100
8101 (defun gnus-summary-limit-to-author (from &optional not-matching)
8102   "Limit the summary buffer to articles that have authors that match a regexp.
8103 If NOT-MATCHING, excluding articles that have authors that match a regexp."
8104   (interactive
8105    (list (read-string (if current-prefix-arg
8106                           "Exclude author (regexp): "
8107                         "Limit to author (regexp): "))
8108          current-prefix-arg))
8109   (gnus-summary-limit-to-subject from "from" not-matching))
8110
8111 (defun gnus-summary-limit-to-recipient (recipient &optional not-matching)
8112   "Limit the summary buffer to articles with the given RECIPIENT.
8113
8114 If NOT-MATCHING, exclude RECIPIENT.
8115
8116 To and Cc headers are checked.  You need to include them in
8117 `nnmail-extra-headers'."
8118   ;; Unlike `rmail-summary-by-recipients', doesn't include From.
8119   (interactive
8120    (list (read-string (format "%s recipient (regexp): "
8121                               (if current-prefix-arg "Exclude" "Limit to")))
8122          current-prefix-arg))
8123   (when (not (equal "" recipient))
8124     (prog1 (let* ((to
8125                    (if (memq 'To nnmail-extra-headers)
8126                        (gnus-summary-find-matching
8127                         (cons 'extra 'To) recipient 'all nil nil
8128                         not-matching)
8129                      (gnus-message
8130                       1 "`To' isn't present in `nnmail-extra-headers'")
8131                      (sit-for 1)
8132                      nil))
8133                   (cc
8134                    (if (memq 'Cc nnmail-extra-headers)
8135                        (gnus-summary-find-matching
8136                         (cons 'extra 'Cc) recipient 'all nil nil
8137                         not-matching)
8138                      (gnus-message
8139                       1 "`Cc' isn't present in `nnmail-extra-headers'")
8140                      (sit-for 1)
8141                      nil))
8142                   (articles
8143                    (if not-matching
8144                        ;; We need the numbers that are in both lists:
8145                        (mapcar (lambda (a)
8146                                  (and (memq a to) a))
8147                                cc)
8148                      (nconc to cc))))
8149              (unless articles
8150                (error "Found no matches for \"%s\"" recipient))
8151              (gnus-summary-limit articles))
8152       (gnus-summary-position-point))))
8153
8154 (defun gnus-summary-limit-to-address (address &optional not-matching)
8155   "Limit the summary buffer to articles with the given ADDRESS.
8156
8157 If NOT-MATCHING, exclude ADDRESS.
8158
8159 To, Cc and From headers are checked.  You need to include `To' and `Cc'
8160 in `nnmail-extra-headers'."
8161   (interactive
8162    (list (read-string (format "%s address (regexp): "
8163                               (if current-prefix-arg "Exclude" "Limit to")))
8164          current-prefix-arg))
8165   (when (not (equal "" address))
8166     (prog1 (let* ((to
8167                    (if (memq 'To nnmail-extra-headers)
8168                        (gnus-summary-find-matching
8169                         (cons 'extra 'To) address 'all nil nil
8170                         not-matching)
8171                      (gnus-message
8172                       1 "`To' isn't present in `nnmail-extra-headers'")
8173                      (sit-for 1)
8174                      t))
8175                   (cc
8176                    (if (memq 'Cc nnmail-extra-headers)
8177                        (gnus-summary-find-matching
8178                         (cons 'extra 'Cc) address 'all nil nil
8179                         not-matching)
8180                      (gnus-message
8181                       1 "`Cc' isn't present in `nnmail-extra-headers'")
8182                      (sit-for 1)
8183                      t))
8184                   (from
8185                    (gnus-summary-find-matching "from" address
8186                                                'all nil nil not-matching))
8187                   (articles
8188                    (if not-matching
8189                        ;; We need the numbers that are in all lists:
8190                        (if (eq cc t)
8191                            (if (eq to t)
8192                                from
8193                              (mapcar (lambda (a) (car (memq a from))) to))
8194                          (if (eq to t)
8195                              (mapcar (lambda (a) (car (memq a from))) cc)
8196                            (mapcar (lambda (a) (car (memq a from)))
8197                                    (mapcar (lambda (a) (car (memq a to)))
8198                                            cc))))
8199                      (nconc (if (eq to t) nil to)
8200                             (if (eq cc t) nil cc)
8201                             from))))
8202              (unless articles
8203                (error "Found no matches for \"%s\"" address))
8204              (gnus-summary-limit articles))
8205       (gnus-summary-position-point))))
8206
8207 (defun gnus-summary-limit-strange-charsets-predicate (header)
8208   (when (fboundp 'char-charset)
8209     (let ((string (concat (mail-header-subject header)
8210                           (mail-header-from header)))
8211           charset found)
8212       (dotimes (i (1- (length string)))
8213         (setq charset (format "%s" (char-charset (aref string (1+ i)))))
8214         (when (string-match "unicode\\|big\\|japanese" charset)
8215           (setq found t)))
8216       found)))
8217
8218 (defun gnus-summary-limit-to-predicate (predicate)
8219   "Limit to articles where PREDICATE returns non-nil.
8220 PREDICATE will be called with the header structures of the
8221 articles."
8222   (let ((articles nil)
8223         (case-fold-search t))
8224     (dolist (header gnus-newsgroup-headers)
8225       (when (funcall predicate header)
8226         (push (mail-header-number header) articles)))
8227     (gnus-summary-limit (nreverse articles))))
8228
8229 (defun gnus-summary-limit-to-age (age &optional younger-p)
8230   "Limit the summary buffer to articles that are older than (or equal) AGE days.
8231 If YOUNGER-P (the prefix) is non-nil, limit the summary buffer to
8232 articles that are younger than AGE days."
8233   (interactive
8234    (let ((younger current-prefix-arg)
8235          (days-got nil)
8236          days)
8237      (while (not days-got)
8238        (setq days (if younger
8239                       (read-string "Limit to articles younger than (in days, older when negative): ")
8240                     (read-string
8241                      "Limit to articles older than (in days, younger when negative): ")))
8242        (when (> (length days) 0)
8243          (setq days (read days)))
8244        (if (numberp days)
8245            (progn
8246              (setq days-got t)
8247              (when (< days 0)
8248                (setq younger (not younger))
8249                (setq days (* days -1))))
8250          (message "Please enter a number.")
8251          (sleep-for 1)))
8252      (list days younger)))
8253   (prog1
8254       (let ((data gnus-newsgroup-data)
8255             (cutoff (days-to-time age))
8256             articles d date is-younger)
8257         (while (setq d (pop data))
8258           (when (and (vectorp (gnus-data-header d))
8259                      (setq date (mail-header-date (gnus-data-header d))))
8260             (setq is-younger (time-less-p
8261                               (time-since (gnus-date-get-time date))
8262                               cutoff))
8263             (when (if younger-p
8264                       is-younger
8265                     (not is-younger))
8266               (push (gnus-data-number d) articles))))
8267         (gnus-summary-limit (nreverse articles)))
8268     (gnus-summary-position-point)))
8269
8270 (defun gnus-summary-limit-to-extra (header regexp &optional not-matching)
8271   "Limit the summary buffer to articles that match an 'extra' header."
8272   (interactive
8273    (let ((header
8274           (intern
8275            (gnus-completing-read
8276             (if current-prefix-arg
8277                 "Exclude extra header"
8278               "Limit extra header")
8279             (mapcar 'symbol-name gnus-extra-headers)
8280             t nil nil
8281             (symbol-name (car gnus-extra-headers))))))
8282      (list header
8283            (read-string (format "%s header %s (regexp): "
8284                                 (if current-prefix-arg "Exclude" "Limit to")
8285                                 header))
8286            current-prefix-arg)))
8287   (when (not (equal "" regexp))
8288     (prog1
8289         (let ((articles (gnus-summary-find-matching
8290                          (cons 'extra header) regexp 'all nil nil
8291                          not-matching)))
8292           (unless articles
8293             (error "Found no matches for \"%s\"" regexp))
8294           (gnus-summary-limit articles))
8295       (gnus-summary-position-point))))
8296
8297 (defun gnus-summary-limit-to-display-predicate ()
8298   "Limit the summary buffer to the predicated in the `display' group parameter."
8299   (interactive)
8300   (unless gnus-newsgroup-display
8301     (error "There is no `display' group parameter"))
8302   (let (articles)
8303     (dolist (gnus-number gnus-newsgroup-articles)
8304       (when (funcall gnus-newsgroup-display)
8305         (push gnus-number articles)))
8306     (gnus-summary-limit articles))
8307   (gnus-summary-position-point))
8308
8309 (defun gnus-summary-limit-to-unread (&optional all)
8310   "Limit the summary buffer to articles that are not marked as read.
8311 If ALL is non-nil, limit strictly to unread articles."
8312   (interactive "P")
8313   (if all
8314       (gnus-summary-limit-to-marks (char-to-string gnus-unread-mark))
8315     (gnus-summary-limit-to-marks
8316      ;; Concat all the marks that say that an article is read and have
8317      ;; those removed.
8318      (list gnus-del-mark gnus-read-mark gnus-ancient-mark
8319            gnus-killed-mark gnus-spam-mark gnus-kill-file-mark
8320            gnus-low-score-mark gnus-expirable-mark
8321            gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark
8322            gnus-duplicate-mark)
8323      'reverse)))
8324
8325 (defun gnus-summary-limit-to-headers (match &optional reverse)
8326   "Limit the summary buffer to articles that have headers that match MATCH.
8327 If REVERSE (the prefix), limit to articles that don't match."
8328   (interactive "sMatch headers (regexp): \nP")
8329   (gnus-summary-limit-to-bodies match reverse t))
8330
8331 (defun gnus-summary-limit-to-bodies (match &optional reverse headersp)
8332   "Limit the summary buffer to articles that have bodies that match MATCH.
8333 If REVERSE (the prefix), limit to articles that don't match."
8334   (interactive "sMatch body (regexp): \nP")
8335   (let ((articles nil)
8336         (gnus-select-article-hook nil)  ;Disable hook.
8337         (gnus-article-prepare-hook nil)
8338         (gnus-use-article-prefetch nil)
8339         (gnus-keep-backlog nil)
8340         (gnus-break-pages nil)
8341         (gnus-summary-display-arrow nil)
8342         (gnus-updated-mode-lines nil)
8343         (gnus-auto-center-summary nil)
8344         (gnus-display-mime-function nil))
8345     (dolist (data gnus-newsgroup-data)
8346       (let (gnus-mark-article-hook)
8347         (gnus-summary-select-article t t nil (gnus-data-number data)))
8348       (with-current-buffer gnus-article-buffer
8349         (article-goto-body)
8350         (let* ((case-fold-search t)
8351                (found (if headersp
8352                           (re-search-backward match nil t)
8353                         (re-search-forward match nil t))))
8354           (when (or (and found
8355                          (not reverse))
8356                     (and (not found)
8357                          reverse))
8358             (push (gnus-data-number data) articles)))))
8359     (if (not articles)
8360         (message "No messages matched")
8361       (gnus-summary-limit articles)))
8362   (gnus-summary-position-point))
8363
8364 (defun gnus-summary-limit-to-singletons (&optional threadsp)
8365   "Limit the summary buffer to articles that aren't part on any thread.
8366 If THREADSP (the prefix), limit to articles that are in threads."
8367   (interactive "P")
8368   (let ((articles nil)
8369         thread-articles
8370         threads)
8371     (dolist (thread gnus-newsgroup-threads)
8372       (if (stringp (car thread))
8373           (dolist (thread (cdr thread))
8374             (push thread threads))
8375         (push thread threads)))
8376     (dolist (thread threads)
8377       (setq thread-articles (gnus-articles-in-thread thread))
8378       (when (or (and threadsp
8379                      (> (length thread-articles) 1))
8380                 (and (not threadsp)
8381                      (= (length thread-articles) 1)))
8382         (setq articles (nconc thread-articles articles))))
8383     (if (not articles)
8384         (message "No messages matched")
8385       (gnus-summary-limit articles))
8386     (gnus-summary-position-point)))
8387
8388 (defun gnus-summary-limit-to-replied (&optional unreplied)
8389   "Limit the summary buffer to replied articles.
8390 If UNREPLIED (the prefix), limit to unreplied articles."
8391   (interactive "P")
8392   (if unreplied
8393       (gnus-summary-limit
8394        (gnus-set-difference gnus-newsgroup-articles
8395         gnus-newsgroup-replied))
8396     (gnus-summary-limit gnus-newsgroup-replied))
8397   (gnus-summary-position-point))
8398
8399 (defun gnus-summary-limit-exclude-marks (marks &optional reverse)
8400   "Exclude articles that are marked with MARKS (e.g. \"DK\").
8401 If REVERSE, limit the summary buffer to articles that are marked
8402 with MARKS.  MARKS can either be a string of marks or a list of marks.
8403 Returns how many articles were removed."
8404   (interactive "sMarks: ")
8405   (gnus-summary-limit-to-marks marks t))
8406
8407 (defun gnus-summary-limit-to-marks (marks &optional reverse)
8408   "Limit the summary buffer to articles that are marked with MARKS (e.g. \"DK\").
8409 If REVERSE (the prefix), limit the summary buffer to articles that are
8410 not marked with MARKS.  MARKS can either be a string of marks or a
8411 list of marks.
8412 Returns how many articles were removed."
8413   (interactive "sMarks: \nP")
8414   (prog1
8415       (let ((data gnus-newsgroup-data)
8416             (marks (if (listp marks) marks
8417                      (append marks nil))) ; Transform to list.
8418             articles)
8419         (while data
8420           (when (if reverse (not (memq (gnus-data-mark (car data)) marks))
8421                   (memq (gnus-data-mark (car data)) marks))
8422             (push (gnus-data-number (car data)) articles))
8423           (setq data (cdr data)))
8424         (gnus-summary-limit articles))
8425     (gnus-summary-position-point)))
8426
8427 (defun gnus-summary-limit-to-score (score)
8428   "Limit to articles with score at or above SCORE."
8429   (interactive "NLimit to articles with score of at least: ")
8430   (let ((data gnus-newsgroup-data)
8431         articles)
8432     (while data
8433       (when (>= (gnus-summary-article-score (gnus-data-number (car data)))
8434                 score)
8435         (push (gnus-data-number (car data)) articles))
8436       (setq data (cdr data)))
8437     (prog1
8438         (gnus-summary-limit articles)
8439       (gnus-summary-position-point))))
8440
8441 (defun gnus-summary-limit-to-unseen ()
8442   "Limit to unseen articles."
8443   (interactive)
8444   (prog1
8445       (gnus-summary-limit gnus-newsgroup-unseen)
8446     (gnus-summary-position-point)))
8447
8448 (defun gnus-summary-limit-include-thread (id)
8449   "Display all the hidden articles that is in the thread with ID in it.
8450 When called interactively, ID is the Message-ID of the current
8451 article."
8452   (interactive (list (mail-header-id (gnus-summary-article-header))))
8453   (let ((articles (gnus-articles-in-thread
8454                    (gnus-id-to-thread (gnus-root-id id))))
8455         ;;we REALLY want the whole thread---this prevents cut-threads
8456         ;;from removing the thread we want to include.
8457         (gnus-fetch-old-headers nil)
8458         (gnus-build-sparse-threads nil))
8459     (prog1
8460         (gnus-summary-limit (nconc articles gnus-newsgroup-limit))
8461       (gnus-summary-limit-include-matching-articles
8462        "subject"
8463        (regexp-quote (gnus-simplify-subject-re
8464                       (mail-header-subject (gnus-id-to-header id)))))
8465       (gnus-summary-position-point))))
8466
8467 (defun gnus-summary-limit-include-matching-articles (header regexp)
8468   "Display all the hidden articles that have HEADERs that match REGEXP."
8469   (interactive (list (read-string "Match on header: ")
8470                      (read-string "Regexp: ")))
8471   (let ((articles (gnus-find-matching-articles header regexp)))
8472     (prog1
8473         (gnus-summary-limit (nconc articles gnus-newsgroup-limit))
8474       (gnus-summary-position-point))))
8475
8476 (defun gnus-summary-insert-dormant-articles ()
8477   "Insert all the dormant articles for this group into the current buffer."
8478   (interactive)
8479   (let ((gnus-verbose (max 6 gnus-verbose)))
8480     (if (not gnus-newsgroup-dormant)
8481         (gnus-message 3 "No dormant articles for this group")
8482       (gnus-summary-goto-subjects gnus-newsgroup-dormant))))
8483
8484 (defun gnus-summary-insert-ticked-articles ()
8485   "Insert ticked articles for this group into the current buffer."
8486   (interactive)
8487   (let ((gnus-verbose (max 6 gnus-verbose)))
8488     (if (not gnus-newsgroup-marked)
8489         (gnus-message 3 "No ticked articles for this group")
8490       (gnus-summary-goto-subjects gnus-newsgroup-marked))))
8491
8492 (defun gnus-summary-limit-include-dormant ()
8493   "Display all the hidden articles that are marked as dormant.
8494 Note that this command only works on a subset of the articles currently
8495 fetched for this group."
8496   (interactive)
8497   (unless gnus-newsgroup-dormant
8498     (error "There are no dormant articles in this group"))
8499   (prog1
8500       (gnus-summary-limit (append gnus-newsgroup-dormant gnus-newsgroup-limit))
8501     (gnus-summary-position-point)))
8502
8503 (defun gnus-summary-limit-exclude-dormant ()
8504   "Hide all dormant articles."
8505   (interactive)
8506   (prog1
8507       (gnus-summary-limit-to-marks (list gnus-dormant-mark) 'reverse)
8508     (gnus-summary-position-point)))
8509
8510 (defun gnus-summary-limit-exclude-childless-dormant ()
8511   "Hide all dormant articles that have no children."
8512   (interactive)
8513   (let ((data (gnus-data-list t))
8514         articles d children)
8515     ;; Find all articles that are either not dormant or have
8516     ;; children.
8517     (while (setq d (pop data))
8518       (when (or (not (= (gnus-data-mark d) gnus-dormant-mark))
8519                 (and (setq children
8520                            (gnus-article-children (gnus-data-number d)))
8521                      (let (found)
8522                        (while children
8523                          (when (memq (car children) articles)
8524                            (setq children nil
8525                                  found t))
8526                          (pop children))
8527                        found)))
8528         (push (gnus-data-number d) articles)))
8529     ;; Do the limiting.
8530     (prog1
8531         (gnus-summary-limit articles)
8532       (gnus-summary-position-point))))
8533
8534 (defun gnus-summary-limit-mark-excluded-as-read (&optional all)
8535   "Mark all unread excluded articles as read.
8536 If ALL, mark even excluded ticked and dormants as read."
8537   (interactive "P")
8538   (setq gnus-newsgroup-limit (sort gnus-newsgroup-limit '<))
8539   (let ((articles (gnus-sorted-ndifference
8540                    (sort
8541                     (mapcar (lambda (h) (mail-header-number h))
8542                             gnus-newsgroup-headers)
8543                     '<)
8544                    gnus-newsgroup-limit))
8545         article)
8546     (setq gnus-newsgroup-unreads
8547           (gnus-sorted-intersection gnus-newsgroup-unreads
8548                                     gnus-newsgroup-limit))
8549     (if all
8550         (setq gnus-newsgroup-dormant nil
8551               gnus-newsgroup-marked nil
8552               gnus-newsgroup-reads
8553               (nconc
8554                (mapcar (lambda (n) (cons n gnus-catchup-mark)) articles)
8555                gnus-newsgroup-reads))
8556       (while (setq article (pop articles))
8557         (unless (or (memq article gnus-newsgroup-dormant)
8558                     (memq article gnus-newsgroup-marked))
8559           (push (cons article gnus-catchup-mark) gnus-newsgroup-reads))))))
8560
8561 (defun gnus-summary-limit (articles &optional pop)
8562   (if pop
8563       ;; We pop the previous limit off the stack and use that.
8564       (setq articles (car gnus-newsgroup-limits)
8565             gnus-newsgroup-limits (cdr gnus-newsgroup-limits))
8566     ;; We use the new limit, so we push the old limit on the stack.
8567     (push gnus-newsgroup-limit gnus-newsgroup-limits))
8568   ;; Set the limit.
8569   (setq gnus-newsgroup-limit articles)
8570   (let ((total (length gnus-newsgroup-data))
8571         (data (gnus-data-find-list (gnus-summary-article-number)))
8572         (gnus-summary-mark-below nil)   ; Inhibit this.
8573         found)
8574     ;; This will do all the work of generating the new summary buffer
8575     ;; according to the new limit.
8576     (gnus-summary-prepare)
8577     ;; Hide any threads, possibly.
8578     (gnus-summary-maybe-hide-threads)
8579     ;; Try to return to the article you were at, or one in the
8580     ;; neighborhood.
8581     (when data
8582       ;; We try to find some article after the current one.
8583       (while data
8584         (when (gnus-summary-goto-subject (gnus-data-number (car data)) nil t)
8585           (setq data nil
8586                 found t))
8587         (setq data (cdr data))))
8588     (unless found
8589       ;; If there is no data, that means that we were after the last
8590       ;; article.  The same goes when we can't find any articles
8591       ;; after the current one.
8592       (goto-char (point-max))
8593       (gnus-summary-find-prev))
8594     (gnus-set-mode-line 'summary)
8595     ;; We return how many articles were removed from the summary
8596     ;; buffer as a result of the new limit.
8597     (- total (length gnus-newsgroup-data))))
8598
8599 (defsubst gnus-invisible-cut-children (threads)
8600   (let ((num 0))
8601     (while threads
8602       (when (memq (mail-header-number (caar threads)) gnus-newsgroup-limit)
8603         (incf num))
8604       (pop threads))
8605     (< num 2)))
8606
8607 (defsubst gnus-cut-thread (thread)
8608   "Go forwards in the thread until we find an article that we want to display."
8609   (when (or (eq gnus-fetch-old-headers 'some)
8610             (eq gnus-fetch-old-headers 'invisible)
8611             (numberp gnus-fetch-old-headers)
8612             (eq gnus-build-sparse-threads 'some)
8613             (eq gnus-build-sparse-threads 'more))
8614     ;; Deal with old-fetched headers and sparse threads.
8615     (while (and
8616             thread
8617             (or
8618              (gnus-summary-article-sparse-p (mail-header-number (car thread)))
8619              (gnus-summary-article-ancient-p
8620               (mail-header-number (car thread))))
8621             (if (or (<= (length (cdr thread)) 1)
8622                     (eq gnus-fetch-old-headers 'invisible))
8623                 (setq gnus-newsgroup-limit
8624                       (delq (mail-header-number (car thread))
8625                             gnus-newsgroup-limit)
8626                       thread (cadr thread))
8627               (when (gnus-invisible-cut-children (cdr thread))
8628                 (let ((th (cdr thread)))
8629                   (while th
8630                     (if (memq (mail-header-number (caar th))
8631                               gnus-newsgroup-limit)
8632                         (setq thread (car th)
8633                               th nil)
8634                       (setq th (cdr th))))))))))
8635   thread)
8636
8637 (defun gnus-cut-threads (threads)
8638   "Cut off all uninteresting articles from the beginning of THREADS."
8639   (when (or (eq gnus-fetch-old-headers 'some)
8640             (eq gnus-fetch-old-headers 'invisible)
8641             (numberp gnus-fetch-old-headers)
8642             (eq gnus-build-sparse-threads 'some)
8643             (eq gnus-build-sparse-threads 'more))
8644     (let ((th threads))
8645       (while th
8646         (setcar th (gnus-cut-thread (car th)))
8647         (setq th (cdr th)))))
8648   ;; Remove nixed out threads.
8649   (delq nil threads))
8650
8651 (defun gnus-summary-initial-limit (&optional show-if-empty)
8652   "Figure out what the initial limit is supposed to be on group entry.
8653 This entails weeding out unwanted dormants, low-scored articles,
8654 fetch-old-headers verbiage, and so on."
8655   ;; Most groups have nothing to remove.
8656   (unless (or gnus-inhibit-limiting
8657               (and (null gnus-newsgroup-dormant)
8658                    (eq gnus-newsgroup-display 'gnus-not-ignore)
8659                    (not (eq gnus-fetch-old-headers 'some))
8660                    (not (numberp gnus-fetch-old-headers))
8661                    (not (eq gnus-fetch-old-headers 'invisible))
8662                    (null gnus-summary-expunge-below)
8663                    (not (eq gnus-build-sparse-threads 'some))
8664                    (not (eq gnus-build-sparse-threads 'more))
8665                    (null gnus-thread-expunge-below)))
8666     (push gnus-newsgroup-limit gnus-newsgroup-limits)
8667     (setq gnus-newsgroup-limit nil)
8668     (mapatoms
8669      (lambda (node)
8670        (unless (car (symbol-value node))
8671          ;; These threads have no parents -- they are roots.
8672          (let ((nodes (cdr (symbol-value node)))
8673                thread)
8674            (while nodes
8675              (if (and gnus-thread-expunge-below
8676                       (< (gnus-thread-total-score (car nodes))
8677                          gnus-thread-expunge-below))
8678                  (gnus-expunge-thread (pop nodes))
8679                (setq thread (pop nodes))
8680                (gnus-summary-limit-children thread))))))
8681      gnus-newsgroup-dependencies)
8682     ;; If this limitation resulted in an empty group, we might
8683     ;; pop the previous limit and use it instead.
8684     (when (and (not gnus-newsgroup-limit)
8685                show-if-empty)
8686       (setq gnus-newsgroup-limit (pop gnus-newsgroup-limits)))
8687     gnus-newsgroup-limit))
8688
8689 (defun gnus-summary-limit-children (thread)
8690   "Return 1 if this subthread is visible and 0 if it is not."
8691   ;; First we get the number of visible children to this thread.  This
8692   ;; is done by recursing down the thread using this function, so this
8693   ;; will really go down to a leaf article first, before slowly
8694   ;; working its way up towards the root.
8695   (when thread
8696     (let* ((max-lisp-eval-depth (max 5000 max-lisp-eval-depth))
8697            (children
8698            (if (cdr thread)
8699                (apply '+ (mapcar 'gnus-summary-limit-children
8700                                  (cdr thread)))
8701              0))
8702            (number (mail-header-number (car thread)))
8703            score)
8704       (if (and
8705            (not (memq number gnus-newsgroup-marked))
8706            (or
8707             ;; If this article is dormant and has absolutely no visible
8708             ;; children, then this article isn't visible.
8709             (and (memq number gnus-newsgroup-dormant)
8710                  (zerop children))
8711             ;; If this is "fetch-old-headered" and there is no
8712             ;; visible children, then we don't want this article.
8713             (and (or (eq gnus-fetch-old-headers 'some)
8714                      (numberp gnus-fetch-old-headers))
8715                  (gnus-summary-article-ancient-p number)
8716                  (zerop children))
8717             ;; If this is "fetch-old-headered" and `invisible', then
8718             ;; we don't want this article.
8719             (and (eq gnus-fetch-old-headers 'invisible)
8720                  (gnus-summary-article-ancient-p number))
8721             ;; If this is a sparsely inserted article with no children,
8722             ;; we don't want it.
8723             (and (eq gnus-build-sparse-threads 'some)
8724                  (gnus-summary-article-sparse-p number)
8725                  (zerop children))
8726             ;; If we use expunging, and this article is really
8727             ;; low-scored, then we don't want this article.
8728             (when (and gnus-summary-expunge-below
8729                        (< (setq score
8730                                 (or (cdr (assq number gnus-newsgroup-scored))
8731                                     gnus-summary-default-score))
8732                           gnus-summary-expunge-below))
8733               ;; We increase the expunge-tally here, but that has
8734               ;; nothing to do with the limits, really.
8735               (incf gnus-newsgroup-expunged-tally)
8736               ;; We also mark as read here, if that's wanted.
8737               (when (and gnus-summary-mark-below
8738                          (< score gnus-summary-mark-below))
8739                 (setq gnus-newsgroup-unreads
8740                       (delq number gnus-newsgroup-unreads))
8741                 (if gnus-newsgroup-auto-expire
8742                     (push number gnus-newsgroup-expirable)
8743                   (push (cons number gnus-low-score-mark)
8744                         gnus-newsgroup-reads)))
8745               t)
8746             ;; Do the `display' group parameter.
8747             (and gnus-newsgroup-display
8748                  (let ((gnus-number number))
8749                    (not (funcall gnus-newsgroup-display))))))
8750           ;; Nope, invisible article.
8751           0
8752         ;; Ok, this article is to be visible, so we add it to the limit
8753         ;; and return 1.
8754         (push number gnus-newsgroup-limit)
8755         1))))
8756
8757 (defun gnus-expunge-thread (thread)
8758   "Mark all articles in THREAD as read."
8759   (let* ((number (mail-header-number (car thread))))
8760     (incf gnus-newsgroup-expunged-tally)
8761     ;; We also mark as read here, if that's wanted.
8762     (setq gnus-newsgroup-unreads
8763           (delq number gnus-newsgroup-unreads))
8764     (if gnus-newsgroup-auto-expire
8765         (push number gnus-newsgroup-expirable)
8766       (push (cons number gnus-low-score-mark)
8767             gnus-newsgroup-reads)))
8768   ;; Go recursively through all subthreads.
8769   (mapcar 'gnus-expunge-thread (cdr thread)))
8770
8771 ;; Summary article oriented commands
8772
8773 (defun gnus-summary-refer-parent-article (n)
8774   "Refer parent article N times.
8775 If N is negative, go to ancestor -N instead.
8776 The difference between N and the number of articles fetched is returned."
8777   (interactive "p")
8778   (let ((skip 1)
8779         error header ref)
8780     (when (not (natnump n))
8781       (setq skip (abs n)
8782             n 1))
8783     (while (and (> n 0)
8784                 (not error))
8785       (setq header (gnus-summary-article-header))
8786       (if (and (eq (mail-header-number header)
8787                    (cdr gnus-article-current))
8788                (equal gnus-newsgroup-name
8789                       (car gnus-article-current)))
8790           ;; If we try to find the parent of the currently
8791           ;; displayed article, then we take a look at the actual
8792           ;; References header, since this is slightly more
8793           ;; reliable than the References field we got from the
8794           ;; server.
8795           (with-current-buffer gnus-original-article-buffer
8796             (nnheader-narrow-to-headers)
8797             (unless (setq ref (message-fetch-field "references"))
8798               (when (setq ref (message-fetch-field "in-reply-to"))
8799                 (setq ref (gnus-extract-message-id-from-in-reply-to ref))))
8800             (widen))
8801         (setq ref
8802               ;; It's not the current article, so we take a bet on
8803               ;; the value we got from the server.
8804               (mail-header-references header)))
8805       (if (and ref
8806                (not (equal ref "")))
8807           (unless (gnus-summary-refer-article (gnus-parent-id ref skip))
8808             (gnus-message 1 "Couldn't find parent"))
8809         (gnus-message 1 "No references in article %d"
8810                       (gnus-summary-article-number))
8811         (setq error t))
8812       (decf n))
8813     (gnus-summary-position-point)
8814     n))
8815
8816 (defun gnus-summary-refer-references ()
8817   "Fetch all articles mentioned in the References header.
8818 Return the number of articles fetched."
8819   (interactive)
8820   (let ((ref (mail-header-references (gnus-summary-article-header)))
8821         (current (gnus-summary-article-number))
8822         (n 0))
8823     (if (or (not ref)
8824             (equal ref ""))
8825         (error "No References in the current article")
8826       ;; For each Message-ID in the References header...
8827       (while (string-match "<[^>]*>" ref)
8828         (incf n)
8829         ;; ... fetch that article.
8830         (gnus-summary-refer-article
8831          (prog1 (match-string 0 ref)
8832            (setq ref (substring ref (match-end 0))))))
8833       (gnus-summary-goto-subject current)
8834       (gnus-summary-position-point)
8835       n)))
8836
8837 (defun gnus-summary-refer-thread (&optional limit)
8838   "Fetch all articles in the current thread.
8839 If no backend-specific 'request-thread function is available
8840 fetch LIMIT (the numerical prefix) old headers. If LIMIT is nil
8841 fetch what's specified by the `gnus-refer-thread-limit'
8842 variable."
8843   (interactive "P")
8844   (gnus-warp-to-article)
8845   (let ((id (mail-header-id (gnus-summary-article-header)))
8846         (gnus-inhibit-demon t)
8847         (gnus-agent nil)
8848         (gnus-summary-ignore-duplicates t)
8849         (gnus-read-all-available-headers t)
8850         (limit (if limit (prefix-numeric-value limit)
8851                  gnus-refer-thread-limit)))
8852     (setq gnus-newsgroup-headers
8853           (gnus-merge
8854            'list gnus-newsgroup-headers
8855            (if (gnus-check-backend-function
8856                 'request-thread gnus-newsgroup-name)
8857                (gnus-request-thread id)
8858              (let* ((last (if (numberp limit)
8859                               (min (+ (mail-header-number
8860                                        (gnus-summary-article-header))
8861                                       limit)
8862                                    gnus-newsgroup-highest)
8863                             gnus-newsgroup-highest))
8864                     (subject (gnus-simplify-subject
8865                               (mail-header-subject
8866                                (gnus-summary-article-header))))
8867                     (refs (split-string (or (mail-header-references
8868                                              (gnus-summary-article-header))
8869                                             "")))
8870                     (gnus-parse-headers-hook
8871                      (lambda () (goto-char (point-min))
8872                        (keep-lines
8873                         (regexp-opt (append refs (list id subject)))))))
8874                (gnus-fetch-headers (list last) (if (numberp limit)
8875                                                    (* 2 limit) limit) t)))
8876            'gnus-article-sort-by-number))
8877     (gnus-summary-limit-include-thread id)))
8878
8879 (defun gnus-summary-refer-article (message-id)
8880   "Fetch an article specified by MESSAGE-ID."
8881   (interactive "sMessage-ID: ")
8882   (when (and (stringp message-id)
8883              (not (zerop (length message-id))))
8884     (setq message-id (gnus-replace-in-string message-id " " ""))
8885     ;; Construct the correct Message-ID if necessary.
8886     ;; Suggested by tale@pawl.rpi.edu.
8887     (unless (string-match "^<" message-id)
8888       (setq message-id (concat "<" message-id)))
8889     (unless (string-match ">$" message-id)
8890       (setq message-id (concat message-id ">")))
8891     ;; People often post MIDs from URLs, so unhex it:
8892     (unless (string-match "@" message-id)
8893       (setq message-id (gnus-url-unhex-string message-id)))
8894     (let* ((header (gnus-id-to-header message-id))
8895            (sparse (and header
8896                         (gnus-summary-article-sparse-p
8897                          (mail-header-number header))
8898                         (memq (mail-header-number header)
8899                               gnus-newsgroup-limit)))
8900            number)
8901       (cond
8902        ;; If the article is present in the buffer we just go to it.
8903        ((and header
8904              (or (not (gnus-summary-article-sparse-p
8905                        (mail-header-number header)))
8906                  sparse))
8907         (prog1
8908             (gnus-summary-goto-article
8909              (mail-header-number header) nil t)
8910           (when sparse
8911             (gnus-summary-update-article (mail-header-number header)))))
8912        (t
8913         ;; We fetch the article.
8914         (catch 'found
8915           (dolist (gnus-override-method (gnus-refer-article-methods))
8916             (when (and (gnus-check-server gnus-override-method)
8917                        ;; Fetch the header,
8918                        (setq number (gnus-summary-insert-subject message-id)))
8919               ;; and display the article.
8920               (gnus-summary-select-article nil nil nil number)
8921               (throw 'found t)))
8922           (gnus-message 3 "Couldn't fetch article %s" message-id)))))))
8923
8924 (defun gnus-refer-article-methods ()
8925   "Return a list of referable methods."
8926   (cond
8927    ;; No method, so we default to current and native.
8928    ((null gnus-refer-article-method)
8929     (list gnus-current-select-method gnus-select-method))
8930    ;; Current.
8931    ((eq 'current gnus-refer-article-method)
8932     (list gnus-current-select-method))
8933    ;; List of select methods.
8934    ((not (and (symbolp (car gnus-refer-article-method))
8935               (assq (car gnus-refer-article-method) nnoo-definition-alist)))
8936     (let (out)
8937       (dolist (method gnus-refer-article-method)
8938         (push (if (eq 'current method)
8939                   gnus-current-select-method
8940                 method)
8941               out))
8942       (nreverse out)))
8943    ;; One single select method.
8944    (t
8945     (list gnus-refer-article-method))))
8946
8947 (defun gnus-summary-edit-parameters ()
8948   "Edit the group parameters of the current group."
8949   (interactive)
8950   (gnus-group-edit-group gnus-newsgroup-name 'params))
8951
8952 (defun gnus-summary-customize-parameters ()
8953   "Customize the group parameters of the current group."
8954   (interactive)
8955   (gnus-group-customize gnus-newsgroup-name))
8956
8957 (defun gnus-summary-enter-digest-group (&optional force)
8958   "Enter an nndoc group based on the current article.
8959 If FORCE, force a digest interpretation.  If not, try
8960 to guess what the document format is."
8961   (interactive "P")
8962   (let ((conf gnus-current-window-configuration))
8963     (save-window-excursion
8964       (save-excursion
8965         (let (gnus-article-prepare-hook
8966               gnus-display-mime-function
8967               gnus-break-pages)
8968           (gnus-summary-select-article))))
8969     (setq gnus-current-window-configuration conf)
8970     (let* ((name (format "%s-%d"
8971                          (gnus-group-prefixed-name
8972                           gnus-newsgroup-name (list 'nndoc ""))
8973                          (with-current-buffer gnus-summary-buffer
8974                            gnus-current-article)))
8975            (ogroup gnus-newsgroup-name)
8976            (params (append (gnus-info-params (gnus-get-info ogroup))
8977                            (list (cons 'to-group ogroup))
8978                            (list (cons 'parent-group ogroup))
8979                            (list (cons 'save-article-group ogroup))))
8980            (case-fold-search t)
8981            (buf (current-buffer))
8982            dig to-address)
8983       (with-current-buffer gnus-original-article-buffer
8984         ;; Have the digest group inherit the main mail address of
8985         ;; the parent article.
8986         (when (setq to-address (or (gnus-fetch-field "reply-to")
8987                                    (gnus-fetch-field "from")))
8988           (setq params
8989                 (append
8990                  (list (cons 'to-address
8991                              (funcall gnus-decode-encoded-address-function
8992                                       to-address))))))
8993         (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*"))
8994         (insert-buffer-substring gnus-original-article-buffer)
8995         ;; Remove lines that may lead nndoc to misinterpret the
8996         ;; document type.
8997         (narrow-to-region
8998          (goto-char (point-min))
8999          (or (search-forward "\n\n" nil t) (point)))
9000         (goto-char (point-min))
9001         (delete-matching-lines "^Path:\\|^From ")
9002         (widen))
9003       (unwind-protect
9004           (if (let ((gnus-newsgroup-ephemeral-charset gnus-newsgroup-charset)
9005                     (gnus-newsgroup-ephemeral-ignored-charsets
9006                      gnus-newsgroup-ignored-charsets))
9007                 (gnus-group-read-ephemeral-group
9008                  name `(nndoc ,name (nndoc-address ,(get-buffer dig))
9009                               (nndoc-article-type
9010                                ,(if force 'mbox 'guess)))
9011                  t nil nil nil
9012                  `((adapt-file . ,(gnus-score-file-name gnus-newsgroup-name
9013                                                         "ADAPT")))))
9014               ;; Make all postings to this group go to the parent group.
9015               (nconc (gnus-info-params (gnus-get-info name))
9016                      params)
9017             ;; Couldn't select this doc group.
9018             (switch-to-buffer buf)
9019             (gnus-set-global-variables)
9020             (gnus-configure-windows 'summary)
9021             (gnus-message 3 "Article couldn't be entered?"))
9022         (kill-buffer dig)))))
9023
9024 (defun gnus-summary-read-document (n)
9025   "Open a new group based on the current article(s).
9026 This will allow you to read digests and other similar
9027 documents as newsgroups.
9028 Obeys the standard process/prefix convention."
9029   (interactive "P")
9030   (let* ((ogroup gnus-newsgroup-name)
9031          (params (append (gnus-info-params (gnus-get-info ogroup))
9032                          (list (cons 'to-group ogroup))))
9033          group egroup groups vgroup)
9034     (dolist (article (gnus-summary-work-articles n))
9035       (setq group (format "%s-%d" gnus-newsgroup-name article))
9036       (gnus-summary-remove-process-mark article)
9037       (when (gnus-summary-display-article article)
9038         (save-excursion ;;What for?
9039           (with-temp-buffer
9040             (insert-buffer-substring gnus-original-article-buffer)
9041             ;; Remove some headers that may lead nndoc to make
9042             ;; the wrong guess.
9043             (message-narrow-to-head)
9044             (goto-char (point-min))
9045             (delete-matching-lines "^Path:\\|^From ")
9046             (widen)
9047             (if (setq egroup
9048                       (gnus-group-read-ephemeral-group
9049                        group `(nndoc ,group (nndoc-address ,(current-buffer))
9050                                      (nndoc-article-type guess))
9051                        t nil t))
9052                 (progn
9053                   ;; Make all postings to this group go to the parent group.
9054                   (nconc (gnus-info-params (gnus-get-info egroup))
9055                          params)
9056                   (push egroup groups))
9057               ;; Couldn't select this doc group.
9058               (gnus-error 3 "Article couldn't be entered"))))))
9059     ;; Now we have selected all the documents.
9060     (cond
9061      ((not groups)
9062       (error "None of the articles could be interpreted as documents"))
9063      ((gnus-group-read-ephemeral-group
9064        (setq vgroup (format
9065                      "nnvirtual:%s-%s" gnus-newsgroup-name
9066                      (format-time-string "%Y%m%dT%H%M%S" (current-time))))
9067        `(nnvirtual ,vgroup (nnvirtual-component-groups ,groups))
9068        t
9069        (cons (current-buffer) 'summary)))
9070      (t
9071       (error "Couldn't select virtual nndoc group")))))
9072
9073 (defun gnus-summary-isearch-article (&optional regexp-p)
9074   "Do incremental search forward on the current article.
9075 If REGEXP-P (the prefix) is non-nil, do regexp isearch."
9076   (interactive "P")
9077   (gnus-summary-select-article)
9078   (gnus-configure-windows 'article)
9079   (gnus-eval-in-buffer-window gnus-article-buffer
9080     (save-restriction
9081       (widen)
9082       (isearch-forward regexp-p))))
9083
9084 (defun gnus-summary-repeat-search-article-forward ()
9085   "Repeat the previous search forwards."
9086   (interactive)
9087   (unless gnus-last-search-regexp
9088     (error "No previous search"))
9089   (gnus-summary-search-article-forward gnus-last-search-regexp))
9090
9091 (defun gnus-summary-repeat-search-article-backward ()
9092   "Repeat the previous search backwards."
9093   (interactive)
9094   (unless gnus-last-search-regexp
9095     (error "No previous search"))
9096   (gnus-summary-search-article-forward gnus-last-search-regexp t))
9097
9098 (defun gnus-summary-search-article-forward (regexp &optional backward)
9099   "Search for an article containing REGEXP forward.
9100 If BACKWARD, search backward instead."
9101   (interactive
9102    (list (read-string
9103           (format "Search article %s (regexp%s): "
9104                   (if current-prefix-arg "backward" "forward")
9105                   (if gnus-last-search-regexp
9106                       (concat ", default " gnus-last-search-regexp)
9107                     "")))
9108          current-prefix-arg))
9109   (if (string-equal regexp "")
9110       (setq regexp (or gnus-last-search-regexp ""))
9111     (setq gnus-last-search-regexp regexp)
9112     (setq gnus-article-before-search gnus-current-article))
9113   ;; Intentionally set gnus-last-article.
9114   (setq gnus-last-article gnus-article-before-search)
9115   (let ((gnus-last-article gnus-last-article))
9116     (if (gnus-summary-search-article regexp backward)
9117         (gnus-summary-show-thread)
9118       (signal 'search-failed (list regexp)))))
9119
9120 (defun gnus-summary-search-article-backward (regexp)
9121   "Search for an article containing REGEXP backward."
9122   (interactive
9123    (list (read-string
9124           (format "Search article backward (regexp%s): "
9125                   (if gnus-last-search-regexp
9126                       (concat ", default " gnus-last-search-regexp)
9127                     "")))))
9128   (gnus-summary-search-article-forward regexp 'backward))
9129
9130 (defun gnus-summary-search-article (regexp &optional backward)
9131   "Search for an article containing REGEXP.
9132 Optional argument BACKWARD means do search for backward.
9133 `gnus-select-article-hook' is not called during the search."
9134   ;; We have to require this here to make sure that the following
9135   ;; dynamic binding isn't shadowed by autoloading.
9136   (require 'gnus-async)
9137   (require 'gnus-art)
9138   (let ((gnus-select-article-hook nil)  ;Disable hook.
9139         (gnus-article-prepare-hook nil)
9140         (gnus-mark-article-hook nil)    ;Inhibit marking as read.
9141         (gnus-use-article-prefetch nil)
9142         (gnus-xmas-force-redisplay nil) ;Inhibit XEmacs redisplay.
9143         (gnus-use-trees nil)            ;Inhibit updating tree buffer.
9144         (gnus-visual nil)
9145         (gnus-keep-backlog nil)
9146         (gnus-break-pages nil)
9147         (gnus-summary-display-arrow nil)
9148         (gnus-updated-mode-lines nil)
9149         (gnus-auto-center-summary nil)
9150         (sum (current-buffer))
9151         (gnus-display-mime-function nil)
9152         (found nil)
9153         point)
9154     (gnus-save-hidden-threads
9155       (gnus-summary-select-article)
9156       (set-buffer gnus-article-buffer)
9157       (goto-char (window-point (get-buffer-window (current-buffer))))
9158       (when backward
9159         (forward-line -1))
9160       (while (not found)
9161         (gnus-message 7 "Searching article: %d..." (cdr gnus-article-current))
9162         (if (if backward
9163                 (re-search-backward regexp nil t)
9164               (re-search-forward regexp nil t))
9165             ;; We found the regexp.
9166             (progn
9167               (setq found 'found)
9168               (beginning-of-line)
9169               (set-window-start
9170                (get-buffer-window (current-buffer))
9171                (point))
9172               (forward-line 1)
9173               (set-window-point
9174                (get-buffer-window (current-buffer))
9175                (point))
9176               (set-buffer sum)
9177               (setq point (point)))
9178           ;; We didn't find it, so we go to the next article.
9179           (set-buffer sum)
9180           (setq found 'not)
9181           (while (eq found 'not)
9182             (if (not (if backward (gnus-summary-find-prev)
9183                        (gnus-summary-find-next)))
9184                 ;; No more articles.
9185                 (setq found t)
9186               ;; Select the next article and adjust point.
9187               (unless (gnus-summary-article-sparse-p
9188                        (gnus-summary-article-number))
9189                 (setq found nil)
9190                 (gnus-summary-select-article)
9191                 (set-buffer gnus-article-buffer)
9192                 (widen)
9193                 (goto-char (if backward (point-max) (point-min))))))))
9194       (gnus-message 7 ""))
9195     ;; Return whether we found the regexp.
9196     (when (eq found 'found)
9197       (goto-char point)
9198       (gnus-summary-show-thread)
9199       (gnus-summary-goto-subject gnus-current-article)
9200       (gnus-summary-position-point)
9201       t)))
9202
9203 (defun gnus-find-matching-articles (header regexp)
9204   "Return a list of all articles that match REGEXP on HEADER.
9205 This search includes all articles in the current group that Gnus has
9206 fetched headers for, whether they are displayed or not."
9207   (let ((articles nil)
9208         ;; Can't eta-reduce because it's a macro.
9209         (func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))
9210         (case-fold-search t))
9211     (dolist (header gnus-newsgroup-headers)
9212       (when (string-match regexp (funcall func header))
9213         (push (mail-header-number header) articles)))
9214     (nreverse articles)))
9215
9216 (defun gnus-summary-find-matching (header regexp &optional backward unread
9217                                           not-case-fold not-matching)
9218   "Return a list of all articles that match REGEXP on HEADER.
9219 The search stars on the current article and goes forwards unless
9220 BACKWARD is non-nil.  If BACKWARD is `all', do all articles.
9221 If UNREAD is non-nil, only unread articles will
9222 be taken into consideration.  If NOT-CASE-FOLD, case won't be folded
9223 in the comparisons. If NOT-MATCHING, return a list of all articles that
9224 not match REGEXP on HEADER."
9225   (let ((case-fold-search (not not-case-fold))
9226         articles d func)
9227     (if (consp header)
9228         (if (eq (car header) 'extra)
9229             (setq func
9230                   `(lambda (h)
9231                      (or (cdr (assq ',(cdr header) (mail-header-extra h)))
9232                          "")))
9233           (error "%s is an invalid header" header))
9234       (unless (fboundp (intern (concat "mail-header-" header)))
9235         (error "%s is not a valid header" header))
9236       (setq func `(lambda (h) (,(intern (concat "mail-header-" header)) h))))
9237     (dolist (d (if (eq backward 'all)
9238                    gnus-newsgroup-data
9239                  (gnus-data-find-list
9240                   (gnus-summary-article-number)
9241                   (gnus-data-list backward))))
9242       (when (and (or (not unread)       ; We want all articles...
9243                      (gnus-data-unread-p d)) ; Or just unreads.
9244                  (vectorp (gnus-data-header d)) ; It's not a pseudo.
9245                  (if not-matching
9246                      (not (string-match
9247                            regexp
9248                            (funcall func (gnus-data-header d))))
9249                    (string-match regexp
9250                                  (funcall func (gnus-data-header d)))))
9251         (push (gnus-data-number d) articles))) ; Success!
9252     (nreverse articles)))
9253
9254 (defun gnus-summary-execute-command (header regexp command &optional backward)
9255   "Search forward for an article whose HEADER matches REGEXP and execute COMMAND.
9256 If HEADER is an empty string (or nil), the match is done on the entire
9257 article.  If BACKWARD (the prefix) is non-nil, search backward instead."
9258   (interactive
9259    (list (let ((completion-ignore-case t))
9260            (gnus-completing-read
9261             "Header name"
9262             (mapcar 'symbol-name
9263                     (append
9264                      '(Number Subject From Lines Date
9265                        Message-ID Xref References Body)
9266                      gnus-extra-headers))
9267             'require-match))
9268          (read-string "Regexp: ")
9269          (read-key-sequence "Command: ")
9270          current-prefix-arg))
9271   (when (equal header "Body")
9272     (setq header ""))
9273   ;; Hidden thread subtrees must be searched as well.
9274   (gnus-summary-show-all-threads)
9275   ;; We don't want to change current point nor window configuration.
9276   (save-excursion
9277     (save-window-excursion
9278       (let (gnus-visual
9279             gnus-treat-strip-trailing-blank-lines
9280             gnus-treat-strip-leading-blank-lines
9281             gnus-treat-strip-multiple-blank-lines
9282             gnus-treat-hide-boring-headers
9283             gnus-treat-fold-newsgroups
9284             gnus-article-prepare-hook)
9285         (gnus-message 6 "Executing %s..." (key-description command))
9286         ;; We'd like to execute COMMAND interactively so as to give arguments.
9287         (gnus-execute header regexp
9288                       `(call-interactively ',(key-binding command))
9289                       backward)
9290         (gnus-message 6 "Executing %s...done" (key-description command))))))
9291
9292 (defun gnus-summary-beginning-of-article ()
9293   "Scroll the article back to the beginning."
9294   (interactive)
9295   (gnus-summary-select-article)
9296   (gnus-configure-windows 'article)
9297   (gnus-eval-in-buffer-window gnus-article-buffer
9298     (widen)
9299     (goto-char (point-min))
9300     (when gnus-break-pages
9301       (gnus-narrow-to-page))))
9302
9303 (defun gnus-summary-end-of-article ()
9304   "Scroll to the end of the article."
9305   (interactive)
9306   (gnus-summary-select-article)
9307   (gnus-configure-windows 'article)
9308   (gnus-eval-in-buffer-window gnus-article-buffer
9309     (widen)
9310     (goto-char (point-max))
9311     (recenter -3)
9312     (when gnus-break-pages
9313       (gnus-narrow-to-page))))
9314
9315 (defun gnus-summary-print-truncate-and-quote (string &optional len)
9316   "Truncate to LEN and quote all \"(\"'s in STRING."
9317   (gnus-replace-in-string (if (and len (> (length string) len))
9318                               (substring string 0 len)
9319                             string)
9320                           "[()]" "\\\\\\&"))
9321
9322 (defun gnus-summary-print-article (&optional filename n)
9323   "Generate and print a PostScript image of the process-marked (mail) articles.
9324
9325 If used interactively, print the current article if none are
9326 process-marked.  With prefix arg, prompt the user for the name of the
9327 file to save in.
9328
9329 When used from Lisp, accept two optional args FILENAME and N.  N means
9330 to print the next N articles.  If N is negative, print the N previous
9331 articles.  If N is nil and articles have been marked with the process
9332 mark, print these instead.
9333
9334 If the optional first argument FILENAME is nil, send the image to the
9335 printer.  If FILENAME is a string, save the PostScript image in a file with
9336 that name.  If FILENAME is a number, prompt the user for the name of the file
9337 to save in."
9338   (interactive (list (ps-print-preprint current-prefix-arg)))
9339   (dolist (article (gnus-summary-work-articles n))
9340     (gnus-summary-select-article nil nil 'pseudo article)
9341     (gnus-eval-in-buffer-window gnus-article-buffer
9342       (gnus-print-buffer))
9343     (gnus-summary-remove-process-mark article))
9344   (ps-despool filename))
9345
9346 (defun gnus-print-buffer ()
9347   (let ((ps-left-header
9348          (list
9349           (concat "("
9350                   (gnus-summary-print-truncate-and-quote
9351                    (mail-header-subject gnus-current-headers)
9352                    66) ")")
9353           (concat "("
9354                   (gnus-summary-print-truncate-and-quote
9355                    (mail-header-from gnus-current-headers)
9356                    45) ")")))
9357         (ps-right-header
9358          (list
9359           "/pagenumberstring load"
9360           (concat "("
9361                   (mail-header-date gnus-current-headers) ")"))))
9362     (gnus-run-hooks 'gnus-ps-print-hook)
9363     (save-excursion
9364       (if ps-print-color-p
9365           (ps-spool-buffer-with-faces)
9366         (ps-spool-buffer)))))
9367
9368 (defun gnus-summary-show-complete-article ()
9369   "Show a complete version of the current article.
9370 This is only useful if you're looking at a partial version of the
9371 article currently."
9372   (interactive)
9373   (let ((gnus-keep-backlog nil)
9374         (gnus-use-cache nil)
9375         (gnus-agent nil)
9376         (variable (intern
9377                    (format "%s-fetch-partial-articles"
9378                            (car (gnus-find-method-for-group
9379                                  gnus-newsgroup-name)))
9380                    obarray))
9381         old-val)
9382     (unwind-protect
9383         (progn
9384           (setq old-val (symbol-value variable))
9385           (set variable nil)
9386           (gnus-flush-original-article-buffer)
9387           (gnus-summary-show-article))
9388       (set variable old-val))))
9389
9390 (defun gnus-summary-show-article (&optional arg)
9391   "Force redisplaying of the current article.
9392 If ARG (the prefix) is a number, show the article with the charset
9393 defined in `gnus-summary-show-article-charset-alist', or the charset
9394 input.
9395 If ARG (the prefix) is non-nil and not a number, show the article,
9396 but without running any of the article treatment functions
9397 article.  Normally, the keystroke is `C-u g'.  When using `C-u
9398 C-u g', show the raw article."
9399   (interactive "P")
9400   (cond
9401    ((numberp arg)
9402     (gnus-summary-show-article t)
9403     (let ((gnus-newsgroup-charset
9404            (or (cdr (assq arg gnus-summary-show-article-charset-alist))
9405                (mm-read-coding-system
9406                 "View as charset: " ;; actually it is coding system.
9407                 (with-current-buffer gnus-article-buffer
9408                   (mm-detect-coding-region (point) (point-max))))))
9409           (gnus-newsgroup-ignored-charsets 'gnus-all))
9410       (gnus-summary-select-article nil 'force)
9411       (let ((deps gnus-newsgroup-dependencies)
9412             head header lines)
9413         (with-current-buffer gnus-original-article-buffer
9414           (save-restriction
9415             (message-narrow-to-head)
9416             (setq head (buffer-string))
9417             (goto-char (point-min))
9418             (unless (re-search-forward "^lines:[ \t]\\([0-9]+\\)" nil t)
9419               (goto-char (point-max))
9420               (widen)
9421               (setq lines (1- (count-lines (point) (point-max))))))
9422           (with-temp-buffer
9423             (insert (format "211 %d Article retrieved.\n"
9424                             (cdr gnus-article-current)))
9425             (insert head)
9426             (if lines (insert (format "Lines: %d\n" lines)))
9427             (insert ".\n")
9428             (let ((nntp-server-buffer (current-buffer)))
9429               (setq header (car (gnus-get-newsgroup-headers deps t))))))
9430         (gnus-data-set-header
9431          (gnus-data-find (cdr gnus-article-current))
9432          header)
9433         (gnus-summary-update-article-line
9434          (cdr gnus-article-current) header)
9435         (when (gnus-summary-goto-subject (cdr gnus-article-current) nil t)
9436           (gnus-summary-update-secondary-mark (cdr gnus-article-current))))))
9437    ((not arg)
9438     ;; Select the article the normal way.
9439     (gnus-summary-select-article nil 'force))
9440    ((or (equal arg '(16))
9441         (eq arg t))
9442     ;; C-u C-u g
9443     ;; We have to require this here to make sure that the following
9444     ;; dynamic binding isn't shadowed by autoloading.
9445     (require 'gnus-async)
9446     (require 'gnus-art)
9447     ;; Bind the article treatment functions to nil.
9448     (let ((gnus-have-all-headers t)
9449           gnus-article-prepare-hook
9450           gnus-article-decode-hook
9451           gnus-display-mime-function
9452           gnus-break-pages)
9453       ;; Destroy any MIME parts.
9454       (when (gnus-buffer-live-p gnus-article-buffer)
9455         (with-current-buffer gnus-article-buffer
9456           (mm-destroy-parts gnus-article-mime-handles)
9457           ;; Set it to nil for safety reason.
9458           (setq gnus-article-mime-handle-alist nil)
9459           (setq gnus-article-mime-handles nil)))
9460       (gnus-summary-select-article nil 'force)))
9461    (t
9462     (let ((gnus-inhibit-article-treatments t))
9463       (gnus-summary-select-article nil 'force))))
9464   (gnus-summary-goto-subject gnus-current-article)
9465   (gnus-summary-position-point))
9466
9467 (defun gnus-summary-show-raw-article ()
9468   "Show the raw article without any article massaging functions being run."
9469   (interactive)
9470   (gnus-summary-show-article t))
9471
9472 (defun gnus-summary-verbose-headers (&optional arg)
9473   "Toggle permanent full header display.
9474 If ARG is a positive number, turn header display on.
9475 If ARG is a negative number, turn header display off."
9476   (interactive "P")
9477   (setq gnus-show-all-headers
9478         (cond ((or (not (numberp arg))
9479                    (zerop arg))
9480                (not gnus-show-all-headers))
9481               ((natnump arg)
9482                t)))
9483   (gnus-summary-show-article))
9484
9485 (defun gnus-summary-toggle-header (&optional arg)
9486   "Show the headers if they are hidden, or hide them if they are shown.
9487 If ARG is a positive number, show the entire header.
9488 If ARG is a negative number, hide the unwanted header lines."
9489   (interactive "P")
9490   (let ((window (and (gnus-buffer-live-p gnus-article-buffer)
9491                      (get-buffer-window gnus-article-buffer t))))
9492     (with-current-buffer gnus-article-buffer
9493       (widen)
9494       (article-narrow-to-head)
9495       (let* ((inhibit-read-only t)
9496              (inhibit-point-motion-hooks t)
9497              (hidden (if (numberp arg)
9498                          (>= arg 0)
9499                        (or (not (looking-at "[^ \t\n]+:"))
9500                            (gnus-article-hidden-text-p 'headers))))
9501              s e)
9502         (delete-region (point-min) (point-max))
9503         (with-current-buffer gnus-original-article-buffer
9504           (goto-char (setq s (point-min)))
9505           (setq e (if (search-forward "\n\n" nil t)
9506                       (1- (point))
9507                     (point-max))))
9508         (insert-buffer-substring gnus-original-article-buffer s e)
9509         (run-hooks 'gnus-article-decode-hook)
9510         (if hidden
9511             (let ((gnus-treat-hide-headers nil)
9512                   (gnus-treat-hide-boring-headers nil))
9513               (gnus-delete-wash-type 'headers)
9514               (gnus-treat-article 'head))
9515           (gnus-treat-article 'head))
9516         (widen)
9517         (if window
9518             (set-window-start window (goto-char (point-min))))
9519         (if gnus-break-pages
9520             (gnus-narrow-to-page)
9521           (when (gnus-visual-p 'page-marker)
9522             (let ((inhibit-read-only t))
9523               (gnus-remove-text-with-property 'gnus-prev)
9524               (gnus-remove-text-with-property 'gnus-next))))
9525         (gnus-set-mode-line 'article)))))
9526
9527 (defun gnus-summary-show-all-headers ()
9528   "Make all header lines visible."
9529   (interactive)
9530   (gnus-summary-toggle-header 1))
9531
9532 (defun gnus-summary-caesar-message (&optional arg)
9533   "Caesar rotate the current article by 13.
9534 With a non-numerical prefix, also rotate headers.  A numerical
9535 prefix specifies how many places to rotate each letter forward."
9536   (interactive "P")
9537   (gnus-summary-select-article)
9538   (let ((mail-header-separator ""))
9539     (gnus-eval-in-buffer-window gnus-article-buffer
9540       (save-restriction
9541         (widen)
9542         (let ((start (window-start))
9543               (inhibit-read-only t))
9544           (if (equal arg '(4))
9545               (message-caesar-buffer-body nil t)
9546             (message-caesar-buffer-body arg))
9547           (set-window-start (get-buffer-window (current-buffer)) start)))))
9548   ;; Create buttons and stuff...
9549   (gnus-treat-article nil))
9550
9551 (declare-function idna-to-unicode "ext:idna" (str))
9552
9553 (defun gnus-summary-idna-message (&optional arg)
9554   "Decode IDNA encoded domain names in the current articles.
9555 IDNA encoded domain names looks like `xn--bar'.  If a string
9556 remain unencoded after running this function, it is likely an
9557 invalid IDNA string (`xn--bar' is invalid).
9558
9559 You must have GNU Libidn (URL `http://www.gnu.org/software/libidn/')
9560 installed for this command to work."
9561   (interactive "P")
9562   (if (not (and (condition-case nil (require 'idna)
9563                   (file-error))
9564                 (mm-coding-system-p 'utf-8)
9565                 (executable-find (symbol-value 'idna-program))))
9566       (gnus-message
9567        5 "GNU Libidn not installed properly (`idn' or `idna.el' missing)")
9568     (gnus-summary-select-article)
9569     (let ((mail-header-separator ""))
9570       (gnus-eval-in-buffer-window gnus-article-buffer
9571         (save-restriction
9572           (widen)
9573           (let ((start (window-start))
9574                 buffer-read-only)
9575             (while (re-search-forward "\\(xn--[-0-9a-z]+\\)" nil t)
9576               (replace-match (idna-to-unicode (match-string 1))))
9577             (set-window-start (get-buffer-window (current-buffer)) start)))))))
9578
9579 (defun gnus-summary-morse-message (&optional arg)
9580   "Morse decode the current article."
9581   (interactive "P")
9582   (gnus-summary-select-article)
9583   (let ((mail-header-separator ""))
9584     (gnus-eval-in-buffer-window gnus-article-buffer
9585       (save-excursion
9586         (save-restriction
9587           (widen)
9588           (let ((pos (window-start))
9589                 (inhibit-read-only t))
9590             (goto-char (point-min))
9591             (when (message-goto-body)
9592               (gnus-narrow-to-body))
9593             (goto-char (point-min))
9594             (while (search-forward "·" (point-max) t)
9595               (replace-match "."))
9596             (unmorse-region (point-min) (point-max))
9597             (widen)
9598             (set-window-start (get-buffer-window (current-buffer)) pos)))))))
9599
9600 (defun gnus-summary-stop-page-breaking ()
9601   "Stop page breaking in the current article."
9602   (interactive)
9603   (gnus-summary-select-article)
9604   (gnus-eval-in-buffer-window gnus-article-buffer
9605     (widen)
9606     (when (gnus-visual-p 'page-marker)
9607       (let ((inhibit-read-only t))
9608         (gnus-remove-text-with-property 'gnus-prev)
9609         (gnus-remove-text-with-property 'gnus-next))
9610       (setq gnus-page-broken nil))))
9611
9612 (defun gnus-summary-move-article (&optional n to-newsgroup
9613                                             select-method action)
9614   "Move the current article to a different newsgroup.
9615 If N is a positive number, move the N next articles.
9616 If N is a negative number, move the N previous articles.
9617 If N is nil and any articles have been marked with the process mark,
9618 move those articles instead.
9619 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to.
9620 If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but
9621 re-spool using this method.
9622
9623 When called interactively with TO-NEWSGROUP being nil, the value of
9624 the variable `gnus-move-split-methods' is used for finding a default
9625 for the target newsgroup.
9626
9627 For this function to work, both the current newsgroup and the
9628 newsgroup that you want to move to have to support the `request-move'
9629 and `request-accept' functions.
9630
9631 ACTION can be either `move' (the default), `crosspost' or `copy'."
9632   (interactive "P")
9633   (unless action
9634     (setq action 'move))
9635   ;; Check whether the source group supports the required functions.
9636   (cond ((and (eq action 'move)
9637               (not (gnus-check-backend-function
9638                     'request-move-article gnus-newsgroup-name)))
9639          (error "The current group does not support article moving"))
9640         ((and (eq action 'crosspost)
9641               (not (gnus-check-backend-function
9642                     'request-replace-article gnus-newsgroup-name)))
9643          (error "The current group does not support article editing")))
9644   (let ((articles (gnus-summary-work-articles n))
9645         (prefix (if (gnus-check-backend-function
9646                      'request-move-article gnus-newsgroup-name)
9647                     (funcall gnus-move-group-prefix-function
9648                              gnus-newsgroup-name)
9649                   ""))
9650         (names '((move "Move" "Moving")
9651                  (copy "Copy" "Copying")
9652                  (crosspost "Crosspost" "Crossposting")))
9653         (copy-buf (save-excursion
9654                     (nnheader-set-temp-buffer " *copy article*")))
9655         art-group to-method new-xref article to-groups
9656         articles-to-update-marks encoded)
9657     (unless (assq action names)
9658       (error "Unknown action %s" action))
9659     ;; Read the newsgroup name.
9660     (when (and (not to-newsgroup)
9661                (not select-method))
9662       (if (and gnus-move-split-methods
9663                (not
9664                 (and (memq gnus-current-article articles)
9665                      (gnus-buffer-live-p gnus-original-article-buffer))))
9666           ;; When `gnus-move-split-methods' is non-nil, we have to
9667           ;; select an article to give `gnus-read-move-group-name' an
9668           ;; opportunity to suggest an appropriate default.  However,
9669           ;; we needn't render or mark the article.
9670           (let ((gnus-display-mime-function nil)
9671                 (gnus-article-prepare-hook nil)
9672                 (gnus-mark-article-hook nil))
9673             (gnus-summary-select-article nil nil nil (car articles))))
9674       (setq to-newsgroup (gnus-read-move-group-name
9675                           (cadr (assq action names))
9676                           (symbol-value
9677                            (intern (format "gnus-current-%s-group" action)))
9678                           articles prefix)
9679             encoded to-newsgroup
9680             to-method (gnus-server-to-method (gnus-group-method to-newsgroup)))
9681       (set (intern (format "gnus-current-%s-group" action))
9682            (mm-decode-coding-string
9683             to-newsgroup
9684             (gnus-group-name-charset to-method to-newsgroup))))
9685     (unless to-method
9686       (setq to-method (or select-method
9687                           (gnus-server-to-method
9688                            (gnus-group-method to-newsgroup)))))
9689     (setq to-newsgroup
9690           (or encoded
9691               (and to-newsgroup
9692                    (mm-encode-coding-string
9693                     to-newsgroup
9694                     (gnus-group-name-charset to-method to-newsgroup)))))
9695     ;; Check the method we are to move this article to...
9696     (unless (gnus-check-backend-function
9697              'request-accept-article (car to-method))
9698       (error "%s does not support article copying" (car to-method)))
9699     (unless (gnus-check-server to-method)
9700       (error "Can't open server %s" (car to-method)))
9701     (gnus-message 6 "%s to %s: %s..."
9702                   (caddr (assq action names))
9703                   (or (car select-method)
9704                       (gnus-group-decoded-name to-newsgroup))
9705                   articles)
9706     (while articles
9707       (setq article (pop articles))
9708       (let ((gnus-newsgroup-original-name gnus-newsgroup-name)
9709             (gnus-article-original-subject
9710              (mail-header-subject
9711               (gnus-data-header (assoc article (gnus-data-list nil))))))
9712         (setq
9713          art-group
9714          (cond
9715           ;; Move the article.
9716           ((eq action 'move)
9717            ;; Remove this article from future suppression.
9718            (gnus-dup-unsuppress-article article)
9719            (let* ((from-method (gnus-find-method-for-group
9720                                 gnus-newsgroup-name))
9721                   (to-method (or select-method
9722                                  (gnus-find-method-for-group to-newsgroup)))
9723                   (move-is-internal (gnus-server-equal from-method to-method)))
9724              (gnus-request-move-article
9725               article                   ; Article to move
9726               gnus-newsgroup-name       ; From newsgroup
9727               (nth 1 (gnus-find-method-for-group
9728                       gnus-newsgroup-name)) ; Server
9729               (list 'gnus-request-accept-article
9730                     to-newsgroup (list 'quote select-method)
9731                     (not articles) t)   ; Accept form
9732               (not articles)            ; Only save nov last time
9733               (and move-is-internal
9734                    to-newsgroup         ; Not respooling
9735                                         ; Is this move internal?
9736                    (gnus-group-real-name to-newsgroup)))))
9737           ;; Copy the article.
9738           ((eq action 'copy)
9739            (with-current-buffer copy-buf
9740              (when (gnus-request-article-this-buffer article
9741                                                      gnus-newsgroup-name)
9742                (save-restriction
9743                  (nnheader-narrow-to-headers)
9744                  (dolist (hdr gnus-copy-article-ignored-headers)
9745                    (message-remove-header hdr t)))
9746                (gnus-request-accept-article
9747                 to-newsgroup select-method (not articles) t))))
9748           ;; Crosspost the article.
9749           ((eq action 'crosspost)
9750            (let ((xref (message-tokenize-header
9751                         (mail-header-xref (gnus-summary-article-header
9752                                            article))
9753                         " ")))
9754              (setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name)
9755                                     ":" (number-to-string article)))
9756              (unless xref
9757                (setq xref (list (system-name))))
9758              (setq new-xref
9759                    (concat
9760                     (mapconcat 'identity
9761                                (delete "Xref:" (delete new-xref xref))
9762                                " ")
9763                     " " new-xref))
9764              (with-current-buffer copy-buf
9765                ;; First put the article in the destination group.
9766                (gnus-request-article-this-buffer article gnus-newsgroup-name)
9767                (when (consp (setq art-group
9768                                   (gnus-request-accept-article
9769                                    to-newsgroup select-method (not articles)
9770                                    t)))
9771                  (setq new-xref (concat new-xref " " (car art-group)
9772                                         ":"
9773                                         (number-to-string (cdr art-group))))
9774                  ;; Now we have the new Xrefs header, so we insert
9775                  ;; it and replace the new article.
9776                  (nnheader-replace-header "Xref" new-xref)
9777                  (gnus-request-replace-article
9778                   (cdr art-group) to-newsgroup (current-buffer) t)
9779                  art-group))))))
9780         (cond
9781          ((not art-group)
9782           (gnus-message 1 "Couldn't %s article %s: %s"
9783                         (cadr (assq action names)) article
9784                         (nnheader-get-report (car to-method))))
9785          ((eq art-group 'junk)
9786           (when (eq action 'move)
9787             (gnus-summary-mark-article article gnus-canceled-mark)
9788             (gnus-message 4 "Deleted article %s" article)
9789             ;; run the delete hook
9790             (run-hook-with-args 'gnus-summary-article-delete-hook
9791                                 action
9792                                 (gnus-data-header
9793                                  (assoc article (gnus-data-list nil)))
9794                                 gnus-newsgroup-original-name nil
9795                                 select-method)))
9796          (t
9797           (let* ((pto-group (gnus-group-prefixed-name
9798                              (car art-group) to-method))
9799                  (info (gnus-get-info pto-group))
9800                  (to-group (gnus-info-group info))
9801                  to-marks)
9802             ;; Update the group that has been moved to.
9803             (when (and info
9804                        (memq action '(move copy)))
9805               (unless (member to-group to-groups)
9806                 (push to-group to-groups))
9807
9808               (unless (memq article gnus-newsgroup-unreads)
9809                 (push 'read to-marks)
9810                 (gnus-info-set-read
9811                  info (gnus-add-to-range (gnus-info-read info)
9812                                          (list (cdr art-group)))))
9813
9814               ;; See whether the article is to be put in the cache.
9815               (let* ((expirable (gnus-group-auto-expirable-p to-group))
9816                      (marks (if expirable
9817                                 gnus-article-mark-lists
9818                               (delete '(expirable . expire)
9819                                       (copy-sequence
9820                                        gnus-article-mark-lists))))
9821                      (to-article (cdr art-group)))
9822
9823                 ;; Enter the article into the cache in the new group,
9824                 ;; if that is required.
9825                 (when gnus-use-cache
9826                   (gnus-cache-possibly-enter-article
9827                    to-group to-article
9828                    (memq article gnus-newsgroup-marked)
9829                    (memq article gnus-newsgroup-dormant)
9830                    (memq article gnus-newsgroup-unreads)))
9831
9832                 (when gnus-preserve-marks
9833                   ;; Copy any marks over to the new group.
9834                   (when (and (equal to-group gnus-newsgroup-name)
9835                              (not (memq article gnus-newsgroup-unreads)))
9836                     ;; Mark this article as read in this group.
9837                     (push (cons to-article gnus-read-mark)
9838                           gnus-newsgroup-reads)
9839                     ;; Increase the active status of this group.
9840                     (setcdr (gnus-active to-group) to-article)
9841                     (setcdr gnus-newsgroup-active to-article))
9842
9843                   (while marks
9844                     (when (eq (gnus-article-mark-to-type (cdar marks)) 'list)
9845                       (when (memq article (symbol-value
9846                                            (intern (format "gnus-newsgroup-%s"
9847                                                            (caar marks)))))
9848                         (push (cdar marks) to-marks)
9849                         ;; If the other group is the same as this group,
9850                         ;; then we have to add the mark to the list.
9851                         (when (equal to-group gnus-newsgroup-name)
9852                           (set (intern (format "gnus-newsgroup-%s"
9853                                                (caar marks)))
9854                                (cons to-article
9855                                      (symbol-value
9856                                       (intern (format "gnus-newsgroup-%s"
9857                                                       (caar marks)))))))
9858                         ;; Copy the marks to other group.
9859                         (gnus-add-marked-articles
9860                          to-group (cdar marks) (list to-article) info)))
9861                     (setq marks (cdr marks)))
9862
9863                   (when (and expirable
9864                              gnus-mark-copied-or-moved-articles-as-expirable
9865                              (not (memq 'expire to-marks)))
9866                     ;; Mark this article as expirable.
9867                     (push 'expire to-marks)
9868                     (when (equal to-group gnus-newsgroup-name)
9869                       (push to-article gnus-newsgroup-expirable))
9870                     ;; Copy the expirable mark to other group.
9871                     (gnus-add-marked-articles
9872                      to-group 'expire (list to-article) info))
9873
9874                   (when to-marks
9875                     (gnus-request-set-mark
9876                      to-group (list (list (list to-article) 'add to-marks)))))
9877
9878                 (gnus-dribble-enter
9879                  (concat "(gnus-group-set-info '"
9880                          (gnus-prin1-to-string (gnus-get-info to-group))
9881                          ")"))))
9882
9883             ;; Update the Xref header in this article to point to
9884             ;; the new crossposted article we have just created.
9885             (when (eq action 'crosspost)
9886               (with-current-buffer copy-buf
9887                 (gnus-request-article-this-buffer article gnus-newsgroup-name)
9888                 (nnheader-replace-header "Xref" new-xref)
9889                 (gnus-request-replace-article
9890                  article gnus-newsgroup-name (current-buffer) t)))
9891
9892             ;; run the move/copy/crosspost/respool hook
9893             (let ((header (gnus-data-header
9894                            (assoc article (gnus-data-list nil)))))
9895               (mail-header-set-subject header gnus-article-original-subject)
9896               (run-hook-with-args 'gnus-summary-article-move-hook
9897                                   action
9898                                   (gnus-data-header
9899                                    (assoc article (gnus-data-list nil)))
9900                                   gnus-newsgroup-original-name
9901                                   to-newsgroup
9902                                   select-method)))
9903
9904           ;;;!!!Why is this necessary?
9905           (set-buffer gnus-summary-buffer)
9906
9907           (when (eq action 'move)
9908             (save-excursion
9909               (gnus-summary-goto-subject article)
9910               (gnus-summary-mark-article article gnus-canceled-mark)))))
9911         (push article articles-to-update-marks)))
9912
9913     (save-excursion
9914       (apply 'gnus-summary-remove-process-mark articles-to-update-marks))
9915     ;; Re-activate all groups that have been moved to.
9916     (with-current-buffer gnus-group-buffer
9917       (let ((gnus-group-marked to-groups))
9918         (gnus-group-get-new-news-this-group nil t)))
9919
9920     (gnus-kill-buffer copy-buf)
9921     (gnus-summary-position-point)
9922     (gnus-set-mode-line 'summary)))
9923
9924 (defun gnus-summary-copy-article (&optional n to-newsgroup select-method)
9925   "Copy the current article to some other group.
9926 If TO-NEWSGROUP is string, do not prompt for a newsgroup to copy to.
9927 When called interactively, if TO-NEWSGROUP is nil, use the value of
9928 the variable `gnus-move-split-methods' for finding a default target
9929 newsgroup.
9930 If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but
9931 re-spool using this method."
9932   (interactive "P")
9933   (gnus-summary-move-article n to-newsgroup select-method 'copy))
9934
9935 (defun gnus-summary-crosspost-article (&optional n)
9936   "Crosspost the current article to some other group."
9937   (interactive "P")
9938   (gnus-summary-move-article n nil nil 'crosspost))
9939
9940 (defcustom gnus-summary-respool-default-method nil
9941   "Default method type for respooling an article.
9942 If nil, use to the current newsgroup method."
9943   :type 'symbol
9944   :group 'gnus-summary-mail)
9945
9946 (defun gnus-summary-respool-article (&optional n method)
9947   "Respool the current article.
9948 The article will be squeezed through the mail spooling process again,
9949 which means that it will be put in some mail newsgroup or other
9950 depending on `nnmail-split-methods'.
9951 If N is a positive number, respool the N next articles.
9952 If N is a negative number, respool the N previous articles.
9953 If N is nil and any articles have been marked with the process mark,
9954 respool those articles instead.
9955
9956 Respooling can be done both from mail groups and \"real\" newsgroups.
9957 In the former case, the articles in question will be moved from the
9958 current group into whatever groups they are destined to.  In the
9959 latter case, they will be copied into the relevant groups."
9960   (interactive
9961    (list current-prefix-arg
9962          (let* ((methods (gnus-methods-using 'respool))
9963                 (methname
9964                  (symbol-name (or gnus-summary-respool-default-method
9965                                   (car (gnus-find-method-for-group
9966                                         gnus-newsgroup-name)))))
9967                 (method
9968                  (gnus-completing-read
9969                   "Backend to use when respooling"
9970                   methods t nil 'gnus-mail-method-history methname))
9971                 ms)
9972            (cond
9973             ((zerop (length (setq ms (gnus-servers-using-backend
9974                                       (intern method)))))
9975              (list (intern method) ""))
9976             ((= 1 (length ms))
9977              (car ms))
9978             (t
9979              (let ((ms-alist (mapcar (lambda (m) (cons (cadr m) m)) ms)))
9980                (cdr (assoc (gnus-completing-read "Server name" ms-alist t)
9981                            ms-alist))))))))
9982   (unless method
9983     (error "No method given for respooling"))
9984   (if (assoc (symbol-name
9985               (car (gnus-find-method-for-group gnus-newsgroup-name)))
9986              (gnus-methods-using 'respool))
9987       (gnus-summary-move-article n nil method)
9988     (gnus-summary-copy-article n nil method)))
9989
9990 (defun gnus-summary-import-article (file &optional edit)
9991   "Import an arbitrary file into a mail newsgroup."
9992   (interactive "fImport file: \nP")
9993   (let ((group gnus-newsgroup-name)
9994         (now (current-time))
9995         atts lines group-art)
9996     (unless (gnus-check-backend-function 'request-accept-article group)
9997       (error "%s does not support article importing" group))
9998     (or (file-readable-p file)
9999         (not (file-regular-p file))
10000         (error "Can't read %s" file))
10001     (with-current-buffer (gnus-get-buffer-create " *import file*")
10002       (erase-buffer)
10003       (nnheader-insert-file-contents file)
10004       (goto-char (point-min))
10005       (if (nnheader-article-p)
10006           (save-restriction
10007             (goto-char (point-min))
10008             (search-forward "\n\n" nil t)
10009             (narrow-to-region (point-min) (1- (point)))
10010             (goto-char (point-min))
10011             (unless (re-search-forward "^date:" nil t)
10012               (goto-char (point-max))
10013               (insert "Date: " (message-make-date (nth 5 atts)) "\n")))
10014        ;; This doesn't look like an article, so we fudge some headers.
10015         (setq atts (file-attributes file)
10016               lines (count-lines (point-min) (point-max)))
10017         (insert "From: " (read-string "From: ") "\n"
10018                 "Subject: " (read-string "Subject: ") "\n"
10019                 "Date: " (message-make-date (nth 5 atts)) "\n"
10020                 "Message-ID: " (message-make-message-id) "\n"
10021                 "Lines: " (int-to-string lines) "\n"
10022                 "Chars: " (int-to-string (nth 7 atts)) "\n\n"))
10023       (setq group-art (gnus-request-accept-article group nil t))
10024       (kill-buffer (current-buffer)))
10025     (setq gnus-newsgroup-active (gnus-activate-group group))
10026     (forward-line 1)
10027     (gnus-summary-goto-article (cdr group-art) nil t)
10028     (when edit
10029       (gnus-summary-edit-article))))
10030
10031 (defun gnus-summary-create-article ()
10032   "Create an article in a mail newsgroup."
10033   (interactive)
10034   (let ((group gnus-newsgroup-name)
10035         (now (current-time))
10036         group-art)
10037     (unless (gnus-check-backend-function 'request-accept-article group)
10038       (error "%s does not support article importing" group))
10039     (with-current-buffer (gnus-get-buffer-create " *import file*")
10040       (erase-buffer)
10041       (goto-char (point-min))
10042       ;; This doesn't look like an article, so we fudge some headers.
10043       (insert "From: " (read-string "From: ") "\n"
10044               "Subject: " (read-string "Subject: ") "\n"
10045               "Date: " (message-make-date now) "\n"
10046               "Message-ID: " (message-make-message-id) "\n")
10047       (setq group-art (gnus-request-accept-article group nil t))
10048       (kill-buffer (current-buffer)))
10049     (setq gnus-newsgroup-active (gnus-activate-group group))
10050     (forward-line 1)
10051     (gnus-summary-goto-article (cdr group-art) nil t)
10052     (gnus-summary-edit-article)))
10053
10054 (defun gnus-summary-article-posted-p ()
10055   "Say whether the current (mail) article is available from news as well.
10056 This will be the case if the article has both been mailed and posted."
10057   (interactive)
10058   (let ((id (mail-header-references (gnus-summary-article-header)))
10059         (gnus-override-method (car (gnus-refer-article-methods))))
10060     (if (gnus-request-head id "")
10061         (gnus-message 2 "The current message was found on %s"
10062                       gnus-override-method)
10063       (gnus-message 2 "The current message couldn't be found on %s"
10064                     gnus-override-method)
10065       nil)))
10066
10067 (defun gnus-summary-expire-articles (&optional now)
10068   "Expire all articles that are marked as expirable in the current group."
10069   (interactive)
10070   (when (and (not gnus-group-is-exiting-without-update-p)
10071              (gnus-check-backend-function
10072               'request-expire-articles gnus-newsgroup-name))
10073     ;; This backend supports expiry.
10074     (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name))
10075            (expirable (if total
10076                           (progn
10077                             ;; We need to update the info for
10078                             ;; this group for `gnus-list-of-read-articles'
10079                             ;; to give us the right answer.
10080                             (gnus-run-hooks 'gnus-exit-group-hook)
10081                             (gnus-summary-update-info)
10082                             (gnus-list-of-read-articles gnus-newsgroup-name))
10083                         (setq gnus-newsgroup-expirable
10084                               (sort gnus-newsgroup-expirable '<))))
10085            (expiry-wait (if now 'immediate
10086                           (gnus-group-find-parameter
10087                            gnus-newsgroup-name 'expiry-wait)))
10088            (nnmail-expiry-target
10089             (or (gnus-group-find-parameter gnus-newsgroup-name 'expiry-target)
10090                 nnmail-expiry-target))
10091            es)
10092       (when expirable
10093         ;; There are expirable articles in this group, so we run them
10094         ;; through the expiry process.
10095         (gnus-message 6 "Expiring articles...")
10096         (unless (gnus-check-group gnus-newsgroup-name)
10097           (error "Can't open server for %s" gnus-newsgroup-name))
10098         ;; The list of articles that weren't expired is returned.
10099         (save-excursion
10100           (if expiry-wait
10101               (let ((nnmail-expiry-wait-function nil)
10102                     (nnmail-expiry-wait expiry-wait))
10103                 (setq es (gnus-request-expire-articles
10104                           expirable gnus-newsgroup-name)))
10105             (setq es (gnus-request-expire-articles
10106                       expirable gnus-newsgroup-name)))
10107           (unless total
10108             (setq gnus-newsgroup-expirable es))
10109           ;; We go through the old list of expirable, and mark all
10110           ;; really expired articles as nonexistent.
10111           (unless (eq es expirable) ;If nothing was expired, we don't mark.
10112             (let ((gnus-use-cache nil))
10113               (dolist (article expirable)
10114                 (when (and (not (memq article es))
10115                            (gnus-data-find article))
10116                   (gnus-summary-mark-article article gnus-canceled-mark)
10117                   (run-hook-with-args 'gnus-summary-article-expire-hook
10118                                       'delete
10119                                       (gnus-data-header
10120                                        (assoc article (gnus-data-list nil)))
10121                                       gnus-newsgroup-name
10122                                       nil
10123                                       nil))))))
10124         (gnus-message 6 "Expiring articles...done")))))
10125
10126 (defun gnus-summary-expire-articles-now ()
10127   "Expunge all expirable articles in the current group.
10128 This means that *all* articles that are marked as expirable will be
10129 deleted forever, right now."
10130   (interactive)
10131   (or gnus-expert-user
10132       (gnus-yes-or-no-p
10133        "Are you really, really sure you want to delete all expirable messages? ")
10134       (error "Phew!"))
10135   (gnus-summary-expire-articles t))
10136
10137 ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
10138 (defun gnus-summary-delete-article (&optional n)
10139   "Delete the N next (mail) articles.
10140 This command actually deletes articles.  This is not a marking
10141 command.  The article will disappear forever from your life, never to
10142 return.
10143
10144 If N is negative, delete backwards.
10145 If N is nil and articles have been marked with the process mark,
10146 delete these instead.
10147
10148 If `gnus-novice-user' is non-nil you will be asked for
10149 confirmation before the articles are deleted."
10150   (interactive "P")
10151   (unless (gnus-check-backend-function 'request-expire-articles
10152                                        gnus-newsgroup-name)
10153     (error "The current newsgroup does not support article deletion"))
10154   (unless (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
10155     (error "Couldn't open server"))
10156   ;; Compute the list of articles to delete.
10157   (let ((articles (sort (copy-sequence (gnus-summary-work-articles n)) '<))
10158         (nnmail-expiry-target 'delete)
10159         not-deleted)
10160     (if (and gnus-novice-user
10161              (not (gnus-yes-or-no-p
10162                    (format "Do you really want to delete %s forever? "
10163                            (if (> (length articles) 1)
10164                                (format "these %s articles" (length articles))
10165                              "this article")))))
10166         ()
10167       ;; Delete the articles.
10168       (setq not-deleted (gnus-request-expire-articles
10169                          articles gnus-newsgroup-name 'force))
10170       (save-excursion
10171         (while articles
10172           (gnus-summary-remove-process-mark (car articles))
10173           ;; The backend might not have been able to delete the article
10174           ;; after all.
10175           (unless (memq (car articles) not-deleted)
10176             (gnus-summary-mark-article (car articles) gnus-canceled-mark))
10177           (let* ((article (car articles))
10178                  (ghead  (gnus-data-header
10179                           (assoc article (gnus-data-list nil)))))
10180             (run-hook-with-args 'gnus-summary-article-delete-hook
10181                                 'delete ghead gnus-newsgroup-name nil
10182                                 nil))
10183           (setq articles (cdr articles))))
10184       (when not-deleted
10185         (gnus-message 4 "Couldn't delete articles %s" not-deleted)))
10186     (gnus-summary-position-point)
10187     (gnus-set-mode-line 'summary)
10188     not-deleted))
10189
10190 (defun gnus-summary-edit-article (&optional arg)
10191   "Edit the current article.
10192 This will have permanent effect only in mail groups.
10193 If ARG is nil, edit the decoded articles.
10194 If ARG is 1, edit the raw articles.
10195 If ARG is 2, edit the raw articles even in read-only groups.
10196 If ARG is 3, edit the articles with the current handles.
10197 Otherwise, allow editing of articles even in read-only
10198 groups."
10199   (interactive "P")
10200   (let (force raw current-handles)
10201     (cond
10202      ((null arg))
10203      ((eq arg 1)
10204       (setq raw t))
10205      ((eq arg 2)
10206       (setq raw t
10207             force t))
10208      ((eq arg 3)
10209       (setq current-handles
10210             (and (gnus-buffer-live-p gnus-article-buffer)
10211                  (with-current-buffer gnus-article-buffer
10212                    (prog1
10213                        gnus-article-mime-handles
10214                      (setq gnus-article-mime-handles nil))))))
10215      (t
10216       (setq force t)))
10217     (when (and raw (not force)
10218                (member gnus-newsgroup-name '("nndraft:delayed"
10219                                              "nndraft:drafts"
10220                                              "nndraft:queue")))
10221       (error "Can't edit the raw article in group %s"
10222              gnus-newsgroup-name))
10223     (with-current-buffer gnus-summary-buffer
10224       (let ((mail-parse-charset gnus-newsgroup-charset)
10225             (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets))
10226         (gnus-set-global-variables)
10227         (when (and (not force)
10228                    (gnus-group-read-only-p))
10229           (error "The current newsgroup does not support article editing"))
10230         (gnus-summary-show-article t)
10231         (when (and (not raw) (gnus-buffer-live-p gnus-article-buffer))
10232           (with-current-buffer gnus-article-buffer
10233             (mm-enable-multibyte)))
10234         (if (member gnus-newsgroup-name '("nndraft:delayed" "nndraft:drafts"))
10235             (setq raw t))
10236         (gnus-article-edit-article
10237          (if raw 'ignore
10238            `(lambda ()
10239               (let ((mbl mml-buffer-list))
10240                 (setq mml-buffer-list nil)
10241                 (let ((rfc2047-quote-decoded-words-containing-tspecials t))
10242                   (mime-to-mml ,'current-handles))
10243                 (let ((mbl1 mml-buffer-list))
10244                   (setq mml-buffer-list mbl)
10245                   (set (make-local-variable 'mml-buffer-list) mbl1))
10246                 (gnus-make-local-hook 'kill-buffer-hook)
10247                 (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))))
10248          `(lambda (no-highlight)
10249             (let ((mail-parse-charset ',gnus-newsgroup-charset)
10250                   (message-options message-options)
10251                   (message-options-set-recipient)
10252                   (mail-parse-ignored-charsets
10253                    ',gnus-newsgroup-ignored-charsets)
10254                   (rfc2047-header-encoding-alist
10255                    ',(let ((charset (gnus-group-name-charset
10256                                      (gnus-find-method-for-group
10257                                       gnus-newsgroup-name)
10258                                      gnus-newsgroup-name)))
10259                        (append (list (cons "Newsgroups" charset)
10260                                      (cons "Followup-To" charset)
10261                                      (cons "Xref" charset))
10262                                rfc2047-header-encoding-alist))))
10263               ,(if (not raw) '(progn
10264                                 (mml-to-mime)
10265                                 (mml-destroy-buffers)
10266                                 (remove-hook 'kill-buffer-hook
10267                                              'mml-destroy-buffers t)
10268                                 (kill-local-variable 'mml-buffer-list)))
10269               (gnus-summary-edit-article-done
10270                ,(or (mail-header-references gnus-current-headers) "")
10271                ,(gnus-group-read-only-p)
10272                ,gnus-summary-buffer no-highlight))))))))
10273
10274 (defalias 'gnus-summary-edit-article-postpone 'gnus-article-edit-exit)
10275
10276 (defun gnus-summary-edit-article-done (&optional references read-only buffer
10277                                                  no-highlight)
10278   "Make edits to the current article permanent."
10279   (interactive)
10280   (save-excursion
10281     ;; The buffer restriction contains the entire article if it exists.
10282     (when (article-goto-body)
10283       (let ((lines (count-lines (point) (point-max)))
10284             (length (- (point-max) (point)))
10285             (case-fold-search t)
10286             (body (copy-marker (point))))
10287         (goto-char (point-min))
10288         (when (re-search-forward "^content-length:[ \t]\\([0-9]+\\)" body t)
10289           (delete-region (match-beginning 1) (match-end 1))
10290           (insert (number-to-string length)))
10291         (goto-char (point-min))
10292         (when (re-search-forward
10293                "^x-content-length:[ \t]\\([0-9]+\\)" body t)
10294           (delete-region (match-beginning 1) (match-end 1))
10295           (insert (number-to-string length)))
10296         (goto-char (point-min))
10297         (when (re-search-forward "^lines:[ \t]\\([0-9]+\\)" body t)
10298           (delete-region (match-beginning 1) (match-end 1))
10299           (insert (number-to-string lines))))))
10300   ;; Replace the article.
10301   (let ((buf (current-buffer))
10302         (article (cdr gnus-article-current))
10303         replace-result)
10304     (with-temp-buffer
10305       (insert-buffer-substring buf)
10306       (if (and (not read-only)
10307                (not (setq replace-result
10308                           (gnus-request-replace-article
10309                            article (car gnus-article-current)
10310                            (current-buffer) t))))
10311           (error "Couldn't replace article")
10312         ;; If we got a number back, then that's the new article number
10313         ;; for this article.  Otherwise, the article number didn't change.
10314         (when (numberp replace-result)
10315           (with-current-buffer gnus-summary-buffer
10316             (setq gnus-newsgroup-limit (delq article gnus-newsgroup-limit))
10317             (gnus-summary-limit gnus-newsgroup-limit)
10318             (setq article replace-result)
10319             (gnus-summary-goto-subject article t)))
10320         ;; Update the summary buffer.
10321         (if (and references
10322                  (equal (message-tokenize-header references " ")
10323                         (message-tokenize-header
10324                          (or (message-fetch-field "references") "") " ")))
10325             ;; We only have to update this line.
10326             (save-excursion
10327               (save-restriction
10328                 (message-narrow-to-head)
10329                 (let ((head (buffer-substring-no-properties
10330                              (point-min) (point-max)))
10331                       header)
10332                   (with-temp-buffer
10333                     (insert (format "211 %d Article retrieved.\n" article))
10334                     (insert head)
10335                     (insert ".\n")
10336                     (let ((nntp-server-buffer (current-buffer)))
10337                       (setq header (car (gnus-get-newsgroup-headers nil t))))
10338                     (with-current-buffer gnus-summary-buffer
10339                       (gnus-data-set-header (gnus-data-find article) header)
10340                       (gnus-summary-update-article-line article header)
10341                       (if (gnus-summary-goto-subject article nil t)
10342                           (gnus-summary-update-secondary-mark article)))))))
10343           ;; Update threads.
10344           (set-buffer (or buffer gnus-summary-buffer))
10345           (gnus-summary-update-article article)
10346           (if (gnus-summary-goto-subject article nil t)
10347               (gnus-summary-update-secondary-mark article)))
10348         ;; Prettify the article buffer again.
10349         (unless no-highlight
10350           (with-current-buffer gnus-article-buffer
10351             ;;!!! Fix this -- article should be rehighlighted.
10352             ;;(gnus-run-hooks 'gnus-article-display-hook)
10353             (set-buffer gnus-original-article-buffer)
10354             (gnus-request-article
10355              article (car gnus-article-current) (current-buffer))))
10356         ;; Prettify the summary buffer line.
10357         (when (gnus-visual-p 'summary-highlight 'highlight)
10358           (gnus-run-hooks 'gnus-visual-mark-article-hook))))))
10359
10360 (defun gnus-summary-edit-wash (key)
10361   "Perform editing command KEY in the article buffer."
10362   (interactive
10363    (list
10364     (progn
10365       (message "%s" (concat (this-command-keys) "- "))
10366       (read-char))))
10367   (message "")
10368   (gnus-summary-edit-article)
10369   (execute-kbd-macro (concat (this-command-keys) key))
10370   (gnus-article-edit-done))
10371
10372 ;;; Respooling
10373
10374 (defun gnus-summary-respool-query (&optional silent trace)
10375   "Query where the respool algorithm would put this article."
10376   (interactive)
10377   (let (gnus-mark-article-hook)
10378     (gnus-summary-select-article)
10379     (with-current-buffer gnus-original-article-buffer
10380       (let ((groups (nnmail-article-group 'identity trace)))
10381         (unless silent
10382           (if groups
10383               (message "This message would go to %s"
10384                        (mapconcat 'car groups ", "))
10385             (message "This message would go to no groups"))
10386           groups)))))
10387
10388 (defun gnus-summary-respool-trace ()
10389   "Trace where the respool algorithm would put this article.
10390 Display a buffer showing all fancy splitting patterns which matched."
10391   (interactive)
10392   (gnus-summary-respool-query nil t))
10393
10394 ;; Summary marking commands.
10395
10396 (defun gnus-summary-kill-same-subject-and-select (&optional unmark)
10397   "Mark articles which has the same subject as read, and then select the next.
10398 If UNMARK is positive, remove any kind of mark.
10399 If UNMARK is negative, tick articles."
10400   (interactive "P")
10401   (when unmark
10402     (setq unmark (prefix-numeric-value unmark)))
10403   (let ((count
10404          (gnus-summary-mark-same-subject
10405           (gnus-summary-article-subject) unmark)))
10406     ;; Select next unread article.  If auto-select-same mode, should
10407     ;; select the first unread article.
10408     (gnus-summary-next-article t (and gnus-auto-select-same
10409                                       (gnus-summary-article-subject)))
10410     (gnus-message 7 "%d article%s marked as %s"
10411                   count (if (= count 1) " is" "s are")
10412                   (if unmark "unread" "read"))))
10413
10414 (defun gnus-summary-kill-same-subject (&optional unmark)
10415   "Mark articles which has the same subject as read.
10416 If UNMARK is positive, remove any kind of mark.
10417 If UNMARK is negative, tick articles."
10418   (interactive "P")
10419   (when unmark
10420     (setq unmark (prefix-numeric-value unmark)))
10421   (let ((count
10422          (gnus-summary-mark-same-subject
10423           (gnus-summary-article-subject) unmark)))
10424     ;; If marked as read, go to next unread subject.
10425     (when (null unmark)
10426       ;; Go to next unread subject.
10427       (gnus-summary-next-subject 1 t))
10428     (gnus-message 7 "%d articles are marked as %s"
10429                   count (if unmark "unread" "read"))))
10430
10431 (defun gnus-summary-mark-same-subject (subject &optional unmark)
10432   "Mark articles with same SUBJECT as read, and return marked number.
10433 If optional argument UNMARK is positive, remove any kinds of marks.
10434 If optional argument UNMARK is negative, mark articles as unread instead."
10435   (let ((count 1))
10436     (save-excursion
10437       (cond
10438        ((null unmark)                   ; Mark as read.
10439         (while (and
10440                 (progn
10441                   (gnus-summary-mark-article-as-read gnus-killed-mark)
10442                   (gnus-summary-show-thread) t)
10443                 (gnus-summary-find-subject subject))
10444           (setq count (1+ count))))
10445        ((> unmark 0)                    ; Tick.
10446         (while (and
10447                 (progn
10448                   (gnus-summary-mark-article-as-unread gnus-ticked-mark)
10449                   (gnus-summary-show-thread) t)
10450                 (gnus-summary-find-subject subject))
10451           (setq count (1+ count))))
10452        (t                               ; Mark as unread.
10453         (while (and
10454                 (progn
10455                   (gnus-summary-mark-article-as-unread gnus-unread-mark)
10456                   (gnus-summary-show-thread) t)
10457                 (gnus-summary-find-subject subject))
10458           (setq count (1+ count)))))
10459       (gnus-set-mode-line 'summary)
10460       ;; Return the number of marked articles.
10461       count)))
10462
10463 (defun gnus-summary-mark-as-processable (n &optional unmark)
10464   "Set the process mark on the next N articles.
10465 If N is negative, mark backward instead.  If UNMARK is non-nil, remove
10466 the process mark instead.  The difference between N and the actual
10467 number of articles marked is returned."
10468   (interactive "P")
10469   (if (and (null n) (gnus-region-active-p))
10470       (gnus-uu-mark-region (region-beginning) (region-end) unmark)
10471     (setq n (prefix-numeric-value n))
10472     (let ((backward (< n 0))
10473           (n (abs n)))
10474       (while (and
10475               (> n 0)
10476               (if unmark
10477                   (gnus-summary-remove-process-mark
10478                    (gnus-summary-article-number))
10479                 (gnus-summary-set-process-mark (gnus-summary-article-number)))
10480               (zerop (gnus-summary-next-subject (if backward -1 1) nil t)))
10481         (setq n (1- n)))
10482       (when (/= 0 n)
10483         (gnus-message 7 "No more articles"))
10484       (gnus-summary-recenter)
10485       (gnus-summary-position-point)
10486       n)))
10487
10488 (defun gnus-summary-unmark-as-processable (n)
10489   "Remove the process mark from the next N articles.
10490 If N is negative, unmark backward instead.  The difference between N and
10491 the actual number of articles unmarked is returned."
10492   (interactive "P")
10493   (gnus-summary-mark-as-processable n t))
10494
10495 (defun gnus-summary-unmark-all-processable ()
10496   "Remove the process mark from all articles."
10497   (interactive)
10498   (save-excursion
10499     (while gnus-newsgroup-processable
10500       (gnus-summary-remove-process-mark (car gnus-newsgroup-processable))))
10501   (gnus-summary-position-point))
10502
10503 (defun gnus-summary-add-mark (article type)
10504   "Mark ARTICLE with a mark of TYPE."
10505   (let ((vtype (car (assq type gnus-article-mark-lists)))
10506         var)
10507     (if (not vtype)
10508         (error "No such mark type: %s" type)
10509       (setq var (intern (format "gnus-newsgroup-%s" type)))
10510       (set var (cons article (symbol-value var)))
10511       (if (memq type '(processable cached replied forwarded recent saved))
10512           (gnus-summary-update-secondary-mark article)
10513         ;;; !!! This is bogus.  We should find out what primary
10514         ;;; !!! mark we want to set.
10515         (gnus-summary-update-mark gnus-del-mark 'unread)))))
10516
10517 (defun gnus-summary-mark-as-expirable (n)
10518   "Mark N articles forward as expirable.
10519 If N is negative, mark backward instead.  The difference between N and
10520 the actual number of articles marked is returned."
10521   (interactive "p")
10522   (gnus-summary-mark-forward n gnus-expirable-mark))
10523
10524 (defun gnus-summary-mark-as-spam (n)
10525   "Mark N articles forward as spam.
10526 If N is negative, mark backward instead.  The difference between N and
10527 the actual number of articles marked is returned."
10528   (interactive "p")
10529   (gnus-summary-mark-forward n gnus-spam-mark))
10530
10531 (defun gnus-summary-mark-article-as-replied (article)
10532   "Mark ARTICLE as replied to and update the summary line.
10533 ARTICLE can also be a list of articles."
10534   (interactive (list (gnus-summary-article-number)))
10535   (let ((articles (if (listp article) article (list article))))
10536     (dolist (article articles)
10537       (unless (numberp article)
10538         (error "%s is not a number" article))
10539       (push article gnus-newsgroup-replied)
10540       (let ((inhibit-read-only t))
10541         (when (gnus-summary-goto-subject article nil t)
10542           (gnus-summary-update-secondary-mark article))))))
10543
10544 (defun gnus-summary-mark-article-as-forwarded (article)
10545   "Mark ARTICLE as forwarded and update the summary line.
10546 ARTICLE can also be a list of articles."
10547   (let ((articles (if (listp article) article (list article))))
10548     (dolist (article articles)
10549       (push article gnus-newsgroup-forwarded)
10550       (let ((inhibit-read-only t))
10551         (when (gnus-summary-goto-subject article nil t)
10552           (gnus-summary-update-secondary-mark article))))))
10553
10554 (defun gnus-summary-set-bookmark (article)
10555   "Set a bookmark in current article."
10556   (interactive (list (gnus-summary-article-number)))
10557   (when (or (not (get-buffer gnus-article-buffer))
10558             (not gnus-current-article)
10559             (not gnus-article-current)
10560             (not (equal gnus-newsgroup-name (car gnus-article-current))))
10561     (error "No current article selected"))
10562   ;; Remove old bookmark, if one exists.
10563   (gnus-alist-pull article gnus-newsgroup-bookmarks)
10564   ;; Set the new bookmark, which is on the form
10565   ;; (article-number . line-number-in-body).
10566   (push
10567    (cons article
10568          (with-current-buffer gnus-article-buffer
10569            (count-lines
10570             (min (point)
10571                  (save-excursion
10572                    (article-goto-body)
10573                    (point)))
10574             (point))))
10575    gnus-newsgroup-bookmarks)
10576   (gnus-message 6 "A bookmark has been added to the current article."))
10577
10578 (defun gnus-summary-remove-bookmark (article)
10579   "Remove the bookmark from the current article."
10580   (interactive (list (gnus-summary-article-number)))
10581   ;; Remove old bookmark, if one exists.
10582   (if (not (assq article gnus-newsgroup-bookmarks))
10583       (gnus-message 6 "No bookmark in current article.")
10584     (gnus-alist-pull article gnus-newsgroup-bookmarks)
10585     (gnus-message 6 "Removed bookmark.")))
10586
10587 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
10588 (defun gnus-summary-mark-as-dormant (n)
10589   "Mark N articles forward as dormant.
10590 If N is negative, mark backward instead.  The difference between N and
10591 the actual number of articles marked is returned."
10592   (interactive "p")
10593   (gnus-summary-mark-forward n gnus-dormant-mark))
10594
10595 (defun gnus-summary-set-process-mark (article)
10596   "Set the process mark on ARTICLE and update the summary line."
10597   (setq gnus-newsgroup-processable
10598         (cons article
10599               (delq article gnus-newsgroup-processable)))
10600   (when (gnus-summary-goto-subject article)
10601     (gnus-summary-show-thread)
10602     (gnus-summary-goto-subject article)
10603     (gnus-summary-update-secondary-mark article)))
10604
10605 (defun gnus-summary-remove-process-mark (&rest articles)
10606   "Remove the process mark from ARTICLES and update the summary line."
10607   (dolist (article articles)
10608     (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable))
10609     (when (gnus-summary-goto-subject article)
10610       (gnus-summary-show-thread)
10611       (gnus-summary-goto-subject article)
10612       (gnus-summary-update-secondary-mark article)))
10613   t)
10614
10615 (defun gnus-summary-set-saved-mark (article)
10616   "Set the process mark on ARTICLE and update the summary line."
10617   (push article gnus-newsgroup-saved)
10618   (when (gnus-summary-goto-subject article)
10619     (gnus-summary-update-secondary-mark article)))
10620
10621 (defun gnus-summary-mark-forward (n &optional mark no-expire)
10622   "Mark N articles as read forwards.
10623 If N is negative, mark backwards instead.  Mark with MARK, ?r by default.
10624 The difference between N and the actual number of articles marked is
10625 returned.
10626 If NO-EXPIRE, auto-expiry will be inhibited."
10627   (interactive "p")
10628   (gnus-summary-show-thread)
10629   (let ((backward (< n 0))
10630         (gnus-summary-goto-unread
10631          (and gnus-summary-goto-unread
10632               (not (eq gnus-summary-goto-unread 'never))
10633               (not (memq mark (list gnus-unread-mark gnus-spam-mark
10634                                     gnus-ticked-mark gnus-dormant-mark)))))
10635         (n (abs n))
10636         (mark (or mark gnus-del-mark)))
10637     (while (and (> n 0)
10638                 (gnus-summary-mark-article nil mark no-expire)
10639                 (zerop (gnus-summary-next-subject
10640                         (if backward -1 1)
10641                         (and gnus-summary-goto-unread
10642                              (not (eq gnus-summary-goto-unread 'never)))
10643                         t)))
10644       (setq n (1- n)))
10645     (when (/= 0 n)
10646       (gnus-message 7 "No more %sarticles" (if mark "" "unread ")))
10647     (gnus-summary-recenter)
10648     (gnus-summary-position-point)
10649     (gnus-set-mode-line 'summary)
10650     n))
10651
10652 (defun gnus-summary-mark-article-as-read (mark)
10653   "Mark the current article quickly as read with MARK."
10654   (let ((article (gnus-summary-article-number)))
10655     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
10656     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
10657     (setq gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked))
10658     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
10659     (push (cons article mark) gnus-newsgroup-reads)
10660     ;; Possibly remove from cache, if that is used.
10661     (when gnus-use-cache
10662       (gnus-cache-enter-remove-article article))
10663     ;; Allow the backend to change the mark.
10664     (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
10665     ;; Check for auto-expiry.
10666     (when (and gnus-newsgroup-auto-expire
10667                (memq mark gnus-auto-expirable-marks))
10668       (setq mark gnus-expirable-mark)
10669       ;; Let the backend know about the mark change.
10670       (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
10671       (push article gnus-newsgroup-expirable))
10672     ;; Set the mark in the buffer.
10673     (gnus-summary-update-mark mark 'unread)
10674     t))
10675
10676 (defun gnus-summary-mark-article-as-unread (mark)
10677   "Mark the current article quickly as unread with MARK."
10678   (let* ((article (gnus-summary-article-number))
10679          (old-mark (gnus-summary-article-mark article)))
10680     ;; Allow the backend to change the mark.
10681     (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
10682     (if (eq mark old-mark)
10683         t
10684       (if (<= article 0)
10685           (progn
10686             (gnus-error 1 "Can't mark negative article numbers")
10687             nil)
10688         (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
10689         (setq gnus-newsgroup-spam-marked
10690               (delq article gnus-newsgroup-spam-marked))
10691         (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
10692         (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
10693         (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads))
10694         (cond ((= mark gnus-ticked-mark)
10695                (setq gnus-newsgroup-marked
10696                      (gnus-add-to-sorted-list gnus-newsgroup-marked
10697                                               article)))
10698               ((= mark gnus-spam-mark)
10699                (setq gnus-newsgroup-spam-marked
10700                      (gnus-add-to-sorted-list gnus-newsgroup-spam-marked
10701                                               article)))
10702               ((= mark gnus-dormant-mark)
10703                (setq gnus-newsgroup-dormant
10704                      (gnus-add-to-sorted-list gnus-newsgroup-dormant
10705                                               article)))
10706               (t
10707                (setq gnus-newsgroup-unreads
10708                      (gnus-add-to-sorted-list gnus-newsgroup-unreads
10709                                               article))))
10710         (gnus-alist-pull article gnus-newsgroup-reads)
10711
10712         ;; See whether the article is to be put in the cache.
10713         (and gnus-use-cache
10714              (vectorp (gnus-summary-article-header article))
10715              (save-excursion
10716                (gnus-cache-possibly-enter-article
10717                 gnus-newsgroup-name article
10718                 (= mark gnus-ticked-mark)
10719                 (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
10720
10721         ;; Fix the mark.
10722         (gnus-summary-update-mark mark 'unread)
10723         t))))
10724
10725 (defun gnus-summary-mark-article (&optional article mark no-expire)
10726   "Mark ARTICLE with MARK.  MARK can be any character.
10727 Four MARK strings are reserved: `? ' (unread), `?!' (ticked),
10728 `??' (dormant) and `?E' (expirable).
10729 If MARK is nil, then the default character `?r' is used.
10730 If ARTICLE is nil, then the article on the current line will be
10731 marked.
10732 If NO-EXPIRE, auto-expiry will be inhibited."
10733   ;; The mark might be a string.
10734   (when (stringp mark)
10735     (setq mark (aref mark 0)))
10736   ;; If no mark is given, then we check auto-expiring.
10737   (when (null mark)
10738     (setq mark gnus-del-mark))
10739   (when (and (not no-expire)
10740              gnus-newsgroup-auto-expire
10741              (memq mark gnus-auto-expirable-marks))
10742     (setq mark gnus-expirable-mark))
10743   (let ((article (or article (gnus-summary-article-number)))
10744         (old-mark (gnus-summary-article-mark article)))
10745     ;; Allow the backend to change the mark.
10746     (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
10747     (if (eq mark old-mark)
10748         t
10749       (unless article
10750         (error "No article on current line"))
10751       (if (not (if (or (= mark gnus-unread-mark)
10752                        (= mark gnus-ticked-mark)
10753                        (= mark gnus-spam-mark)
10754                        (= mark gnus-dormant-mark))
10755                    (gnus-mark-article-as-unread article mark)
10756                  (gnus-mark-article-as-read article mark)))
10757           t
10758         ;; See whether the article is to be put in the cache.
10759         (and gnus-use-cache
10760              (not (= mark gnus-canceled-mark))
10761              (vectorp (gnus-summary-article-header article))
10762              (save-excursion
10763                (gnus-cache-possibly-enter-article
10764                 gnus-newsgroup-name article
10765                 (= mark gnus-ticked-mark)
10766                 (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
10767
10768         (when (gnus-summary-goto-subject article nil t)
10769           (let ((inhibit-read-only t))
10770             (gnus-summary-show-thread)
10771             ;; Fix the mark.
10772             (gnus-summary-update-mark mark 'unread)
10773             t))))))
10774
10775 (defun gnus-summary-update-secondary-mark (article)
10776   "Update the secondary (read, process, cache) mark."
10777   (gnus-summary-update-mark
10778    (cond ((memq article gnus-newsgroup-processable)
10779           gnus-process-mark)
10780          ((memq article gnus-newsgroup-cached)
10781           gnus-cached-mark)
10782          ((memq article gnus-newsgroup-replied)
10783           gnus-replied-mark)
10784          ((memq article gnus-newsgroup-forwarded)
10785           gnus-forwarded-mark)
10786          ((memq article gnus-newsgroup-saved)
10787           gnus-saved-mark)
10788          ((memq article gnus-newsgroup-recent)
10789           gnus-recent-mark)
10790          ((memq article gnus-newsgroup-unseen)
10791           gnus-unseen-mark)
10792          (t gnus-no-mark))
10793    'replied)
10794   (when (gnus-visual-p 'summary-highlight 'highlight)
10795     (gnus-summary-highlight-line)
10796     (gnus-run-hooks 'gnus-summary-update-hook))
10797   t)
10798
10799 (defun gnus-summary-update-download-mark (article)
10800   "Update the download mark."
10801   (gnus-summary-update-mark
10802    (cond ((memq article gnus-newsgroup-undownloaded)
10803           gnus-undownloaded-mark)
10804          (gnus-newsgroup-agentized
10805           gnus-downloaded-mark)
10806          (t
10807           gnus-no-mark))
10808    'download)
10809   (gnus-summary-update-line t)
10810   t)
10811
10812 (defun gnus-summary-update-mark (mark type)
10813   (let ((forward (cdr (assq type gnus-summary-mark-positions)))
10814         (inhibit-read-only t))
10815     (re-search-backward "[\n\r]" (point-at-bol) 'move-to-limit)
10816     (when forward
10817       (when (looking-at "\r")
10818         (incf forward))
10819       (when (<= (+ forward (point)) (point-max))
10820         ;; Go to the right position on the line.
10821         (goto-char (+ forward (point)))
10822         ;; Replace the old mark with the new mark.
10823         (let ((to-insert
10824                (mm-subst-char-in-string
10825                 (char-after) mark
10826                 (buffer-substring (point) (1+ (point))))))
10827           (delete-region (point) (1+ (point)))
10828           (insert to-insert))
10829         ;; Optionally update the marks by some user rule.
10830         (when (eq type 'unread)
10831           (gnus-data-set-mark
10832            (gnus-data-find (gnus-summary-article-number)) mark)
10833           (gnus-summary-update-line (eq mark gnus-unread-mark)))))))
10834
10835 (defun gnus-mark-article-as-read (article &optional mark)
10836   "Enter ARTICLE in the pertinent lists and remove it from others."
10837   ;; Make the article expirable.
10838   (let ((mark (or mark gnus-del-mark)))
10839     (setq gnus-newsgroup-expirable
10840           (if (= mark gnus-expirable-mark)
10841               (gnus-add-to-sorted-list gnus-newsgroup-expirable article)
10842             (delq article gnus-newsgroup-expirable)))
10843     ;; Remove from unread and marked lists.
10844     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
10845     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
10846     (setq gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked))
10847     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
10848     (push (cons article mark) gnus-newsgroup-reads)
10849     ;; Possibly remove from cache, if that is used.
10850     (when gnus-use-cache
10851       (gnus-cache-enter-remove-article article))
10852     t))
10853
10854 (defun gnus-mark-article-as-unread (article &optional mark)
10855   "Enter ARTICLE in the pertinent lists and remove it from others."
10856   (let ((mark (or mark gnus-ticked-mark)))
10857     (if (<= article 0)
10858         (progn
10859           (gnus-error 1 "Can't mark negative article numbers")
10860           nil)
10861       (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)
10862             gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked)
10863             gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)
10864             gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)
10865             gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
10866
10867       ;; Unsuppress duplicates?
10868       (when gnus-suppress-duplicates
10869         (gnus-dup-unsuppress-article article))
10870
10871       (cond ((= mark gnus-ticked-mark)
10872              (setq gnus-newsgroup-marked
10873                    (gnus-add-to-sorted-list gnus-newsgroup-marked article)))
10874             ((= mark gnus-spam-mark)
10875              (setq gnus-newsgroup-spam-marked
10876                    (gnus-add-to-sorted-list gnus-newsgroup-spam-marked
10877                                             article)))
10878             ((= mark gnus-dormant-mark)
10879              (setq gnus-newsgroup-dormant
10880                    (gnus-add-to-sorted-list gnus-newsgroup-dormant article)))
10881             (t
10882              (setq gnus-newsgroup-unreads
10883                    (gnus-add-to-sorted-list gnus-newsgroup-unreads article))))
10884       (gnus-alist-pull article gnus-newsgroup-reads)
10885       t)))
10886
10887 (defun gnus-summary-tick-article-forward (n)
10888   "Tick N articles forwards.
10889 If N is negative, tick backwards instead.
10890 The difference between N and the number of articles ticked is returned."
10891   (interactive "p")
10892   (gnus-summary-mark-forward n gnus-ticked-mark))
10893
10894 (defun gnus-summary-tick-article-backward (n)
10895   "Tick N articles backwards.
10896 The difference between N and the number of articles ticked is returned."
10897   (interactive "p")
10898   (gnus-summary-mark-forward (- n) gnus-ticked-mark))
10899
10900 (defun gnus-summary-tick-article (&optional article clear-mark)
10901   "Mark current article as unread.
10902 Optional 1st argument ARTICLE specifies article number to be marked as unread.
10903 Optional 2nd argument CLEAR-MARK remove any kinds of mark."
10904   (interactive)
10905   (gnus-summary-mark-article article (if clear-mark gnus-unread-mark
10906                                        gnus-ticked-mark)))
10907
10908 (defun gnus-summary-mark-as-read-forward (n)
10909   "Mark N articles as read forwards.
10910 If N is negative, mark backwards instead.
10911 The difference between N and the actual number of articles marked is
10912 returned."
10913   (interactive "p")
10914   (gnus-summary-mark-forward n gnus-del-mark gnus-inhibit-user-auto-expire))
10915
10916 (defun gnus-summary-mark-as-read-backward (n)
10917   "Mark the N articles as read backwards.
10918 The difference between N and the actual number of articles marked is
10919 returned."
10920   (interactive "p")
10921   (gnus-summary-mark-forward
10922    (- n) gnus-del-mark gnus-inhibit-user-auto-expire))
10923
10924 (defun gnus-summary-mark-as-read (&optional article mark)
10925   "Mark current article as read.
10926 ARTICLE specifies the article to be marked as read.
10927 MARK specifies a string to be inserted at the beginning of the line."
10928   (gnus-summary-mark-article article mark))
10929
10930 (defun gnus-summary-clear-mark-forward (n)
10931   "Clear marks from N articles forward.
10932 If N is negative, clear backward instead.
10933 The difference between N and the number of marks cleared is returned."
10934   (interactive "p")
10935   (gnus-summary-mark-forward n gnus-unread-mark))
10936
10937 (defun gnus-summary-clear-mark-backward (n)
10938   "Clear marks from N articles backward.
10939 The difference between N and the number of marks cleared is returned."
10940   (interactive "p")
10941   (gnus-summary-mark-forward (- n) gnus-unread-mark))
10942
10943 (defun gnus-summary-mark-unread-as-read ()
10944   "Intended to be used by `gnus-mark-article-hook'."
10945   (when (memq gnus-current-article gnus-newsgroup-unreads)
10946     (gnus-summary-mark-article gnus-current-article gnus-read-mark)))
10947
10948 (defun gnus-summary-mark-read-and-unread-as-read (&optional new-mark)
10949   "Intended to be used by `gnus-mark-article-hook'."
10950   (let ((mark (gnus-summary-article-mark)))
10951     (when (or (gnus-unread-mark-p mark)
10952               (gnus-read-mark-p mark))
10953       (gnus-summary-mark-article gnus-current-article
10954                                  (or new-mark gnus-read-mark)))))
10955
10956 (defun gnus-summary-mark-current-read-and-unread-as-read (&optional new-mark)
10957   "Intended to be used by `gnus-mark-article-hook'."
10958   (let ((mark (gnus-summary-article-mark)))
10959     (when (or (gnus-unread-mark-p mark)
10960               (gnus-read-mark-p mark))
10961       (gnus-summary-mark-article (gnus-summary-article-number)
10962                                  (or new-mark gnus-read-mark)))))
10963
10964 (defun gnus-summary-mark-unread-as-ticked ()
10965   "Intended to be used by `gnus-mark-article-hook'."
10966   (when (memq gnus-current-article gnus-newsgroup-unreads)
10967     (gnus-summary-mark-article gnus-current-article gnus-ticked-mark)))
10968
10969 (defun gnus-summary-mark-region-as-read (point mark all)
10970   "Mark all unread articles between point and mark as read.
10971 If given a prefix, mark all articles between point and mark as read,
10972 even ticked and dormant ones."
10973   (interactive "r\nP")
10974   (save-excursion
10975     (let (article)
10976       (goto-char point)
10977       (beginning-of-line)
10978       (while (and
10979               (< (point) mark)
10980               (progn
10981                 (when (or all
10982                           (memq (setq article (gnus-summary-article-number))
10983                                 gnus-newsgroup-unreads))
10984                   (gnus-summary-mark-article article gnus-del-mark))
10985                 t)
10986               (gnus-summary-find-next))))))
10987
10988 (defun gnus-summary-mark-below (score mark)
10989   "Mark articles with score less than SCORE with MARK."
10990   (interactive "P\ncMark: ")
10991   (setq score (if score
10992                   (prefix-numeric-value score)
10993                 (or gnus-summary-default-score 0)))
10994   (with-current-buffer gnus-summary-buffer
10995     (goto-char (point-min))
10996     (while
10997         (progn
10998           (and (< (gnus-summary-article-score) score)
10999                (gnus-summary-mark-article nil mark))
11000           (gnus-summary-find-next)))))
11001
11002 (defun gnus-summary-kill-below (&optional score)
11003   "Mark articles with score below SCORE as read."
11004   (interactive "P")
11005   (gnus-summary-mark-below score gnus-killed-mark))
11006
11007 (defun gnus-summary-clear-above (&optional score)
11008   "Clear all marks from articles with score above SCORE."
11009   (interactive "P")
11010   (gnus-summary-mark-above score gnus-unread-mark))
11011
11012 (defun gnus-summary-tick-above (&optional score)
11013   "Tick all articles with score above SCORE."
11014   (interactive "P")
11015   (gnus-summary-mark-above score gnus-ticked-mark))
11016
11017 (defun gnus-summary-mark-above (score mark)
11018   "Mark articles with score over SCORE with MARK."
11019   (interactive "P\ncMark: ")
11020   (setq score (if score
11021                   (prefix-numeric-value score)
11022                 (or gnus-summary-default-score 0)))
11023   (with-current-buffer gnus-summary-buffer
11024     (goto-char (point-min))
11025     (while (and (progn
11026                   (when (> (gnus-summary-article-score) score)
11027                     (gnus-summary-mark-article nil mark))
11028                   t)
11029                 (gnus-summary-find-next)))))
11030
11031 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
11032 (defalias 'gnus-summary-show-all-expunged 'gnus-summary-limit-include-expunged)
11033 (defun gnus-summary-limit-include-expunged (&optional no-error)
11034   "Display all the hidden articles that were expunged for low scores."
11035   (interactive)
11036   (let ((inhibit-read-only t))
11037     (let ((scored gnus-newsgroup-scored)
11038           headers h)
11039       (while scored
11040         (unless (gnus-summary-article-header (caar scored))
11041           (and (setq h (gnus-number-to-header (caar scored)))
11042                (< (cdar scored) gnus-summary-expunge-below)
11043                (push h headers)))
11044         (setq scored (cdr scored)))
11045       (if (not headers)
11046           (when (not no-error)
11047             (error "No expunged articles hidden"))
11048         (goto-char (point-min))
11049         (push gnus-newsgroup-limit gnus-newsgroup-limits)
11050         (setq gnus-newsgroup-limit (copy-sequence gnus-newsgroup-limit))
11051         (dolist (x headers)
11052           (push (mail-header-number x) gnus-newsgroup-limit))
11053         (gnus-summary-prepare-unthreaded (nreverse headers))
11054         (goto-char (point-min))
11055         (gnus-summary-position-point)
11056         t))))
11057
11058 (defun gnus-summary-catchup (&optional all quietly to-here not-mark reverse)
11059   "Mark all unread articles in this newsgroup as read.
11060 If prefix argument ALL is non-nil, ticked and dormant articles will
11061 also be marked as read.
11062 If QUIETLY is non-nil, no questions will be asked.
11063
11064 If TO-HERE is non-nil, it should be a point in the buffer.  All
11065 articles before (after, if REVERSE is set) this point will be marked
11066 as read.
11067
11068 Note that this function will only catch up the unread article
11069 in the current summary buffer limitation.
11070
11071 The number of articles marked as read is returned."
11072   (interactive "P")
11073   (prog1
11074       (save-excursion
11075         (when (or quietly
11076                   (not gnus-interactive-catchup) ;Without confirmation?
11077                   gnus-expert-user
11078                   (gnus-y-or-n-p
11079                    (if all
11080                        "Mark absolutely all articles as read? "
11081                      "Mark all unread articles as read? ")))
11082           (if (and not-mark
11083                    (not gnus-newsgroup-adaptive)
11084                    (not gnus-newsgroup-auto-expire)
11085                    (not gnus-suppress-duplicates)
11086                    (or (not gnus-use-cache)
11087                        (eq gnus-use-cache 'passive)))
11088               (progn
11089                 (when all
11090                   (setq gnus-newsgroup-marked nil
11091                         gnus-newsgroup-spam-marked nil
11092                         gnus-newsgroup-dormant nil))
11093                 (setq gnus-newsgroup-unreads
11094                       (gnus-sorted-nunion
11095                        (gnus-sorted-intersection gnus-newsgroup-unreads
11096                                                  gnus-newsgroup-downloadable)
11097                        (gnus-sorted-difference gnus-newsgroup-unfetched
11098                                                gnus-newsgroup-cached))))
11099             ;; We actually mark all articles as canceled, which we
11100             ;; have to do when using auto-expiry or adaptive scoring.
11101             (gnus-summary-show-all-threads)
11102             (if (and to-here reverse)
11103                 (progn
11104                   (goto-char to-here)
11105                   (gnus-summary-mark-current-read-and-unread-as-read
11106                    gnus-catchup-mark)
11107                   (while (gnus-summary-find-next (not all))
11108                     (gnus-summary-mark-article-as-read gnus-catchup-mark)))
11109               (when (gnus-summary-first-subject (not all))
11110                 (while (and
11111                         (if to-here (< (point) to-here) t)
11112                         (gnus-summary-mark-article-as-read gnus-catchup-mark)
11113                         (gnus-summary-find-next (not all))))))
11114             (gnus-set-mode-line 'summary))
11115           t))
11116     (gnus-summary-position-point)))
11117
11118 (defun gnus-summary-catchup-to-here (&optional all)
11119   "Mark all unticked articles before the current one as read.
11120 If ALL is non-nil, also mark ticked and dormant articles as read."
11121   (interactive "P")
11122   (save-excursion
11123     (gnus-save-hidden-threads
11124       (let ((beg (point)))
11125         ;; We check that there are unread articles.
11126         (when (or all (gnus-summary-find-prev))
11127           (gnus-summary-catchup all t beg)))))
11128   (gnus-summary-position-point))
11129
11130 (defun gnus-summary-catchup-from-here (&optional all)
11131   "Mark all unticked articles after (and including) the current one as read.
11132 If ALL is non-nil, also mark ticked and dormant articles as read."
11133   (interactive "P")
11134   (save-excursion
11135     (gnus-save-hidden-threads
11136       (let ((beg (point)))
11137         ;; We check that there are unread articles.
11138         (when (or all (gnus-summary-find-next))
11139           (gnus-summary-catchup all t beg nil t)))))
11140   (gnus-summary-position-point))
11141
11142 (defun gnus-summary-catchup-all (&optional quietly)
11143   "Mark all articles in this newsgroup as read.
11144 This command is dangerous.  Normally, you want \\[gnus-summary-catchup]
11145 instead, which marks only unread articles as read."
11146   (interactive "P")
11147   (gnus-summary-catchup t quietly))
11148
11149 (defun gnus-summary-catchup-and-exit (&optional all quietly)
11150   "Mark all unread articles in this group as read, then exit.
11151 If prefix argument ALL is non-nil, all articles are marked as read.
11152 If QUIETLY is non-nil, no questions will be asked."
11153   (interactive "P")
11154   (when (gnus-summary-catchup all quietly nil 'fast)
11155     ;; Select next newsgroup or exit.
11156     (if (and (not (gnus-group-quit-config gnus-newsgroup-name))
11157              (eq gnus-auto-select-next 'quietly))
11158         (gnus-summary-next-group nil)
11159       (gnus-summary-exit))))
11160
11161 (defun gnus-summary-catchup-all-and-exit (&optional quietly)
11162   "Mark all articles in this newsgroup as read, and then exit.
11163 This command is dangerous.  Normally, you want \\[gnus-summary-catchup-and-exit]
11164 instead, which marks only unread articles as read."
11165   (interactive "P")
11166   (gnus-summary-catchup-and-exit t quietly))
11167
11168 (defun gnus-summary-catchup-and-goto-next-group (&optional all)
11169   "Mark all articles in this group as read and select the next group.
11170 If given a prefix, mark all articles, unread as well as ticked, as
11171 read."
11172   (interactive "P")
11173   (save-excursion
11174     (gnus-summary-catchup all))
11175   (gnus-summary-next-group))
11176
11177 (defun gnus-summary-catchup-and-goto-prev-group (&optional all)
11178   "Mark all articles in this group as read and select the previous group.
11179 If given a prefix, mark all articles, unread as well as ticked, as
11180 read."
11181   (interactive "P")
11182   (save-excursion
11183     (gnus-summary-catchup all))
11184   (gnus-summary-next-group nil nil t))
11185
11186 ;;;
11187 ;;; with article
11188 ;;;
11189
11190 (defmacro gnus-with-article (article &rest forms)
11191   "Select ARTICLE and perform FORMS in the original article buffer.
11192 Then replace the article with the result."
11193   `(progn
11194      ;; We don't want the article to be marked as read.
11195      (let (gnus-mark-article-hook)
11196        (gnus-summary-select-article t t nil ,article))
11197      (set-buffer gnus-original-article-buffer)
11198      ,@forms
11199      (if (not (gnus-check-backend-function
11200                'request-replace-article (car gnus-article-current)))
11201          (gnus-message 5 "Read-only group; not replacing")
11202        (unless (gnus-request-replace-article
11203                 ,article (car gnus-article-current)
11204                 (current-buffer) t)
11205          (error "Couldn't replace article")))
11206      ;; The cache and backlog have to be flushed somewhat.
11207      (when gnus-keep-backlog
11208        (gnus-backlog-remove-article
11209         (car gnus-article-current) (cdr gnus-article-current)))
11210      (when gnus-use-cache
11211        (gnus-cache-update-article
11212         (car gnus-article-current) (cdr gnus-article-current)))))
11213
11214 (put 'gnus-with-article 'lisp-indent-function 1)
11215 (put 'gnus-with-article 'edebug-form-spec '(form body))
11216
11217 ;; Thread-based commands.
11218
11219 (defun gnus-summary-articles-in-thread (&optional article)
11220   "Return a list of all articles in the current thread.
11221 If ARTICLE is non-nil, return all articles in the thread that starts
11222 with that article."
11223   (let* ((article (or article (gnus-summary-article-number)))
11224          (data (gnus-data-find-list article))
11225          (top-level (gnus-data-level (car data)))
11226          (top-subject
11227           (cond ((null gnus-thread-operation-ignore-subject)
11228                  (gnus-simplify-subject-re
11229                   (mail-header-subject (gnus-data-header (car data)))))
11230                 ((eq gnus-thread-operation-ignore-subject 'fuzzy)
11231                  (gnus-simplify-subject-fuzzy
11232                   (mail-header-subject (gnus-data-header (car data)))))
11233                 (t nil)))
11234          (end-point (save-excursion
11235                       (if (gnus-summary-go-to-next-thread)
11236                           (point) (point-max))))
11237          articles)
11238     (while (and data
11239                 (< (gnus-data-pos (car data)) end-point))
11240       (when (or (not top-subject)
11241                 (string= top-subject
11242                          (if (eq gnus-thread-operation-ignore-subject 'fuzzy)
11243                              (gnus-simplify-subject-fuzzy
11244                               (mail-header-subject
11245                                (gnus-data-header (car data))))
11246                            (gnus-simplify-subject-re
11247                             (mail-header-subject
11248                              (gnus-data-header (car data)))))))
11249         (push (gnus-data-number (car data)) articles))
11250       (unless (and (setq data (cdr data))
11251                    (> (gnus-data-level (car data)) top-level))
11252         (setq data nil)))
11253     ;; Return the list of articles.
11254     (nreverse articles)))
11255
11256 (defun gnus-summary-rethread-current ()
11257   "Rethread the thread the current article is part of."
11258   (interactive)
11259   (let* ((gnus-show-threads t)
11260          (article (gnus-summary-article-number))
11261          (id (mail-header-id (gnus-summary-article-header)))
11262          (gnus-newsgroup-threads (list (gnus-id-to-thread (gnus-root-id id)))))
11263     (unless id
11264       (error "No article on the current line"))
11265     (gnus-rebuild-thread id)
11266     (gnus-summary-goto-subject article)))
11267
11268 (defun gnus-summary-reparent-thread ()
11269   "Make the current article child of the marked (or previous) article.
11270
11271 Note that the re-threading will only work if `gnus-thread-ignore-subject'
11272 is non-nil or the Subject: of both articles are the same."
11273   (interactive)
11274   (unless (not (gnus-group-read-only-p))
11275     (error "The current newsgroup does not support article editing"))
11276   (unless (<= (length gnus-newsgroup-processable) 1)
11277     (error "No more than one article may be marked"))
11278   (let ((child (gnus-summary-article-number))
11279         ;; First grab the marked article, otherwise one line up.
11280         (parent (if (not (null gnus-newsgroup-processable))
11281                     (car gnus-newsgroup-processable)
11282                   (save-excursion
11283                     (if (eq (forward-line -1) 0)
11284                         (gnus-summary-article-number)
11285                       (error "Beginning of summary buffer"))))))
11286     (gnus-summary-reparent-children parent (list child))))
11287
11288 (defun gnus-summary-reparent-children (parent children)
11289   "Make PARENT the parent of CHILDREN.
11290 When called interactively, PARENT is the current article and CHILDREN
11291 are the process-marked articles."
11292   (interactive
11293    (list (gnus-summary-article-number)
11294          (gnus-summary-work-articles nil)))
11295   (dolist (child children)
11296     (save-window-excursion
11297       (let ((gnus-article-buffer " *reparent*"))
11298         (unless (not (eq parent child))
11299           (error "An article may not be self-referential"))
11300         (let ((message-id (mail-header-id
11301                            (gnus-summary-article-header parent))))
11302           (unless (and message-id (not (equal message-id "")))
11303             (error "No message-id in desired parent"))
11304           (gnus-with-article child
11305             (save-restriction
11306               (goto-char (point-min))
11307               (message-narrow-to-head)
11308               (if (re-search-forward "^References: " nil t)
11309                   (progn
11310                     (re-search-forward "^[^ \t]" nil t)
11311                     (forward-line -1)
11312                     (end-of-line)
11313                     (insert " " message-id))
11314                 (insert "References: " message-id "\n"))))
11315           (set-buffer gnus-summary-buffer)
11316           (gnus-summary-unmark-all-processable)
11317           (gnus-summary-update-article child)
11318           (when (gnus-summary-goto-subject (cdr gnus-article-current) nil t)
11319             (gnus-summary-update-secondary-mark (cdr gnus-article-current)))
11320           (gnus-summary-rethread-current)
11321           (gnus-message 3 "Article %d is now the child of article %d"
11322                         child parent))))))
11323
11324 (defun gnus-summary-toggle-threads (&optional arg)
11325   "Toggle showing conversation threads.
11326 If ARG is positive number, turn showing conversation threads on."
11327   (interactive "P")
11328   (let ((current (or (gnus-summary-article-number) gnus-newsgroup-end)))
11329     (setq gnus-show-threads
11330           (if (null arg) (not gnus-show-threads)
11331             (> (prefix-numeric-value arg) 0)))
11332     (gnus-summary-prepare)
11333     (gnus-summary-goto-subject current)
11334     (gnus-message 6 "Threading is now %s" (if gnus-show-threads "on" "off"))
11335     (gnus-summary-position-point)))
11336
11337 (eval-and-compile
11338   (if (fboundp 'remove-overlays)
11339       (defalias 'gnus-remove-overlays 'remove-overlays)
11340     (defun gnus-remove-overlays (beg end name val)
11341       "Clear BEG and END of overlays whose property NAME has value VAL.
11342 For compatibility with XEmacs."
11343       (dolist (ov (gnus-overlays-in beg end))
11344         (when (eq (gnus-overlay-get ov name) val)
11345           (gnus-delete-overlay ov))))))
11346
11347 (defun gnus-summary-show-all-threads ()
11348   "Show all threads."
11349   (interactive)
11350   (gnus-remove-overlays (point-min) (point-max) 'invisible 'gnus-sum)
11351   (gnus-summary-position-point))
11352
11353 (defsubst gnus-summary--inv (p)
11354   (and (eq (get-char-property p 'invisible) 'gnus-sum) p))
11355
11356 (defun gnus-summary-show-thread ()
11357   "Show thread subtrees.
11358 Returns nil if no thread was there to be shown."
11359   (interactive)
11360   (let* ((orig (point))
11361          (end (point-at-eol))
11362          (end (or (gnus-summary--inv end) (gnus-summary--inv (1- end))))
11363          ;; Leave point at bol
11364          (beg (progn (beginning-of-line) (if (bobp) (point) (1- (point)))))
11365          (eoi (when end
11366                 (if (fboundp 'next-single-char-property-change)
11367                     (or (next-single-char-property-change end 'invisible)
11368                         (point-max))
11369                   (while (progn
11370                            (end-of-line 2)
11371                            (and (not (eobp))
11372                                 (eq (get-char-property (point) 'invisible)
11373                                     'gnus-sum))))
11374                   (point)))))
11375     (when eoi
11376       (gnus-remove-overlays beg eoi 'invisible 'gnus-sum)
11377       (goto-char orig)
11378       (gnus-summary-position-point)
11379       eoi)))
11380
11381 (defun gnus-summary-maybe-hide-threads ()
11382   "If requested, hide the threads that should be hidden."
11383   (when (and gnus-show-threads
11384              gnus-thread-hide-subtree)
11385     (gnus-summary-hide-all-threads
11386      (if (or (consp gnus-thread-hide-subtree)
11387              (functionp gnus-thread-hide-subtree))
11388          (gnus-make-predicate gnus-thread-hide-subtree)
11389        nil))))
11390
11391 ;;; Hiding predicates.
11392
11393 (defun gnus-article-unread-p (header)
11394   (memq (mail-header-number header) gnus-newsgroup-unreads))
11395
11396 (defun gnus-article-unseen-p (header)
11397   (memq (mail-header-number header) gnus-newsgroup-unseen))
11398
11399 (defun gnus-map-articles (predicate articles)
11400   "Map PREDICATE over ARTICLES and return non-nil if any predicate is non-nil."
11401   (apply 'gnus-or (mapcar predicate
11402                           (mapcar (lambda (number)
11403                                     (gnus-summary-article-header number))
11404                                   articles))))
11405
11406 (defun gnus-summary-hide-all-threads (&optional predicate)
11407   "Hide all thread subtrees.
11408 If PREDICATE is supplied, threads that satisfy this predicate
11409 will not be hidden."
11410   (interactive)
11411   (save-excursion
11412     (goto-char (point-min))
11413     (let ((end nil))
11414       (while (not end)
11415         (when (or (not predicate)
11416                   (gnus-map-articles
11417                    predicate (gnus-summary-article-children)))
11418             (gnus-summary-hide-thread))
11419         (setq end (not (zerop (gnus-summary-next-thread 1 t)))))))
11420   (gnus-summary-position-point))
11421
11422 (defun gnus-summary-hide-thread ()
11423   "Hide thread subtrees.
11424 If PREDICATE is supplied, threads that satisfy this predicate
11425 will not be hidden.
11426 Returns nil if no threads were there to be hidden."
11427   (interactive)
11428   (let ((start (point))
11429         (starteol (line-end-position))
11430         (article (gnus-summary-article-number)))
11431     (goto-char start)
11432     ;; Go forward until either the buffer ends or the subthread ends.
11433     (when (and (not (eobp))
11434                (or (zerop (gnus-summary-next-thread 1 t))
11435                    (goto-char (point-max))))
11436       (if (and (> (point) start)
11437                ;; FIXME: this should actually search for a non-invisible \n.
11438                (search-backward "\n" start t))
11439           (progn
11440             (when (> (point) starteol)
11441               (gnus-remove-overlays starteol (point) 'invisible 'gnus-sum)
11442               (let ((ol (gnus-make-overlay starteol (point) nil t nil)))
11443                 (gnus-overlay-put ol 'invisible 'gnus-sum)
11444                 (gnus-overlay-put ol 'evaporate t)))
11445             (gnus-summary-goto-subject article))
11446         (goto-char start)
11447         nil))))
11448
11449 (defun gnus-summary-go-to-next-thread (&optional previous)
11450   "Go to the same level (or less) next thread.
11451 If PREVIOUS is non-nil, go to previous thread instead.
11452 Return the article number moved to, or nil if moving was impossible."
11453   (let ((level (gnus-summary-thread-level))
11454         (way (if previous -1 1))
11455         (beg (point)))
11456     (forward-line way)
11457     (while (and (not (eobp))
11458                 (< level (gnus-summary-thread-level)))
11459       (forward-line way))
11460     (if (eobp)
11461         (progn
11462           (goto-char beg)
11463           nil)
11464       (setq beg (point))
11465       (prog1
11466           (gnus-summary-article-number)
11467         (goto-char beg)))))
11468
11469 (defun gnus-summary-next-thread (n &optional silent)
11470   "Go to the same level next N'th thread.
11471 If N is negative, search backward instead.
11472 Returns the difference between N and the number of skips actually
11473 done.
11474
11475 If SILENT, don't output messages."
11476   (interactive "p")
11477   (let ((backward (< n 0))
11478         (n (abs n)))
11479     (while (and (> n 0)
11480                 (gnus-summary-go-to-next-thread backward))
11481       (decf n))
11482     (unless silent
11483       (gnus-summary-position-point))
11484     (when (and (not silent) (/= 0 n))
11485       (gnus-message 7 "No more threads"))
11486     n))
11487
11488 (defun gnus-summary-prev-thread (n)
11489   "Go to the same level previous N'th thread.
11490 Returns the difference between N and the number of skips actually
11491 done."
11492   (interactive "p")
11493   (gnus-summary-next-thread (- n)))
11494
11495 (defun gnus-summary-go-down-thread ()
11496   "Go down one level in the current thread."
11497   (let ((children (gnus-summary-article-children)))
11498     (when children
11499       (gnus-summary-goto-subject (car children)))))
11500
11501 (defun gnus-summary-go-up-thread ()
11502   "Go up one level in the current thread."
11503   (let ((parent (gnus-summary-article-parent)))
11504     (when parent
11505       (gnus-summary-goto-subject parent))))
11506
11507 (defun gnus-summary-down-thread (n)
11508   "Go down thread N steps.
11509 If N is negative, go up instead.
11510 Returns the difference between N and how many steps down that were
11511 taken."
11512   (interactive "p")
11513   (let ((up (< n 0))
11514         (n (abs n)))
11515     (while (and (> n 0)
11516                 (if up (gnus-summary-go-up-thread)
11517                   (gnus-summary-go-down-thread)))
11518       (setq n (1- n)))
11519     (gnus-summary-position-point)
11520     (when (/= 0 n)
11521       (gnus-message 7 "Can't go further"))
11522     n))
11523
11524 (defun gnus-summary-up-thread (n)
11525   "Go up thread N steps.
11526 If N is negative, go down instead.
11527 Returns the difference between N and how many steps down that were
11528 taken."
11529   (interactive "p")
11530   (gnus-summary-down-thread (- n)))
11531
11532 (defun gnus-summary-top-thread ()
11533   "Go to the top of the thread."
11534   (interactive)
11535   (while (gnus-summary-go-up-thread))
11536   (gnus-summary-article-number))
11537
11538 (defun gnus-summary-expire-thread ()
11539   "Mark articles under current thread as expired."
11540   (interactive)
11541   (gnus-summary-kill-thread 0))
11542
11543 (defun gnus-summary-kill-thread (&optional unmark)
11544   "Mark articles under current thread as read.
11545 If the prefix argument is positive, remove any kinds of marks.
11546 If the prefix argument is zero, mark thread as expired.
11547 If the prefix argument is negative, tick articles instead."
11548   (interactive "P")
11549   (when unmark
11550     (setq unmark (prefix-numeric-value unmark)))
11551   (let ((articles (gnus-summary-articles-in-thread))
11552         (hide (or (null unmark) (= unmark 0))))
11553     (save-excursion
11554       ;; Expand the thread.
11555       (gnus-summary-show-thread)
11556       ;; Mark all the articles.
11557       (while articles
11558         (gnus-summary-goto-subject (car articles))
11559         (cond ((null unmark)
11560                (gnus-summary-mark-article-as-read gnus-killed-mark))
11561               ((> unmark 0)
11562                (gnus-summary-mark-article-as-unread gnus-unread-mark))
11563               ((= unmark 0)
11564                (gnus-summary-mark-article nil gnus-expirable-mark))
11565               (t
11566                (gnus-summary-mark-article-as-unread gnus-ticked-mark)))
11567         (setq articles (cdr articles))))
11568     ;; Hide killed subtrees when hide is true.
11569     (and hide
11570          gnus-thread-hide-killed
11571          (gnus-summary-hide-thread))
11572     ;; If hide is t, go to next unread subject.
11573     (when hide
11574       ;; Go to next unread subject.
11575       (gnus-summary-next-subject 1 t)))
11576   (gnus-set-mode-line 'summary))
11577
11578 ;; Summary sorting commands
11579
11580 (defun gnus-summary-sort-by-number (&optional reverse)
11581   "Sort the summary buffer by article number.
11582 Argument REVERSE means reverse order."
11583   (interactive "P")
11584   (gnus-summary-sort 'number reverse))
11585
11586 (defun gnus-summary-sort-by-most-recent-number (&optional reverse)
11587   "Sort the summary buffer by most recent article number.
11588 Argument REVERSE means reverse order."
11589   (interactive "P")
11590   (gnus-summary-sort 'most-recent-number reverse))
11591
11592 (defun gnus-summary-sort-by-random (&optional reverse)
11593   "Randomize the order in the summary buffer.
11594 Argument REVERSE means to randomize in reverse order."
11595   (interactive "P")
11596   (gnus-summary-sort 'random reverse))
11597
11598 (defun gnus-summary-sort-by-author (&optional reverse)
11599   "Sort the summary buffer by author name alphabetically.
11600 If `case-fold-search' is non-nil, case of letters is ignored.
11601 Argument REVERSE means reverse order."
11602   (interactive "P")
11603   (gnus-summary-sort 'author reverse))
11604
11605 (defun gnus-summary-sort-by-recipient (&optional reverse)
11606   "Sort the summary buffer by recipient name alphabetically.
11607 If `case-fold-search' is non-nil, case of letters is ignored.
11608 Argument REVERSE means reverse order."
11609   (interactive "P")
11610   (gnus-summary-sort 'recipient reverse))
11611
11612 (defun gnus-summary-sort-by-subject (&optional reverse)
11613   "Sort the summary buffer by subject alphabetically.  `Re:'s are ignored.
11614 If `case-fold-search' is non-nil, case of letters is ignored.
11615 Argument REVERSE means reverse order."
11616   (interactive "P")
11617   (gnus-summary-sort 'subject reverse))
11618
11619 (defun gnus-summary-sort-by-date (&optional reverse)
11620   "Sort the summary buffer by date.
11621 Argument REVERSE means reverse order."
11622   (interactive "P")
11623   (gnus-summary-sort 'date reverse))
11624
11625 (defun gnus-summary-sort-by-most-recent-date (&optional reverse)
11626   "Sort the summary buffer by most recent date.
11627 Argument REVERSE means reverse order."
11628   (interactive "P")
11629   (gnus-summary-sort 'most-recent-date reverse))
11630
11631 (defun gnus-summary-sort-by-score (&optional reverse)
11632   "Sort the summary buffer by score.
11633 Argument REVERSE means reverse order."
11634   (interactive "P")
11635   (gnus-summary-sort 'score reverse))
11636
11637 (defun gnus-summary-sort-by-lines (&optional reverse)
11638   "Sort the summary buffer by the number of lines.
11639 Argument REVERSE means reverse order."
11640   (interactive "P")
11641   (gnus-summary-sort 'lines reverse))
11642
11643 (defun gnus-summary-sort-by-chars (&optional reverse)
11644   "Sort the summary buffer by article length.
11645 Argument REVERSE means reverse order."
11646   (interactive "P")
11647   (gnus-summary-sort 'chars reverse))
11648
11649 (defun gnus-summary-sort-by-original (&optional reverse)
11650   "Sort the summary buffer using the default sorting method.
11651 Argument REVERSE means reverse order."
11652   (interactive "P")
11653   (let* ((inhibit-read-only t)
11654          (gnus-summary-prepare-hook nil))
11655     ;; We do the sorting by regenerating the threads.
11656     (gnus-summary-prepare)
11657     ;; Hide subthreads if needed.
11658     (gnus-summary-maybe-hide-threads)))
11659
11660 (defun gnus-summary-sort (predicate reverse)
11661   "Sort summary buffer by PREDICATE.  REVERSE means reverse order."
11662   (let* ((thread (intern (format "gnus-thread-sort-by-%s" predicate)))
11663          (article (intern (format "gnus-article-sort-by-%s" predicate)))
11664          (gnus-thread-sort-functions
11665           (if (not reverse)
11666               thread
11667             `(lambda (t1 t2)
11668                (,thread t2 t1))))
11669          (gnus-sort-gathered-threads-function
11670           gnus-thread-sort-functions)
11671          (gnus-article-sort-functions
11672           (if (not reverse)
11673               article
11674             `(lambda (t1 t2)
11675                (,article t2 t1))))
11676          (inhibit-read-only t)
11677          (gnus-summary-prepare-hook nil))
11678     ;; We do the sorting by regenerating the threads.
11679     (gnus-summary-prepare)
11680     ;; Hide subthreads if needed.
11681     (gnus-summary-maybe-hide-threads)))
11682
11683 ;; Summary saving commands.
11684
11685 (defun gnus-summary-save-article (&optional n not-saved)
11686   "Save the current article using the default saver function.
11687 If N is a positive number, save the N next articles.
11688 If N is a negative number, save the N previous articles.
11689 If N is nil and any articles have been marked with the process mark,
11690 save those articles instead.
11691 The variable `gnus-default-article-saver' specifies the saver function.
11692
11693 If the optional second argument NOT-SAVED is non-nil, articles saved
11694 will not be marked as saved."
11695   (interactive "P")
11696   (require 'gnus-art)
11697   (let* ((articles (gnus-summary-work-articles n))
11698          (save-buffer (save-excursion
11699                         (nnheader-set-temp-buffer " *Gnus Save*")))
11700          (num (length articles))
11701          ;; Whether to save decoded articles or raw articles.
11702          (decode (when gnus-article-save-coding-system
11703                    (get gnus-default-article-saver :decode)))
11704          ;; When saving many articles in a single file, use the other
11705          ;; function to save articles other than the first one.
11706          (saver2 (get gnus-default-article-saver :function))
11707          (gnus-prompt-before-saving (if saver2
11708                                         t
11709                                       gnus-prompt-before-saving))
11710          (gnus-default-article-saver gnus-default-article-saver)
11711          header file)
11712     (dolist (article articles)
11713       (setq header (gnus-summary-article-header article))
11714       (if (not (vectorp header))
11715           ;; This is a pseudo-article.
11716           (if (assq 'name header)
11717               (gnus-copy-file (cdr (assq 'name header)))
11718             (gnus-message 1 "Article %d is unsaveable" article))
11719         ;; This is a real article.
11720         (save-window-excursion
11721           (gnus-summary-select-article decode decode nil article)
11722           (gnus-summary-goto-subject article))
11723         (with-current-buffer save-buffer
11724           (erase-buffer)
11725           (insert-buffer-substring (if decode
11726                                        gnus-article-buffer
11727                                      gnus-original-article-buffer)))
11728         (setq file (gnus-article-save save-buffer file num))
11729         (gnus-summary-remove-process-mark article)
11730         (unless not-saved
11731           (gnus-summary-set-saved-mark article)))
11732       (when saver2
11733         (setq gnus-default-article-saver saver2
11734               saver2 nil)))
11735     (gnus-kill-buffer save-buffer)
11736     (gnus-summary-position-point)
11737     (gnus-set-mode-line 'summary)
11738     n))
11739
11740 (defun gnus-summary-pipe-output (&optional n sym)
11741   "Pipe the current article to a subprocess.
11742 If N is a positive number, pipe the N next articles.
11743 If N is a negative number, pipe the N previous articles.
11744 If N is nil and any articles have been marked with the process mark,
11745 pipe those articles instead.
11746 The default command to which articles are piped is specified by the
11747 variable `gnus-summary-pipe-output-default-command'; if it is nil, you
11748 will be prompted for the command.
11749
11750 The properties `:decode' and `:headers' that are put to the function
11751 symbol `gnus-summary-save-in-pipe' control whether this function
11752 decodes articles and what headers to keep (see the doc string for the
11753 `gnus-default-article-saver' variable).  If SYM (the symbolic prefix)
11754 is neither omitted nor the symbol `r', force including all headers
11755 regardless of the `:headers' property.  If it is the symbol `r',
11756 articles that are not decoded and include all headers will be piped
11757 no matter what the properties `:decode' and `:headers' are."
11758   (interactive (gnus-interactive "P\ny"))
11759   (require 'gnus-art)
11760   (let* ((articles (gnus-summary-work-articles n))
11761          (result-buffer "*Shell Command Output*")
11762          (all-headers (not (memq sym '(nil r))))
11763          (gnus-save-all-headers (or all-headers gnus-save-all-headers))
11764          (raw (eq sym 'r))
11765          (headers (get 'gnus-summary-save-in-pipe :headers))
11766          command result)
11767     (unless (numberp (car articles))
11768       (error "No article to pipe"))
11769     (setq command (gnus-read-shell-command
11770                    (concat "Shell command on "
11771                            (if (cdr articles)
11772                                (format "these %d articles" (length articles))
11773                              "this article")
11774                            ": ")
11775                    gnus-summary-pipe-output-default-command))
11776     (when (string-equal command "")
11777       (error "A command is required"))
11778     (when all-headers
11779       (put 'gnus-summary-save-in-pipe :headers nil))
11780     (unwind-protect
11781         (while articles
11782           (gnus-summary-goto-subject (pop articles))
11783           (save-window-excursion (gnus-summary-save-in-pipe command raw))
11784           (when (and (get-buffer result-buffer)
11785                      (not (zerop (buffer-size (get-buffer result-buffer)))))
11786             (setq result (concat result (with-current-buffer result-buffer
11787                                           (buffer-string))))))
11788       (put 'gnus-summary-save-in-pipe :headers headers))
11789     (unless (zerop (length result))
11790       (if (with-current-buffer (get-buffer-create result-buffer)
11791             (erase-buffer)
11792             (insert result)
11793             (prog1
11794                 (and (= (count-lines (point-min) (point)) 1)
11795                      (progn
11796                        (end-of-line 0)
11797                        (<= (current-column)
11798                            (window-width (minibuffer-window)))))
11799               (goto-char (point-min))))
11800           (message "%s" (substring result 0 -1))
11801         (message nil)
11802         (gnus-configure-windows 'pipe)))))
11803
11804 (defun gnus-summary-save-article-mail (&optional arg)
11805   "Append the current article to a Unix mail box file.
11806 If N is a positive number, save the N next articles.
11807 If N is a negative number, save the N previous articles.
11808 If N is nil and any articles have been marked with the process mark,
11809 save those articles instead."
11810   (interactive "P")
11811   (require 'gnus-art)
11812   (let ((gnus-default-article-saver 'gnus-summary-save-in-mail))
11813     (gnus-summary-save-article arg)))
11814
11815 (defun gnus-summary-save-article-rmail (&optional arg)
11816   "Append the current article to an rmail file.
11817 If N is a positive number, save the N next articles.
11818 If N is a negative number, save the N previous articles.
11819 If N is nil and any articles have been marked with the process mark,
11820 save those articles instead."
11821   (interactive "P")
11822   (require 'gnus-art)
11823   (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail))
11824     (gnus-summary-save-article arg)))
11825
11826 (defun gnus-summary-save-article-file (&optional arg)
11827   "Append the current article to a file.
11828 If N is a positive number, save the N next articles.
11829 If N is a negative number, save the N previous articles.
11830 If N is nil and any articles have been marked with the process mark,
11831 save those articles instead."
11832   (interactive "P")
11833   (require 'gnus-art)
11834   (let ((gnus-default-article-saver 'gnus-summary-save-in-file))
11835     (gnus-summary-save-article arg)))
11836
11837 (defun gnus-summary-write-article-file (&optional arg)
11838   "Write the current article to a file, deleting the previous file.
11839 If N is a positive number, save the N next articles.
11840 If N is a negative number, save the N previous articles.
11841 If N is nil and any articles have been marked with the process mark,
11842 save those articles instead."
11843   (interactive "P")
11844   (require 'gnus-art)
11845   (let ((gnus-default-article-saver 'gnus-summary-write-to-file))
11846     (gnus-summary-save-article arg)))
11847
11848 (defun gnus-summary-save-article-body-file (&optional arg)
11849   "Append the current article body to a file.
11850 If N is a positive number, save the N next articles.
11851 If N is a negative number, save the N previous articles.
11852 If N is nil and any articles have been marked with the process mark,
11853 save those articles instead."
11854   (interactive "P")
11855   (require 'gnus-art)
11856   (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file))
11857     (gnus-summary-save-article arg)))
11858
11859 (defun gnus-summary-write-article-body-file (&optional arg)
11860   "Write the current article body to a file, deleting the previous file.
11861 If N is a positive number, save the N next articles.
11862 If N is a negative number, save the N previous articles.
11863 If N is nil and any articles have been marked with the process mark,
11864 save those articles instead."
11865   (interactive "P")
11866   (require 'gnus-art)
11867   (let ((gnus-default-article-saver 'gnus-summary-write-body-to-file))
11868     (gnus-summary-save-article arg)))
11869
11870 (defun gnus-summary-muttprint (&optional arg)
11871   "Print the current article using Muttprint.
11872 If N is a positive number, save the N next articles.
11873 If N is a negative number, save the N previous articles.
11874 If N is nil and any articles have been marked with the process mark,
11875 save those articles instead."
11876   (interactive "P")
11877   (require 'gnus-art)
11878   (let ((gnus-default-article-saver 'gnus-summary-pipe-to-muttprint))
11879     (gnus-summary-save-article arg t)))
11880
11881 (defun gnus-summary-pipe-message (program)
11882   "Pipe the current article through PROGRAM."
11883   (interactive "sProgram: ")
11884   (gnus-summary-select-article)
11885   (let ((mail-header-separator ""))
11886     (gnus-eval-in-buffer-window gnus-article-buffer
11887       (save-restriction
11888         (widen)
11889         (let ((start (window-start))
11890               (inhibit-read-only t))
11891           (message-pipe-buffer-body program)
11892           (set-window-start (get-buffer-window (current-buffer)) start))))))
11893
11894 (defun gnus-get-split-value (methods)
11895   "Return a value based on the split METHODS."
11896   (let (split-name method result match)
11897     (when methods
11898       (with-current-buffer gnus-original-article-buffer
11899         (save-restriction
11900           (nnheader-narrow-to-headers)
11901           (while (and methods (not split-name))
11902             (goto-char (point-min))
11903             (setq method (pop methods))
11904             (setq match (car method))
11905             (when (cond
11906                    ((stringp match)
11907                     ;; Regular expression.
11908                     (ignore-errors
11909                       (re-search-forward match nil t)))
11910                    ((functionp match)
11911                     ;; Function.
11912                     (save-restriction
11913                       (widen)
11914                       (setq result (funcall match gnus-newsgroup-name))))
11915                    ((consp match)
11916                     ;; Form.
11917                     (save-restriction
11918                       (widen)
11919                       (setq result (eval match)))))
11920               (setq split-name (cdr method))
11921               (cond ((stringp result)
11922                      (push (expand-file-name
11923                             result gnus-article-save-directory)
11924                            split-name))
11925                     ((consp result)
11926                      (setq split-name (append result split-name)))))))))
11927     (nreverse split-name)))
11928
11929 (defun gnus-valid-move-group-p (group)
11930   (and (symbolp group)
11931        (boundp group)
11932        (symbol-name group)
11933        (symbol-value group)
11934        (gnus-get-function (gnus-find-method-for-group
11935                            (symbol-name group)) 'request-accept-article t)))
11936
11937 (defun gnus-read-move-group-name (prompt default articles prefix)
11938   "Read a group name."
11939   (let* ((split-name (gnus-get-split-value gnus-move-split-methods))
11940          (minibuffer-confirm-incomplete nil) ; XEmacs
11941          (prom
11942           (format "%s %s to"
11943                   prompt
11944                   (if (> (length articles) 1)
11945                       (format "these %d articles" (length articles))
11946                     "this article")))
11947          (to-newsgroup
11948           (cond
11949            ((null split-name)
11950             (gnus-group-completing-read
11951              prom
11952              (gnus-remove-if-not 'gnus-valid-move-group-p gnus-active-hashtb t)
11953              nil prefix nil default))
11954            ((= 1 (length split-name))
11955             (gnus-group-completing-read
11956              prom
11957              (gnus-remove-if-not 'gnus-valid-move-group-p gnus-active-hashtb t)
11958              nil prefix 'gnus-group-history (car split-name)))
11959            (t
11960             (gnus-completing-read
11961              prom (nreverse split-name) nil nil 'gnus-group-history))))
11962          (to-method (gnus-server-to-method (gnus-group-method to-newsgroup)))
11963          encoded)
11964     (when to-newsgroup
11965       (if (or (string= to-newsgroup "")
11966               (string= to-newsgroup prefix))
11967           (setq to-newsgroup default))
11968       (unless to-newsgroup
11969         (error "No group name entered"))
11970       (setq encoded (mm-encode-coding-string
11971                      to-newsgroup
11972                      (gnus-group-name-charset to-method to-newsgroup)))
11973       (or (gnus-active encoded)
11974           (gnus-activate-group encoded nil nil to-method)
11975           (if (gnus-y-or-n-p (format "No such group: %s.  Create it? "
11976                                      to-newsgroup))
11977               (or (and (gnus-request-create-group encoded to-method)
11978                        (gnus-activate-group encoded nil nil to-method)
11979                        (gnus-subscribe-group encoded))
11980                   (error "Couldn't create group %s" to-newsgroup)))
11981           (error "No such group: %s" to-newsgroup))
11982       encoded)))
11983
11984 (defvar gnus-summary-save-parts-counter)
11985 (declare-function mm-uu-dissect "mm-uu" (&optional noheader mime-type))
11986
11987 (defun gnus-summary-save-parts (type dir n &optional reverse)
11988   "Save parts matching TYPE to DIR.
11989 If REVERSE, save parts that do not match TYPE."
11990   (interactive
11991    (list (read-string "Save parts of type: "
11992                       (or (car gnus-summary-save-parts-type-history)
11993                           gnus-summary-save-parts-default-mime)
11994                       'gnus-summary-save-parts-type-history)
11995          (setq gnus-summary-save-parts-last-directory
11996                (read-file-name "Save to directory: "
11997                                gnus-summary-save-parts-last-directory
11998                                nil t))
11999          current-prefix-arg))
12000   (gnus-summary-iterate n
12001     (let ((gnus-display-mime-function nil)
12002           gnus-article-prepare-hook
12003           gnus-article-decode-hook
12004           gnus-display-mime-function
12005           gnus-break-pages
12006           (gnus-inhibit-treatment t))
12007       (gnus-summary-select-article))
12008     (with-current-buffer gnus-article-buffer
12009       (let ((handles (or gnus-article-mime-handles
12010                          (mm-dissect-buffer nil gnus-article-loose-mime)
12011                          (and gnus-article-emulate-mime
12012                               (mm-uu-dissect))))
12013             (gnus-summary-save-parts-counter 1))
12014         (when handles
12015           (gnus-summary-save-parts-1 type dir handles reverse)
12016           (unless gnus-article-mime-handles ;; Don't destroy this case.
12017             (mm-destroy-parts handles)))))))
12018
12019 (defun gnus-summary-save-parts-1 (type dir handle reverse)
12020   (if (stringp (car handle))
12021       (mapcar (lambda (h) (gnus-summary-save-parts-1 type dir h reverse))
12022               (cdr handle))
12023     (when (if reverse
12024               (not (string-match type (mm-handle-media-type handle)))
12025             (string-match type (mm-handle-media-type handle)))
12026       (let ((file (expand-file-name
12027                    (gnus-map-function
12028                     mm-file-name-rewrite-functions
12029                     (file-name-nondirectory
12030                      (or
12031                       (mail-content-type-get
12032                        (mm-handle-disposition handle) 'filename)
12033                       (mail-content-type-get
12034                        (mm-handle-type handle) 'name)
12035                       (format "%s.%d.%d" gnus-newsgroup-name
12036                               (cdr gnus-article-current)
12037                               gnus-summary-save-parts-counter))))
12038                    dir)))
12039         (incf gnus-summary-save-parts-counter)
12040         (unless (file-exists-p file)
12041           (mm-save-part-to-file handle file))))))
12042
12043 ;; Summary extract commands
12044
12045 (defun gnus-summary-insert-pseudos (pslist &optional not-view)
12046   (let ((inhibit-read-only t)
12047         (article (gnus-summary-article-number))
12048         after-article b e)
12049     (unless (gnus-summary-goto-subject article)
12050       (error "No such article: %d" article))
12051     (gnus-summary-position-point)
12052     ;; If all commands are to be bunched up on one line, we collect
12053     ;; them here.
12054     (unless gnus-view-pseudos-separately
12055       (let ((ps (setq pslist (sort pslist 'gnus-pseudos<)))
12056             files action)
12057         (while ps
12058           (setq action (cdr (assq 'action (car ps))))
12059           (setq files (list (cdr (assq 'name (car ps)))))
12060           (while (and ps (cdr ps)
12061                       (string= (or action "1")
12062                                (or (cdr (assq 'action (cadr ps))) "2")))
12063             (push (cdr (assq 'name (cadr ps))) files)
12064             (setcdr ps (cddr ps)))
12065           (when files
12066             (when (not (string-match "%s" action))
12067               (push " " files))
12068             (push " " files)
12069             (when (assq 'execute (car ps))
12070               (setcdr (assq 'execute (car ps))
12071                       (funcall (if (string-match "%s" action)
12072                                    'format 'concat)
12073                                action
12074                                (mapconcat
12075                                 (lambda (f)
12076                                   (if (equal f " ")
12077                                       f
12078                                     (shell-quote-argument f)))
12079                                 files " ")))))
12080           (setq ps (cdr ps)))))
12081     (if (and gnus-view-pseudos (not not-view))
12082         (while pslist
12083           (when (assq 'execute (car pslist))
12084             (gnus-execute-command (cdr (assq 'execute (car pslist)))
12085                                   (eq gnus-view-pseudos 'not-confirm)))
12086           (setq pslist (cdr pslist)))
12087       (save-excursion
12088         (while pslist
12089           (setq after-article (or (cdr (assq 'article (car pslist)))
12090                                   (gnus-summary-article-number)))
12091           (gnus-summary-goto-subject after-article)
12092           (forward-line 1)
12093           (setq b (point))
12094           (insert "    " (file-name-nondirectory
12095                           (cdr (assq 'name (car pslist))))
12096                   ": " (or (cdr (assq 'execute (car pslist))) "") "\n")
12097           (setq e (point))
12098           (forward-line -1)             ; back to `b'
12099           (gnus-add-text-properties
12100            b (1- e) (list 'gnus-number gnus-reffed-article-number
12101                           gnus-mouse-face-prop gnus-mouse-face))
12102           (gnus-data-enter
12103            after-article gnus-reffed-article-number
12104            gnus-unread-mark b (car pslist) 0 (- e b))
12105           (setq gnus-newsgroup-unreads
12106                 (gnus-add-to-sorted-list gnus-newsgroup-unreads
12107                                          gnus-reffed-article-number))
12108           (setq gnus-reffed-article-number (1- gnus-reffed-article-number))
12109           (setq pslist (cdr pslist)))))))
12110
12111 (defun gnus-pseudos< (p1 p2)
12112   (let ((c1 (cdr (assq 'action p1)))
12113         (c2 (cdr (assq 'action p2))))
12114     (and c1 c2 (string< c1 c2))))
12115
12116 (defun gnus-request-pseudo-article (props)
12117   (cond ((assq 'execute props)
12118          (gnus-execute-command (cdr (assq 'execute props)))))
12119   (let ((gnus-current-article (gnus-summary-article-number)))
12120     (gnus-run-hooks 'gnus-mark-article-hook)))
12121
12122 (defun gnus-execute-command (command &optional automatic)
12123   (save-excursion
12124     (gnus-article-setup-buffer)
12125     (set-buffer gnus-article-buffer)
12126     (setq buffer-read-only nil)
12127     (let ((command (if automatic command
12128                      (read-string "Command: " (cons command 0)))))
12129       (erase-buffer)
12130       (insert "$ " command "\n\n")
12131       (if gnus-view-pseudo-asynchronously
12132           (start-process "gnus-execute" (current-buffer) shell-file-name
12133                          shell-command-switch command)
12134         (call-process shell-file-name nil t nil
12135                       shell-command-switch command)))))
12136
12137 ;; Summary kill commands.
12138
12139 (defun gnus-summary-edit-global-kill (article)
12140   "Edit the \"global\" kill file."
12141   (interactive (list (gnus-summary-article-number)))
12142   (gnus-group-edit-global-kill article))
12143
12144 (defun gnus-summary-edit-local-kill ()
12145   "Edit a local kill file applied to the current newsgroup."
12146   (interactive)
12147   (setq gnus-current-headers (gnus-summary-article-header))
12148   (gnus-group-edit-local-kill
12149    (gnus-summary-article-number) gnus-newsgroup-name))
12150
12151 ;;; Header reading.
12152
12153 (defun gnus-read-header (id &optional header)
12154   "Read the headers of article ID and enter them into the Gnus system."
12155   (let ((group gnus-newsgroup-name)
12156         (gnus-override-method
12157          (or
12158           gnus-override-method
12159           (and (gnus-news-group-p gnus-newsgroup-name)
12160                (car (gnus-refer-article-methods)))))
12161         where)
12162     ;; First we check to see whether the header in question is already
12163     ;; fetched.
12164     (if (stringp id)
12165         ;; This is a Message-ID.
12166         (setq header (or header (gnus-id-to-header id)))
12167       ;; This is an article number.
12168       (setq header (or header (gnus-summary-article-header id))))
12169     (if (and header
12170              (not (gnus-summary-article-sparse-p (mail-header-number header))))
12171         ;; We have found the header.
12172         header
12173       ;; We have to really fetch the header to this article.
12174       (with-current-buffer nntp-server-buffer
12175         (when (setq where (gnus-request-head id group))
12176           (nnheader-fold-continuation-lines)
12177           (goto-char (point-max))
12178           (insert ".\n")
12179           (goto-char (point-min))
12180           (insert "211 ")
12181           (princ (cond
12182                   ((numberp id) id)
12183                   ((cdr where) (cdr where))
12184                   (header (mail-header-number header))
12185                   (t gnus-reffed-article-number))
12186                  (current-buffer))
12187           (insert " Article retrieved.\n"))
12188         (if (or (not where)
12189                 (not (setq header (car (gnus-get-newsgroup-headers nil t)))))
12190             ()                          ; Malformed head.
12191           (unless (gnus-summary-article-sparse-p (mail-header-number header))
12192             (when (and (stringp id)
12193                        (or
12194                         (not (string= (gnus-group-real-name group)
12195                                       (car where)))
12196                         (not (gnus-server-equal gnus-override-method
12197                                                 (gnus-group-method group)))))
12198               ;; If we fetched by Message-ID and the article came from
12199               ;; a different group (or server), we fudge some bogus
12200               ;; article numbers for this article.
12201               (mail-header-set-number header gnus-reffed-article-number))
12202             (with-current-buffer gnus-summary-buffer
12203               (decf gnus-reffed-article-number)
12204               (gnus-remove-header (mail-header-number header))
12205               (push header gnus-newsgroup-headers)
12206               (setq gnus-current-headers header)
12207               (push (mail-header-number header) gnus-newsgroup-limit)))
12208           header)))))
12209
12210 (defun gnus-remove-header (number)
12211   "Remove header NUMBER from `gnus-newsgroup-headers'."
12212   (if (and gnus-newsgroup-headers
12213            (= number (mail-header-number (car gnus-newsgroup-headers))))
12214       (pop gnus-newsgroup-headers)
12215     (let ((headers gnus-newsgroup-headers))
12216       (while (and (cdr headers)
12217                   (not (= number (mail-header-number (cadr headers)))))
12218         (pop headers))
12219       (when (cdr headers)
12220         (setcdr headers (cddr headers))))))
12221
12222 ;;;
12223 ;;; summary highlights
12224 ;;;
12225
12226 (defun gnus-highlight-selected-summary ()
12227   "Highlight selected article in summary buffer."
12228   ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
12229   (when gnus-summary-selected-face
12230     (save-excursion
12231       (let* ((beg (point-at-bol))
12232              (end (point-at-eol))
12233              ;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>.
12234              (from (if (get-text-property beg gnus-mouse-face-prop)
12235                        beg
12236                      (or (next-single-property-change
12237                           beg gnus-mouse-face-prop nil end)
12238                          beg)))
12239              (to
12240               (if (= from end)
12241                   (- from 2)
12242                 (or (next-single-property-change
12243                      from gnus-mouse-face-prop nil end)
12244                     end))))
12245         ;; If no mouse-face prop on line we will have to = from = end,
12246         ;; so we highlight the entire line instead.
12247         (when (= (+ to 2) from)
12248           (setq from beg)
12249           (setq to end))
12250         (if gnus-newsgroup-selected-overlay
12251             ;; Move old overlay.
12252             (gnus-move-overlay
12253              gnus-newsgroup-selected-overlay from to (current-buffer))
12254           ;; Create new overlay.
12255           (gnus-overlay-put
12256            (setq gnus-newsgroup-selected-overlay (gnus-make-overlay from to))
12257            'face gnus-summary-selected-face))))))
12258
12259 (defvar gnus-summary-highlight-line-cached nil)
12260 (defvar gnus-summary-highlight-line-trigger nil)
12261
12262 (defun gnus-summary-highlight-line-0 ()
12263   (if (and (eq gnus-summary-highlight-line-trigger
12264                gnus-summary-highlight)
12265            gnus-summary-highlight-line-cached)
12266       gnus-summary-highlight-line-cached
12267     (setq gnus-summary-highlight-line-trigger gnus-summary-highlight
12268           gnus-summary-highlight-line-cached
12269           (let* ((cond (list 'cond))
12270                  (c cond)
12271                  (list gnus-summary-highlight))
12272             (while list
12273               (setcdr c (cons (list (caar list) (list 'quote (cdar list)))
12274                               nil))
12275               (setq c (cdr c)
12276                     list (cdr list)))
12277             (gnus-byte-compile (list 'lambda nil cond))))))
12278
12279 (defun gnus-summary-highlight-line ()
12280   "Highlight current line according to `gnus-summary-highlight'."
12281   (let* ((beg (point-at-bol))
12282          (article (or (gnus-summary-article-number) gnus-current-article))
12283          (score (or (cdr (assq article
12284                                gnus-newsgroup-scored))
12285                     gnus-summary-default-score 0))
12286          (mark (or (gnus-summary-article-mark) gnus-unread-mark))
12287          (inhibit-read-only t)
12288          (default gnus-summary-default-score)
12289          (default-high gnus-summary-default-high-score)
12290          (default-low gnus-summary-default-low-score)
12291          (uncached (and gnus-summary-use-undownloaded-faces
12292                         (memq article gnus-newsgroup-undownloaded)
12293                         (not (memq article gnus-newsgroup-cached)))))
12294     (let ((face (funcall (gnus-summary-highlight-line-0))))
12295       (unless (eq face (get-text-property beg 'face))
12296         (gnus-put-text-property-excluding-characters-with-faces
12297          beg (point-at-eol) 'face
12298          (setq face (if (boundp face) (symbol-value face) face)))
12299         (when gnus-summary-highlight-line-function
12300           (funcall gnus-summary-highlight-line-function article face))))))
12301
12302 (defun gnus-update-read-articles (group unread &optional compute)
12303   "Update the list of read articles in GROUP.
12304 UNREAD is a sorted list."
12305   (let ((active (or gnus-newsgroup-active (gnus-active group)))
12306         (info (gnus-get-info group))
12307         (prev 1)
12308         read)
12309     (if (or (not info) (not active))
12310         ;; There is no info on this group if it was, in fact,
12311         ;; killed.  Gnus stores no information on killed groups, so
12312         ;; there's nothing to be done.
12313         ;; One could store the information somewhere temporarily,
12314         ;; perhaps...  Hmmm...
12315         ()
12316       ;; Remove any negative articles numbers.
12317       (while (and unread (< (car unread) 0))
12318         (setq unread (cdr unread)))
12319       ;; Remove any expired article numbers
12320       (while (and unread (< (car unread) (car active)))
12321         (setq unread (cdr unread)))
12322       ;; Compute the ranges of read articles by looking at the list of
12323       ;; unread articles.
12324       (while unread
12325         (when (/= (car unread) prev)
12326           (push (if (= prev (1- (car unread))) prev
12327                   (cons prev (1- (car unread))))
12328                 read))
12329         (setq prev (1+ (car unread)))
12330         (setq unread (cdr unread)))
12331       (when (<= prev (cdr active))
12332         (push (cons prev (cdr active)) read))
12333       (setq read (if (> (length read) 1) (nreverse read) read))
12334       (if compute
12335           read
12336         (save-excursion
12337           (let (setmarkundo)
12338             ;; Propagate the read marks to the backend.
12339             (when (and gnus-propagate-marks
12340                        (gnus-check-backend-function 'request-set-mark group))
12341               (let ((del (gnus-remove-from-range (gnus-info-read info) read))
12342                     (add (gnus-remove-from-range read (gnus-info-read info))))
12343                 (when (or add del)
12344                   (unless (gnus-check-group group)
12345                     (error "Can't open server for %s" group))
12346                   (gnus-request-set-mark
12347                    group (delq nil (list (if add (list add 'add '(read)))
12348                                          (if del (list del 'del '(read))))))
12349                   (setq setmarkundo
12350                         `(gnus-request-set-mark
12351                           ,group
12352                           ',(delq nil (list
12353                                        (if del (list del 'add '(read)))
12354                                        (if add (list add 'del '(read))))))))))
12355             (set-buffer gnus-group-buffer)
12356             (gnus-undo-register
12357               `(progn
12358                  (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
12359                  (gnus-info-set-read ',info ',(gnus-info-read info))
12360                  (gnus-get-unread-articles-in-group ',info
12361                                                     (gnus-active ,group))
12362                  (gnus-group-update-group ,group t)
12363                  ,setmarkundo))))
12364         ;; Enter this list into the group info.
12365         (gnus-info-set-read info read)
12366         ;; Set the number of unread articles in gnus-newsrc-hashtb.
12367         (gnus-get-unread-articles-in-group info (gnus-active group))
12368         t))))
12369
12370 (defun gnus-offer-save-summaries ()
12371   "Offer to save all active summary buffers."
12372   (let (buffers)
12373     ;; Go through all buffers and find all summaries.
12374     (dolist (buffer (buffer-list))
12375       (when (and (setq buffer (buffer-name buffer))
12376                  (string-match "Summary" buffer)
12377                  (with-current-buffer buffer
12378                    ;; We check that this is, indeed, a summary buffer.
12379                    (and (eq major-mode 'gnus-summary-mode)
12380                         ;; Also make sure this isn't bogus.
12381                         gnus-newsgroup-prepared
12382                         ;; Also make sure that this isn't a
12383                         ;; dead summary buffer.
12384                         (not gnus-dead-summary-mode))))
12385         (push buffer buffers)))
12386     ;; Go through all these summary buffers and offer to save them.
12387     (when buffers
12388       (save-excursion
12389         (map-y-or-n-p
12390          "Update summary buffer %s? "
12391          (lambda (buf)
12392            (switch-to-buffer buf)
12393            (gnus-summary-exit))
12394          buffers)))))
12395
12396 (defun gnus-summary-setup-default-charset ()
12397   "Setup newsgroup default charset."
12398   (if (member gnus-newsgroup-name '("nndraft:delayed" "nndraft:drafts"))
12399       (setq gnus-newsgroup-charset nil)
12400     (let* ((ignored-charsets
12401             (or gnus-newsgroup-ephemeral-ignored-charsets
12402                 (append
12403                  (and gnus-newsgroup-name
12404                       (gnus-parameter-ignored-charsets gnus-newsgroup-name))
12405                  gnus-newsgroup-ignored-charsets))))
12406       (setq gnus-newsgroup-charset
12407             (or gnus-newsgroup-ephemeral-charset
12408                 (and gnus-newsgroup-name
12409                      (gnus-parameter-charset gnus-newsgroup-name))
12410                 gnus-default-charset))
12411       (set (make-local-variable 'gnus-newsgroup-ignored-charsets)
12412            ignored-charsets))))
12413
12414 ;;;
12415 ;;; Mime Commands
12416 ;;;
12417
12418 (defun gnus-summary-display-buttonized (&optional show-all-parts)
12419   "Display the current article buffer fully MIME-buttonized.
12420 If SHOW-ALL-PARTS (the prefix) is non-nil, all multipart/* parts are
12421 treated as multipart/mixed."
12422   (interactive "P")
12423   (require 'gnus-art)
12424   (let ((gnus-unbuttonized-mime-types nil)
12425         (gnus-mime-display-multipart-as-mixed show-all-parts))
12426     (gnus-summary-show-article)))
12427
12428 (defun gnus-summary-repair-multipart (article)
12429   "Add a Content-Type header to a multipart article without one."
12430   (interactive (list (gnus-summary-article-number)))
12431   (gnus-with-article article
12432     (message-narrow-to-head)
12433     (message-remove-header "Mime-Version")
12434     (goto-char (point-max))
12435     (insert "Mime-Version: 1.0\n")
12436     (widen)
12437     (when (search-forward "\n--" nil t)
12438       (let ((separator (buffer-substring (point) (point-at-eol))))
12439         (message-narrow-to-head)
12440         (message-remove-header "Content-Type")
12441         (goto-char (point-max))
12442         (insert (format "Content-Type: multipart/mixed; boundary=\"%s\"\n"
12443                         separator))
12444         (widen))))
12445   (let (gnus-mark-article-hook)
12446     (gnus-summary-select-article t t nil article)))
12447
12448 (defun gnus-summary-toggle-display-buttonized ()
12449   "Toggle the buttonizing of the article buffer."
12450   (interactive)
12451   (require 'gnus-art)
12452   (if (setq gnus-inhibit-mime-unbuttonizing
12453             (not gnus-inhibit-mime-unbuttonizing))
12454       (let ((gnus-unbuttonized-mime-types nil))
12455         (gnus-summary-show-article))
12456     (gnus-summary-show-article)))
12457
12458 ;;;
12459 ;;; Generic summary marking commands
12460 ;;;
12461
12462 (defvar gnus-summary-marking-alist
12463   '((read gnus-del-mark "d")
12464     (unread gnus-unread-mark "u")
12465     (ticked gnus-ticked-mark "!")
12466     (dormant gnus-dormant-mark "?")
12467     (expirable gnus-expirable-mark "e"))
12468   "An alist of names/marks/keystrokes.")
12469
12470 (defvar gnus-summary-generic-mark-map (make-sparse-keymap))
12471 (defvar gnus-summary-mark-map)
12472
12473 (defun gnus-summary-make-all-marking-commands ()
12474   (define-key gnus-summary-mark-map "M" gnus-summary-generic-mark-map)
12475   (dolist (elem gnus-summary-marking-alist)
12476     (apply 'gnus-summary-make-marking-command elem)))
12477
12478 (defun gnus-summary-make-marking-command (name mark keystroke)
12479   (let ((map (make-sparse-keymap)))
12480     (define-key gnus-summary-generic-mark-map keystroke map)
12481     (dolist (lway `((next "next" next nil "n")
12482                     (next-unread "next unread" next t "N")
12483                     (prev "previous" prev nil "p")
12484                     (prev-unread "previous unread" prev t "P")
12485                     (nomove "" nil nil ,keystroke)))
12486       (let ((func (gnus-summary-make-marking-command-1
12487                    mark (car lway) lway name)))
12488         (setq func (eval func))
12489         (define-key map (nth 4 lway) func)))))
12490
12491 (defun gnus-summary-make-marking-command-1 (mark way lway name)
12492   `(defun ,(intern
12493             (format "gnus-summary-put-mark-as-%s%s"
12494                     name (if (eq way 'nomove)
12495                              ""
12496                            (concat "-" (symbol-name way)))))
12497      (n)
12498      ,(format
12499        "Mark the current article as %s%s.
12500 If N, the prefix, then repeat N times.
12501 If N is negative, move in reverse order.
12502 The difference between N and the actual number of articles marked is
12503 returned."
12504        name (cadr lway))
12505      (interactive "p")
12506      (gnus-summary-generic-mark n ,mark ',(nth 2 lway) ,(nth 3 lway))))
12507
12508 (defun gnus-summary-generic-mark (n mark move unread)
12509   "Mark N articles with MARK."
12510   (unless (eq major-mode 'gnus-summary-mode)
12511     (error "This command can only be used in the summary buffer"))
12512   (gnus-summary-show-thread)
12513   (let ((nummove
12514          (cond
12515           ((eq move 'next) 1)
12516           ((eq move 'prev) -1)
12517           (t 0))))
12518     (if (zerop nummove)
12519         (setq n 1)
12520       (when (< n 0)
12521         (setq n (abs n)
12522               nummove (* -1 nummove))))
12523     (while (and (> n 0)
12524                 (gnus-summary-mark-article nil mark)
12525                 (zerop (gnus-summary-next-subject nummove unread t)))
12526       (setq n (1- n)))
12527     (when (/= 0 n)
12528       (gnus-message 7 "No more %sarticles" (if mark "" "unread ")))
12529     (gnus-summary-recenter)
12530     (gnus-summary-position-point)
12531     (gnus-set-mode-line 'summary)
12532     n))
12533
12534 (defun gnus-summary-insert-articles (articles)
12535   (when (setq articles
12536               (gnus-sorted-difference articles
12537                                       (mapcar (lambda (h)
12538                                                 (mail-header-number h))
12539                                               gnus-newsgroup-headers)))
12540     (setq gnus-newsgroup-headers
12541           (gnus-merge 'list
12542                       gnus-newsgroup-headers
12543                       (gnus-fetch-headers articles)
12544                       'gnus-article-sort-by-number))
12545     ;; Suppress duplicates?
12546     (when gnus-suppress-duplicates
12547       (gnus-dup-suppress-articles))
12548
12549     (if (and gnus-fetch-old-headers
12550              (eq gnus-headers-retrieved-by 'nov))
12551         ;; We might want to build some more threads first.
12552         (if (eq gnus-fetch-old-headers 'invisible)
12553             (gnus-build-all-threads)
12554           (gnus-build-old-threads))
12555       ;; Mark the inserted articles that are unread as unread.
12556       (setq gnus-newsgroup-unreads
12557             (gnus-sorted-nunion
12558              gnus-newsgroup-unreads
12559              (gnus-sorted-nintersection
12560               (gnus-list-of-unread-articles gnus-newsgroup-name)
12561               articles)))
12562       ;; Mark the inserted articles as selected so that the information
12563       ;; of the marks having been changed by a user may be updated when
12564       ;; exiting this group.  See `gnus-summary-update-info'.
12565       (dolist (art articles)
12566         (setq gnus-newsgroup-unselected (delq art gnus-newsgroup-unselected))))
12567     ;; Let the Gnus agent mark articles as read.
12568     (when gnus-agent
12569       (gnus-agent-get-undownloaded-list))
12570     ;; Remove list identifiers from subject
12571     (when gnus-list-identifiers
12572       (gnus-summary-remove-list-identifiers))
12573     ;; First and last article in this newsgroup.
12574     (when gnus-newsgroup-headers
12575       (setq gnus-newsgroup-begin
12576             (mail-header-number (car gnus-newsgroup-headers))
12577             gnus-newsgroup-end
12578             (mail-header-number
12579              (gnus-last-element gnus-newsgroup-headers))))
12580     (when gnus-use-scoring
12581       (gnus-possibly-score-headers))))
12582
12583 (defun gnus-summary-insert-old-articles (&optional all)
12584   "Insert all old articles in this group.
12585 If ALL is non-nil, already read articles become readable.
12586 If ALL is a number, fetch this number of articles."
12587   (interactive "P")
12588   (prog1
12589       (let ((old (sort (mapcar 'car gnus-newsgroup-data) '<))
12590             older len)
12591         (setq older
12592               ;; Some nntp servers lie about their active range.  When
12593               ;; this happens, the active range can be in the millions.
12594               ;; Use a compressed range to avoid creating a huge list.
12595               (gnus-range-difference (list gnus-newsgroup-active) old))
12596         (setq len (gnus-range-length older))
12597         (cond
12598          ((null older) nil)
12599          ((numberp all)
12600           (if (< all len)
12601               (let ((older-range (nreverse older)))
12602                 (setq older nil)
12603
12604                 (while (> all 0)
12605                   (let* ((r (pop older-range))
12606                          (min (if (numberp r) r (car r)))
12607                          (max (if (numberp r) r (cdr r))))
12608                     (while (and (<= min max)
12609                                 (> all 0))
12610                       (push max older)
12611                       (setq all (1- all)
12612                             max (1- max))))))
12613             (setq older (gnus-uncompress-range older))))
12614          (all
12615           (setq older (gnus-uncompress-range older)))
12616          (t
12617           (when (and (numberp gnus-large-newsgroup)
12618                    (> len gnus-large-newsgroup))
12619               (let* ((cursor-in-echo-area nil)
12620                      (initial (gnus-parameter-large-newsgroup-initial
12621                                gnus-newsgroup-name))
12622                      (input
12623                       (read-string
12624                        (format
12625                         "How many articles from %s (%s %d): "
12626                         (gnus-group-decoded-name gnus-newsgroup-name)
12627                         (if initial "max" "default")
12628                         len)
12629                        (if initial
12630                            (cons (number-to-string initial)
12631                                  0)))))
12632                 (unless (string-match "^[ \t]*$" input)
12633                   (setq all (string-to-number input))
12634                   (if (< all len)
12635                       (let ((older-range (nreverse older)))
12636                         (setq older nil)
12637
12638                         (while (> all 0)
12639                           (let* ((r (pop older-range))
12640                                  (min (if (numberp r) r (car r)))
12641                                  (max (if (numberp r) r (cdr r))))
12642                             (while (and (<= min max)
12643                                         (> all 0))
12644                               (push max older)
12645                               (setq all (1- all)
12646                                     max (1- max))))))))))
12647           (setq older (gnus-uncompress-range older))))
12648         (if (not older)
12649             (message "No old news.")
12650           (gnus-summary-insert-articles older)
12651           (gnus-summary-limit (gnus-sorted-nunion old older))))
12652     (gnus-summary-position-point)))
12653
12654 (defun gnus-summary-insert-new-articles ()
12655   "Insert all new articles in this group."
12656   (interactive)
12657   (prog1
12658       (let ((old (sort (mapcar 'car gnus-newsgroup-data) '<))
12659             (old-high gnus-newsgroup-highest)
12660             (nnmail-fetched-sources (list t))
12661             i new)
12662         (setq gnus-newsgroup-active
12663               (gnus-copy-sequence
12664                (gnus-activate-group gnus-newsgroup-name 'scan)))
12665         (setq i (cdr gnus-newsgroup-active)
12666               gnus-newsgroup-highest i)
12667         (while (> i old-high)
12668           (push i new)
12669           (decf i))
12670         (if (not new)
12671             (message "No gnus is bad news")
12672           (gnus-summary-insert-articles new)
12673           (setq gnus-newsgroup-unreads
12674                 (gnus-sorted-nunion gnus-newsgroup-unreads new))
12675           (gnus-summary-limit (gnus-sorted-nunion old new))))
12676     (gnus-summary-position-point)))
12677
12678 ;;; Bookmark support for Gnus.
12679 (declare-function bookmark-make-record-default
12680                   "bookmark" (&optional no-file no-context posn))
12681 (declare-function bookmark-prop-get "bookmark" (bookmark prop))
12682 (declare-function bookmark-default-handler "bookmark" (bmk))
12683 (declare-function bookmark-get-bookmark-record "bookmark" (bmk))
12684 (defvar bookmark-yank-point)
12685 (defvar bookmark-current-buffer)
12686
12687 (defun gnus-summary-bookmark-make-record ()
12688   "Make a bookmark entry for a Gnus summary buffer."
12689   (let (pos buf)
12690     (unless (and (derived-mode-p 'gnus-summary-mode) gnus-article-current)
12691       (save-restriction              ; FIXME is it necessary to widen?
12692         (widen) (setq pos (point))) ; Set position in gnus-article buffer.
12693       (setq buf "art") ; We are recording bookmark from article buffer.
12694       (setq bookmark-yank-point (point))
12695       (setq bookmark-current-buffer (current-buffer))
12696       (gnus-article-show-summary))      ; Go back in summary buffer.
12697     ;; We are now recording bookmark from summary buffer.
12698     (unless buf (setq buf "sum"))
12699     (let* ((subject (elt (gnus-summary-article-header) 1))
12700            (grp     (car gnus-article-current))
12701            (art     (cdr gnus-article-current))
12702            (head    (gnus-summary-article-header art))
12703            (id      (mail-header-id head)))
12704       `(,subject
12705         ,@(condition-case nil
12706               (bookmark-make-record-default 'no-file 'no-context pos)
12707             (wrong-number-of-arguments
12708              (bookmark-make-record-default 'point-only)))
12709         (location . ,(format "Gnus-%s %s:%d:%s" buf grp art id))
12710         (group . ,grp) (article . ,art)
12711         (message-id . ,id) (handler . gnus-summary-bookmark-jump)))))
12712
12713 ;;;###autoload
12714 (defun gnus-summary-bookmark-jump (bookmark)
12715   "Handler function for record returned by `gnus-summary-bookmark-make-record'.
12716 BOOKMARK is a bookmark name or a bookmark record."
12717   (let ((group    (bookmark-prop-get bookmark 'group))
12718         (article  (bookmark-prop-get bookmark 'article))
12719         (id       (bookmark-prop-get bookmark 'message-id))
12720         (buf      (car (split-string (bookmark-prop-get bookmark 'location)))))
12721     (gnus-fetch-group group (list article))
12722     (gnus-summary-insert-cached-articles)
12723     (gnus-summary-goto-article id nil 'force)
12724     ;; FIXME we have to wait article buffer is ready (only large buffer)
12725     ;; Is there a better solution to know that?
12726     ;; If we don't wait `bookmark-default-handler' will have no chance
12727     ;; to set position. However there is no error, just wrong pos.
12728     (sit-for 1)
12729     (when (string= buf "Gnus-art")
12730       (other-window 1))
12731     (bookmark-default-handler
12732      `(""
12733        (buffer . ,(current-buffer))
12734        . ,(bookmark-get-bookmark-record bookmark)))))
12735
12736 (gnus-summary-make-all-marking-commands)
12737
12738 (gnus-ems-redefine)
12739
12740 (provide 'gnus-sum)
12741
12742 (run-hooks 'gnus-sum-load-hook)
12743
12744 ;; Local Variables:
12745 ;; coding: iso-8859-1
12746 ;; End:
12747
12748 ;;; gnus-sum.el ends here