(diary-ordinal-suffix): Declare for compiler.
[bpt/emacs.git] / lisp / gnus / gnus-sum.el
CommitLineData
eec82323 1;;; gnus-sum.el --- summary mode commands for Gnus
e84b4b86
TTN
2
3;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
e3fe4da0 4;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
eec82323 5
6748645f 6;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
eec82323
LMI
7;; Keywords: news
8
9;; This file is part of GNU Emacs.
10
5e809f55 11;; GNU Emacs is free software: you can redistribute it and/or modify
eec82323 12;; it under the terms of the GNU General Public License as published by
5e809f55
GM
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
eec82323
LMI
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
01ccbb85 18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
eec82323
LMI
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
5e809f55 22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
eec82323
LMI
23
24;;; Commentary:
25
26;;; Code:
27
d09ae6ca
GM
28;; For Emacs < 22.2.
29(eval-and-compile
30 (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
23f87bed 31(eval-when-compile
9efa445f
DN
32 (require 'cl))
33
34(defvar tool-bar-mode)
35(defvar gnus-tmp-header)
5ab7173c 36
eec82323
LMI
37(require 'gnus)
38(require 'gnus-group)
39(require 'gnus-spec)
40(require 'gnus-range)
41(require 'gnus-int)
42(require 'gnus-undo)
6748645f 43(require 'gnus-util)
18c06a99 44(require 'gmm-utils)
16409b0b 45(require 'mm-decode)
08c9a385 46(require 'nnoo)
23f87bed 47
6748645f 48(autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t)
d4dfaa19 49(autoload 'gnus-cache-write-active "gnus-cache")
23f87bed
MB
50(autoload 'gnus-mailing-list-insinuate "gnus-ml" nil t)
51(autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" nil t)
531e5812 52(autoload 'gnus-pick-line-number "gnus-salt" nil t)
08c9a385 53(autoload 'mm-uu-dissect "mm-uu")
23f87bed
MB
54(autoload 'gnus-article-outlook-deuglify-article "deuglify"
55 "Deuglify broken Outlook (Express) articles and redisplay."
56 t)
57(autoload 'gnus-article-outlook-unwrap-lines "deuglify" nil t)
58(autoload 'gnus-article-outlook-repair-attribution "deuglify" nil t)
59(autoload 'gnus-article-outlook-rearrange-citation "deuglify" nil t)
eec82323
LMI
60
61(defcustom gnus-kill-summary-on-exit t
62 "*If non-nil, kill the summary buffer when you exit from it.
63If nil, the summary will become a \"*Dead Summary*\" buffer, and
64it will be killed sometime later."
65 :group 'gnus-summary-exit
66 :type 'boolean)
67
01c52d31
MB
68(defcustom gnus-summary-next-group-on-exit t
69 "If non-nil, go to the next unread newsgroup on summary exit.
70See `gnus-group-goto-unread'."
71 :link '(custom-manual "(gnus)Group Maneuvering")
72 :group 'gnus-summary-exit
330f707b 73 :version "23.1" ;; No Gnus
01c52d31
MB
74 :type 'boolean)
75
eec82323
LMI
76(defcustom gnus-fetch-old-headers nil
77 "*Non-nil means that Gnus will try to build threads by grabbing old headers.
01c52d31
MB
78If an unread article in the group refers to an older, already
79read (or just marked as read) article, the old article will not
80normally be displayed in the Summary buffer. If this variable is
81t, Gnus will attempt to grab the headers to the old articles, and
82thereby build complete threads. If it has the value `some', all
83old headers will be fetched but only enough headers to connect
84otherwise loose threads will be displayed. This variable can
85also be a number. In that case, no more than that number of old
86headers will be fetched. If it has the value `invisible', all
6748645f 87old headers will be fetched, but none will be displayed.
eec82323 88
01c52d31
MB
89The server has to support NOV for any of this to work.
90
91This feature can seriously impact performance it ignores all
92locally cached header entries."
eec82323
LMI
93 :group 'gnus-thread
94 :type '(choice (const :tag "off" nil)
1232b9cb 95 (const :tag "on" t)
eec82323 96 (const some)
1232b9cb 97 (const invisible)
eec82323
LMI
98 number
99 (sexp :menu-tag "other" t)))
100
01c52d31 101(defcustom gnus-refer-thread-limit 500
6748645f
LMI
102 "*The number of old headers to fetch when doing \\<gnus-summary-mode-map>\\[gnus-summary-refer-thread].
103If t, fetch all the available old headers."
104 :group 'gnus-thread
105 :type '(choice number
106 (sexp :menu-tag "other" t)))
107
eec82323
LMI
108(defcustom gnus-summary-make-false-root 'adopt
109 "*nil means that Gnus won't gather loose threads.
110If the root of a thread has expired or been read in a previous
111session, the information necessary to build a complete thread has been
112lost. Instead of having many small sub-threads from this original thread
113scattered all over the summary buffer, Gnus can gather them.
114
115If non-nil, Gnus will try to gather all loose sub-threads from an
116original thread into one large thread.
117
118If this variable is non-nil, it should be one of `none', `adopt',
119`dummy' or `empty'.
120
121If this variable is `none', Gnus will not make a false root, but just
122present the sub-threads after another.
123If this variable is `dummy', Gnus will create a dummy root that will
124have all the sub-threads as children.
125If this variable is `adopt', Gnus will make one of the \"children\"
126the parent and mark all the step-children as such.
127If this variable is `empty', the \"children\" are printed with empty
01ccbb85 128subject fields. (Or rather, they will be printed with a string
eec82323
LMI
129given by the `gnus-summary-same-subject' variable.)"
130 :group 'gnus-thread
131 :type '(choice (const :tag "off" nil)
132 (const none)
133 (const dummy)
134 (const adopt)
135 (const empty)))
136
23f87bed
MB
137(defcustom gnus-summary-make-false-root-always nil
138 "Always make a false dummy root."
bf247b6e 139 :version "22.1"
23f87bed
MB
140 :group 'gnus-thread
141 :type 'boolean)
142
eec82323
LMI
143(defcustom gnus-summary-gather-exclude-subject "^ *$\\|^(none)$"
144 "*A regexp to match subjects to be excluded from loose thread gathering.
145As loose thread gathering is done on subjects only, that means that
146there can be many false gatherings performed. By rooting out certain
147common subjects, gathering might become saner."
148 :group 'gnus-thread
149 :type 'regexp)
150
151(defcustom gnus-summary-gather-subject-limit nil
152 "*Maximum length of subject comparisons when gathering loose threads.
153Use nil to compare full subjects. Setting this variable to a low
154number will help gather threads that have been corrupted by
155newsreaders chopping off subject lines, but it might also mean that
156unrelated articles that have subject that happen to begin with the
157same few characters will be incorrectly gathered.
158
159If this variable is `fuzzy', Gnus will use a fuzzy algorithm when
160comparing subjects."
161 :group 'gnus-thread
162 :type '(choice (const :tag "off" nil)
163 (const fuzzy)
164 (sexp :menu-tag "on" t)))
165
6748645f
LMI
166(defcustom gnus-simplify-subject-functions nil
167 "List of functions taking a string argument that simplify subjects.
168The functions are applied recursively.
169
23f87bed
MB
170Useful functions to put in this list include:
171`gnus-simplify-subject-re', `gnus-simplify-subject-fuzzy',
172`gnus-simplify-whitespace', and `gnus-simplify-all-whitespace'."
6748645f
LMI
173 :group 'gnus-thread
174 :type '(repeat function))
175
eec82323 176(defcustom gnus-simplify-ignored-prefixes nil
23f87bed 177 "*Remove matches for this regexp from subject lines when simplifying fuzzily."
eec82323
LMI
178 :group 'gnus-thread
179 :type '(choice (const :tag "off" nil)
180 regexp))
181
182(defcustom gnus-build-sparse-threads nil
183 "*If non-nil, fill in the gaps in threads.
184If `some', only fill in the gaps that are needed to tie loose threads
185together. If `more', fill in all leaf nodes that Gnus can find. If
186non-nil and non-`some', fill in all gaps that Gnus manages to guess."
187 :group 'gnus-thread
188 :type '(choice (const :tag "off" nil)
189 (const some)
190 (const more)
191 (sexp :menu-tag "all" t)))
192
193(defcustom gnus-summary-thread-gathering-function
194 'gnus-gather-threads-by-subject
6748645f 195 "*Function used for gathering loose threads.
eec82323
LMI
196There are two pre-defined functions: `gnus-gather-threads-by-subject',
197which only takes Subjects into consideration; and
198`gnus-gather-threads-by-references', which compared the References
199headers of the articles to find matches."
200 :group 'gnus-thread
22115a9e
RS
201 :type '(radio (function-item gnus-gather-threads-by-subject)
202 (function-item gnus-gather-threads-by-references)
203 (function :tag "other")))
eec82323 204
eec82323
LMI
205(defcustom gnus-summary-same-subject ""
206 "*String indicating that the current article has the same subject as the previous.
207This variable will only be used if the value of
208`gnus-summary-make-false-root' is `empty'."
209 :group 'gnus-summary-format
210 :type 'string)
211
212(defcustom gnus-summary-goto-unread t
16409b0b
GM
213 "*If t, many commands will go to the next unread article.
214This applies to marking commands as well as other commands that
215\"naturally\" select the next article, like, for instance, `SPC' at
216the end of an article.
217
218If nil, the marking commands do NOT go to the next unread article
2642ac8f 219\(they go to the next article instead). If `never', commands that
16409b0b
GM
220usually go to the next unread article, will go to the next article,
221whether it is read or not."
eec82323
LMI
222 :group 'gnus-summary-marks
223 :link '(custom-manual "(gnus)Setting Marks")
224 :type '(choice (const :tag "off" nil)
225 (const never)
226 (sexp :menu-tag "on" t)))
227
228(defcustom gnus-summary-default-score 0
229 "*Default article score level.
230All scores generated by the score files will be added to this score.
231If this variable is nil, scoring will be disabled."
232 :group 'gnus-score-default
233 :type '(choice (const :tag "disable")
234 integer))
235
23f87bed
MB
236(defcustom gnus-summary-default-high-score 0
237 "*Default threshold for a high scored article.
238An article will be highlighted as high scored if its score is greater
239than this score."
bf247b6e 240 :version "22.1"
23f87bed
MB
241 :group 'gnus-score-default
242 :type 'integer)
243
244(defcustom gnus-summary-default-low-score 0
245 "*Default threshold for a low scored article.
246An article will be highlighted as low scored if its score is smaller
247than this score."
bf247b6e 248 :version "22.1"
23f87bed
MB
249 :group 'gnus-score-default
250 :type 'integer)
251
eec82323
LMI
252(defcustom gnus-summary-zcore-fuzz 0
253 "*Fuzziness factor for the zcore in the summary buffer.
254Articles with scores closer than this to `gnus-summary-default-score'
255will not be marked."
256 :group 'gnus-summary-format
257 :type 'integer)
258
259(defcustom gnus-simplify-subject-fuzzy-regexp nil
260 "*Strings to be removed when doing fuzzy matches.
261This can either be a regular expression or list of regular expressions
262that will be removed from subject strings if fuzzy subject
263simplification is selected."
264 :group 'gnus-thread
265 :type '(repeat regexp))
266
267(defcustom gnus-show-threads t
268 "*If non-nil, display threads in summary mode."
269 :group 'gnus-thread
270 :type 'boolean)
271
272(defcustom gnus-thread-hide-subtree nil
273 "*If non-nil, hide all threads initially.
23f87bed 274This can be a predicate specifier which says which threads to hide.
eec82323 275If threads are hidden, you have to run the command
4a2358e9 276`gnus-summary-show-thread' by hand or select an article."
eec82323 277 :group 'gnus-thread
23f87bed
MB
278 :type '(radio (sexp :format "Non-nil\n"
279 :match (lambda (widget value)
280 (not (or (consp value) (functionp value))))
281 :value t)
282 (const nil)
ad136a7c 283 (sexp :tag "Predicate specifier")))
eec82323
LMI
284
285(defcustom gnus-thread-hide-killed t
286 "*If non-nil, hide killed threads automatically."
287 :group 'gnus-thread
288 :type 'boolean)
289
6748645f
LMI
290(defcustom gnus-thread-ignore-subject t
291 "*If non-nil, which is the default, ignore subjects and do all threading based on the Reference header.
292If nil, articles that have different subjects from their parents will
293start separate threads."
eec82323
LMI
294 :group 'gnus-thread
295 :type 'boolean)
296
297(defcustom gnus-thread-operation-ignore-subject t
298 "*If non-nil, subjects will be ignored when doing thread commands.
299This affects commands like `gnus-summary-kill-thread' and
300`gnus-summary-lower-thread'.
301
302If this variable is nil, articles in the same thread with different
303subjects will not be included in the operation in question. If this
304variable is `fuzzy', only articles that have subjects that are fuzzily
305equal will be included."
306 :group 'gnus-thread
307 :type '(choice (const :tag "off" nil)
308 (const fuzzy)
309 (sexp :tag "on" t)))
310
311(defcustom gnus-thread-indent-level 4
312 "*Number that says how much each sub-thread should be indented."
313 :group 'gnus-thread
314 :type 'integer)
315
316(defcustom gnus-auto-extend-newsgroup t
317 "*If non-nil, extend newsgroup forward and backward when requested."
318 :group 'gnus-summary-choose
319 :type 'boolean)
320
321(defcustom gnus-auto-select-first t
651408cb
MB
322 "If non-nil, select an article on group entry.
323An article is selected automatically when entering a group
324e.g. with \\<gnus-group-mode-map>\\[gnus-group-read-group], or via `gnus-summary-next-page' or
325`gnus-summary-catchup-and-goto-next-group'.
326
327Which article is selected is controlled by the variable
328`gnus-auto-select-subject'.
23f87bed
MB
329
330If you want to prevent automatic selection of articles in some
331newsgroups, set the variable to nil in `gnus-select-group-hook'."
651408cb
MB
332 ;; Commands include...
333 ;; \\<gnus-group-mode-map>\\[gnus-group-read-group]
334 ;; \\<gnus-summary-mode-map>\\[gnus-summary-next-page]
335 ;; \\<gnus-summary-mode-map>\\[gnus-summary-catchup-and-goto-next-group]
eec82323
LMI
336 :group 'gnus-group-select
337 :type '(choice (const :tag "none" nil)
23f87bed
MB
338 (sexp :menu-tag "first" t)))
339
340(defcustom gnus-auto-select-subject 'unread
341 "*Says what subject to place under point when entering a group.
342
343This variable can either be the symbols `first' (place point on the
344first subject), `unread' (place point on the subject line of the first
345unread article), `best' (place point on the subject line of the
346higest-scored article), `unseen' (place point on the subject line of
99b5aab7 347the first unseen article), `unseen-or-unread' (place point on the subject
23f87bed
MB
348line of the first unseen article or, if all article have been seen, on the
349subject line of the first unread article), or a function to be called to
350place point on some subject line."
bf247b6e 351 :version "22.1"
23f87bed
MB
352 :group 'gnus-group-select
353 :type '(choice (const best)
354 (const unread)
355 (const first)
356 (const unseen)
357 (const unseen-or-unread)))
eec82323
LMI
358
359(defcustom gnus-auto-select-next t
360 "*If non-nil, offer to go to the next group from the end of the previous.
361If the value is t and the next newsgroup is empty, Gnus will exit
23f87bed
MB
362summary mode and go back to group mode. If the value is neither nil
363nor t, Gnus will select the following unread newsgroup. In
eec82323
LMI
364particular, if the value is the symbol `quietly', the next unread
365newsgroup will be selected without any confirmation, and if it is
366`almost-quietly', the next group will be selected without any
367confirmation if you are located on the last article in the group.
23f87bed 368Finally, if this variable is `slightly-quietly', the `\\<gnus-summary-mode-map>\\[gnus-summary-catchup-and-goto-next-group]' command
eec82323
LMI
369will go to the next group without confirmation."
370 :group 'gnus-summary-maneuvering
371 :type '(choice (const :tag "off" nil)
372 (const quietly)
373 (const almost-quietly)
374 (const slightly-quietly)
375 (sexp :menu-tag "on" t)))
376
377(defcustom gnus-auto-select-same nil
6748645f
LMI
378 "*If non-nil, select the next article with the same subject.
379If there are no more articles with the same subject, go to
380the first unread article."
eec82323
LMI
381 :group 'gnus-summary-maneuvering
382 :type 'boolean)
383
01c52d31
MB
384(defcustom gnus-auto-select-on-ephemeral-exit 'next-noselect
385 "What article should be selected after exiting an ephemeral group.
386Valid values include:
387
388`next'
389 Select the next article.
390`next-unread'
391 Select the next unread article.
392`next-noselect'
393 Move the cursor to the next article. This is the default.
394`next-unread-noselect'
395 Move the cursor to the next unread article.
396
397If it has any other value or there is no next (unread) article, the
398article selected before entering to the ephemeral group will appear."
330f707b 399 :version "23.1" ;; No Gnus
01c52d31
MB
400 :group 'gnus-summary-maneuvering
401 :type '(choice :format "%{%t%}:\n %[Value Menu%] %v"
402 (const next) (const next-unread)
403 (const next-noselect) (const next-unread-noselect)
404 (sexp :tag "other" :value nil)))
405
23f87bed
MB
406(defcustom gnus-auto-goto-ignores 'unfetched
407 "*Says how to handle unfetched articles when maneuvering.
408
409This variable can either be the symbols nil (maneuver to any
410article), `undownloaded' (maneuvering while unplugged ignores articles
411that have not been fetched), `always-undownloaded' (maneuvering always
412ignores articles that have not been fetched), `unfetched' (maneuvering
413ignores articles whose headers have not been fetched).
414
415NOTE: The list of unfetched articles will always be nil when plugged
416and, when unplugged, a subset of the undownloaded article list."
bf247b6e 417 :version "22.1"
23f87bed
MB
418 :group 'gnus-summary-maneuvering
419 :type '(choice (const :tag "None" nil)
420 (const :tag "Undownloaded when unplugged" undownloaded)
421 (const :tag "Undownloaded" always-undownloaded)
422 (const :tag "Unfetched" unfetched)))
423
eec82323
LMI
424(defcustom gnus-summary-check-current nil
425 "*If non-nil, consider the current article when moving.
426The \"unread\" movement commands will stay on the same line if the
427current article is unread."
428 :group 'gnus-summary-maneuvering
429 :type 'boolean)
430
01c52d31 431(defcustom gnus-auto-center-summary 2
eec82323
LMI
432 "*If non-nil, always center the current summary buffer.
433In particular, if `vertical' do only vertical recentering. If non-nil
434and non-`vertical', do both horizontal and vertical recentering."
435 :group 'gnus-summary-maneuvering
436 :type '(choice (const :tag "none" nil)
437 (const vertical)
16409b0b 438 (integer :tag "height")
eec82323
LMI
439 (sexp :menu-tag "both" t)))
440
23f87bed
MB
441(defvar gnus-auto-center-group t
442 "*If non-nil, always center the group buffer.")
443
eec82323
LMI
444(defcustom gnus-show-all-headers nil
445 "*If non-nil, don't hide any headers."
446 :group 'gnus-article-hiding
447 :group 'gnus-article-headers
448 :type 'boolean)
449
450(defcustom gnus-summary-ignore-duplicates nil
451 "*If non-nil, ignore articles with identical Message-ID headers."
452 :group 'gnus-summary
453 :type 'boolean)
6748645f 454
eec82323
LMI
455(defcustom gnus-single-article-buffer t
456 "*If non-nil, display all articles in the same buffer.
457If nil, each group will get its own article buffer."
458 :group 'gnus-article-various
459 :type 'boolean)
460
461(defcustom gnus-break-pages t
462 "*If non-nil, do page breaking on articles.
463The page delimiter is specified by the `gnus-page-delimiter'
464variable."
465 :group 'gnus-article-various
466 :type 'boolean)
467
eec82323
LMI
468(defcustom gnus-move-split-methods nil
469 "*Variable used to suggest where articles are to be moved to.
23f87bed
MB
470It uses the same syntax as the `gnus-split-methods' variable.
471However, whereas `gnus-split-methods' specifies file names as targets,
472this variable specifies group names."
eec82323 473 :group 'gnus-summary-mail
6748645f
LMI
474 :type '(repeat (choice (list :value (fun) function)
475 (cons :value ("" "") regexp (repeat string))
476 (sexp :value nil))))
eec82323 477
01c52d31
MB
478(defcustom gnus-move-group-prefix-function 'gnus-group-real-prefix
479 "Function used to compute default prefix for article move/copy/etc prompts.
480The function should take one argument, a group name, and return a
481string with the suggested prefix."
482 :group 'gnus-summary-mail
483 :type 'function)
484
e62e7654
MB
485;; FIXME: Although the custom type is `character' for the following variables,
486;; using multibyte characters (Latin-1, UTF-8) doesn't work. -- rs
487
23f87bed 488(defcustom gnus-unread-mark ? ;Whitespace
eec82323
LMI
489 "*Mark used for unread articles."
490 :group 'gnus-summary-marks
491 :type 'character)
492
493(defcustom gnus-ticked-mark ?!
494 "*Mark used for ticked articles."
495 :group 'gnus-summary-marks
496 :type 'character)
497
498(defcustom gnus-dormant-mark ??
499 "*Mark used for dormant articles."
500 :group 'gnus-summary-marks
501 :type 'character)
502
503(defcustom gnus-del-mark ?r
504 "*Mark used for del'd articles."
505 :group 'gnus-summary-marks
506 :type 'character)
507
508(defcustom gnus-read-mark ?R
509 "*Mark used for read articles."
510 :group 'gnus-summary-marks
511 :type 'character)
512
513(defcustom gnus-expirable-mark ?E
514 "*Mark used for expirable articles."
515 :group 'gnus-summary-marks
516 :type 'character)
517
518(defcustom gnus-killed-mark ?K
519 "*Mark used for killed articles."
520 :group 'gnus-summary-marks
521 :type 'character)
522
23f87bed
MB
523(defcustom gnus-spam-mark ?$
524 "*Mark used for spam articles."
bf247b6e 525 :version "22.1"
23f87bed
MB
526 :group 'gnus-summary-marks
527 :type 'character)
528
eec82323 529(defcustom gnus-souped-mark ?F
23f87bed 530 "*Mark used for souped articles."
eec82323
LMI
531 :group 'gnus-summary-marks
532 :type 'character)
533
534(defcustom gnus-kill-file-mark ?X
535 "*Mark used for articles killed by kill files."
536 :group 'gnus-summary-marks
537 :type 'character)
538
539(defcustom gnus-low-score-mark ?Y
540 "*Mark used for articles with a low score."
541 :group 'gnus-summary-marks
542 :type 'character)
543
544(defcustom gnus-catchup-mark ?C
545 "*Mark used for articles that are caught up."
546 :group 'gnus-summary-marks
547 :type 'character)
548
549(defcustom gnus-replied-mark ?A
550 "*Mark used for articles that have been replied to."
551 :group 'gnus-summary-marks
552 :type 'character)
553
23f87bed
MB
554(defcustom gnus-forwarded-mark ?F
555 "*Mark used for articles that have been forwarded."
bf247b6e 556 :version "22.1"
23f87bed
MB
557 :group 'gnus-summary-marks
558 :type 'character)
559
560(defcustom gnus-recent-mark ?N
561 "*Mark used for articles that are recent."
bf247b6e 562 :version "22.1"
23f87bed
MB
563 :group 'gnus-summary-marks
564 :type 'character)
565
eec82323
LMI
566(defcustom gnus-cached-mark ?*
567 "*Mark used for articles that are in the cache."
568 :group 'gnus-summary-marks
569 :type 'character)
570
571(defcustom gnus-saved-mark ?S
23f87bed
MB
572 "*Mark used for articles that have been saved."
573 :group 'gnus-summary-marks
574 :type 'character)
575
576(defcustom gnus-unseen-mark ?.
577 "*Mark used for articles that haven't been seen."
bf247b6e 578 :version "22.1"
23f87bed
MB
579 :group 'gnus-summary-marks
580 :type 'character)
581
582(defcustom gnus-no-mark ? ;Whitespace
583 "*Mark used for articles that have no other secondary mark."
bf247b6e 584 :version "22.1"
eec82323
LMI
585 :group 'gnus-summary-marks
586 :type 'character)
587
588(defcustom gnus-ancient-mark ?O
589 "*Mark used for ancient articles."
590 :group 'gnus-summary-marks
591 :type 'character)
592
593(defcustom gnus-sparse-mark ?Q
594 "*Mark used for sparsely reffed articles."
595 :group 'gnus-summary-marks
596 :type 'character)
597
598(defcustom gnus-canceled-mark ?G
599 "*Mark used for canceled articles."
600 :group 'gnus-summary-marks
601 :type 'character)
602
603(defcustom gnus-duplicate-mark ?M
604 "*Mark used for duplicate articles."
605 :group 'gnus-summary-marks
606 :type 'character)
607
23f87bed 608(defcustom gnus-undownloaded-mark ?-
6748645f 609 "*Mark used for articles that weren't downloaded."
bf247b6e 610 :version "22.1"
6748645f
LMI
611 :group 'gnus-summary-marks
612 :type 'character)
613
23f87bed
MB
614(defcustom gnus-downloaded-mark ?+
615 "*Mark used for articles that were downloaded."
616 :group 'gnus-summary-marks
617 :type 'character)
618
6748645f
LMI
619(defcustom gnus-downloadable-mark ?%
620 "*Mark used for articles that are to be downloaded."
621 :group 'gnus-summary-marks
622 :type 'character)
623
624(defcustom gnus-unsendable-mark ?=
625 "*Mark used for articles that won't be sent."
626 :group 'gnus-summary-marks
627 :type 'character)
628
eec82323
LMI
629(defcustom gnus-score-over-mark ?+
630 "*Score mark used for articles with high scores."
631 :group 'gnus-summary-marks
632 :type 'character)
633
634(defcustom gnus-score-below-mark ?-
635 "*Score mark used for articles with low scores."
636 :group 'gnus-summary-marks
637 :type 'character)
638
23f87bed 639(defcustom gnus-empty-thread-mark ? ;Whitespace
eec82323
LMI
640 "*There is no thread under the article."
641 :group 'gnus-summary-marks
642 :type 'character)
643
644(defcustom gnus-not-empty-thread-mark ?=
645 "*There is a thread under the article."
646 :group 'gnus-summary-marks
647 :type 'character)
648
649(defcustom gnus-view-pseudo-asynchronously nil
650 "*If non-nil, Gnus will view pseudo-articles asynchronously."
651 :group 'gnus-extract-view
652 :type 'boolean)
653
16409b0b
GM
654(defcustom gnus-auto-expirable-marks
655 (list gnus-killed-mark gnus-del-mark gnus-catchup-mark
656 gnus-low-score-mark gnus-ancient-mark gnus-read-mark
657 gnus-souped-mark gnus-duplicate-mark)
658 "*The list of marks converted into expiration if a group is auto-expirable."
58e39d05 659 :version "21.1"
16409b0b
GM
660 :group 'gnus-summary
661 :type '(repeat character))
662
663(defcustom gnus-inhibit-user-auto-expire t
664 "*If non-nil, user marking commands will not mark an article as expirable, even if the group has auto-expire turned on."
58e39d05 665 :version "21.1"
16409b0b
GM
666 :group 'gnus-summary
667 :type 'boolean)
668
eec82323
LMI
669(defcustom gnus-view-pseudos nil
670 "*If `automatic', pseudo-articles will be viewed automatically.
671If `not-confirm', pseudos will be viewed automatically, and the user
672will not be asked to confirm the command."
673 :group 'gnus-extract-view
674 :type '(choice (const :tag "off" nil)
675 (const automatic)
676 (const not-confirm)))
677
678(defcustom gnus-view-pseudos-separately t
679 "*If non-nil, one pseudo-article will be created for each file to be viewed.
680If nil, all files that use the same viewing command will be given as a
681list of parameters to that command."
682 :group 'gnus-extract-view
683 :type 'boolean)
684
685(defcustom gnus-insert-pseudo-articles t
686 "*If non-nil, insert pseudo-articles when decoding articles."
687 :group 'gnus-extract-view
688 :type 'boolean)
689
690(defcustom gnus-summary-dummy-line-format
23f87bed 691 " %(: :%) %S\n"
eec82323
LMI
692 "*The format specification for the dummy roots in the summary buffer.
693It works along the same lines as a normal formatting string,
694with some simple extensions.
695
23f87bed
MB
696%S The subject
697
698General format specifiers can also be used.
699See `(gnus)Formatting Variables'."
700 :link '(custom-manual "(gnus)Formatting Variables")
eec82323
LMI
701 :group 'gnus-threading
702 :type 'string)
703
16409b0b 704(defcustom gnus-summary-mode-line-format "Gnus: %g [%A] %Z"
eec82323
LMI
705 "*The format specification for the summary mode line.
706It works along the same lines as a normal formatting string,
707with some simple extensions:
708
709%G Group name
710%p Unprefixed group name
711%A Current article number
6748645f 712%z Current article score
eec82323
LMI
713%V Gnus version
714%U Number of unread articles in the group
715%e Number of unselected articles in the group
716%Z A string with unread/unselected article counts
717%g Shortish group name
718%S Subject of the current article
719%u User-defined spec
720%s Current score file name
721%d Number of dormant articles
722%r Number of articles that have been marked as read in this session
723%E Number of articles expunged by the score files"
724 :group 'gnus-summary-format
725 :type 'string)
726
16409b0b
GM
727(defcustom gnus-list-identifiers nil
728 "Regexp that matches list identifiers to be removed from subject.
729This can also be a list of regexps."
58e39d05 730 :version "21.1"
16409b0b
GM
731 :group 'gnus-summary-format
732 :group 'gnus-article-hiding
733 :type '(choice (const :tag "none" nil)
734 (regexp :value ".*")
735 (repeat :value (".*") regexp)))
736
eec82323
LMI
737(defcustom gnus-summary-mark-below 0
738 "*Mark all articles with a score below this variable as read.
739This variable is local to each summary buffer and usually set by the
740score file."
741 :group 'gnus-score-default
742 :type 'integer)
743
01c52d31
MB
744(defun gnus-widget-reversible-match (widget value)
745 "Ignoring WIDGET, convert VALUE to internal form.
746VALUE should have the form `FOO' or `(not FOO)', where FOO is an symbol."
747 ;; (debug value)
748 (or (symbolp value)
749 (and (listp value)
750 (eq (length value) 2)
751 (eq (nth 0 value) 'not)
752 (symbolp (nth 1 value)))))
753
754(defun gnus-widget-reversible-to-internal (widget value)
755 "Ignoring WIDGET, convert VALUE to internal form.
756VALUE should have the form `FOO' or `(not FOO)', where FOO is an atom.
757FOO is converted to (FOO nil) and (not FOO) is converted to (FOO t)."
758 ;; (debug value)
759 (if (atom value)
760 (list value nil)
761 (list (nth 1 value) t)))
762
763(defun gnus-widget-reversible-to-external (widget value)
764 "Ignoring WIDGET, convert VALUE to external form.
765VALUE should have the form `(FOO nil)' or `(FOO t)', where FOO is an atom.
766\(FOO nil) is converted to FOO and (FOO t) is converted to (not FOO)."
767 ;; (debug value)
768 (if (nth 1 value)
769 (list 'not (nth 0 value))
770 (nth 0 value)))
771
772(define-widget 'gnus-widget-reversible 'group
773 "A `group' that convert values."
774 :match 'gnus-widget-reversible-match
775 :value-to-internal 'gnus-widget-reversible-to-internal
776 :value-to-external 'gnus-widget-reversible-to-external)
777
eec82323
LMI
778(defcustom gnus-article-sort-functions '(gnus-article-sort-by-number)
779 "*List of functions used for sorting articles in the summary buffer.
23f87bed
MB
780
781Each function takes two articles and returns non-nil if the first
782article should be sorted before the other. If you use more than one
783function, the primary sort function should be the last. You should
784probably always include `gnus-article-sort-by-number' in the list of
785sorting functions -- preferably first. Also note that sorting by date
786is often much slower than sorting by number, and the sorting order is
787very similar. (Sorting by date means sorting by the time the message
788was sent, sorting by number means sorting by arrival time.)
789
01c52d31
MB
790Each item can also be a list `(not F)' where F is a function;
791this reverses the sort order.
792
23f87bed
MB
793Ready-made functions include `gnus-article-sort-by-number',
794`gnus-article-sort-by-author', `gnus-article-sort-by-subject',
795`gnus-article-sort-by-date', `gnus-article-sort-by-random'
796and `gnus-article-sort-by-score'.
797
798When threading is turned on, the variable `gnus-thread-sort-functions'
799controls how articles are sorted."
eec82323 800 :group 'gnus-summary-sort
01c52d31
MB
801 :type '(repeat (gnus-widget-reversible
802 (choice (function-item gnus-article-sort-by-number)
803 (function-item gnus-article-sort-by-author)
804 (function-item gnus-article-sort-by-subject)
805 (function-item gnus-article-sort-by-date)
806 (function-item gnus-article-sort-by-score)
807 (function-item gnus-article-sort-by-random)
808 (function :tag "other"))
809 (boolean :tag "Reverse order"))))
810
eec82323
LMI
811
812(defcustom gnus-thread-sort-functions '(gnus-thread-sort-by-number)
813 "*List of functions used for sorting threads in the summary buffer.
814By default, threads are sorted by article number.
815
23f87bed
MB
816Each function takes two threads and returns non-nil if the first
817thread should be sorted before the other. If you use more than one
818function, the primary sort function should be the last. You should
819probably always include `gnus-thread-sort-by-number' in the list of
820sorting functions -- preferably first. Also note that sorting by date
821is often much slower than sorting by number, and the sorting order is
822very similar. (Sorting by date means sorting by the time the message
823was sent, sorting by number means sorting by arrival time.)
eec82323 824
01c52d31
MB
825Each list item can also be a list `(not F)' where F is a
826function; this specifies reversed sort order.
827
eec82323 828Ready-made functions include `gnus-thread-sort-by-number',
01c52d31
MB
829`gnus-thread-sort-by-author', `gnus-thread-sort-by-recipient'
830`gnus-thread-sort-by-subject', `gnus-thread-sort-by-date',
831`gnus-thread-sort-by-score', `gnus-thread-sort-by-most-recent-number',
832`gnus-thread-sort-by-most-recent-date', `gnus-thread-sort-by-random',
833and `gnus-thread-sort-by-total-score' (see
834`gnus-thread-score-function').
23f87bed
MB
835
836When threading is turned off, the variable
837`gnus-article-sort-functions' controls how articles are sorted."
eec82323 838 :group 'gnus-summary-sort
01c52d31
MB
839 :type '(repeat
840 (gnus-widget-reversible
841 (choice (function-item gnus-thread-sort-by-number)
842 (function-item gnus-thread-sort-by-author)
843 (function-item gnus-thread-sort-by-recipient)
844 (function-item gnus-thread-sort-by-subject)
845 (function-item gnus-thread-sort-by-date)
846 (function-item gnus-thread-sort-by-score)
847 (function-item gnus-thread-sort-by-most-recent-number)
848 (function-item gnus-thread-sort-by-most-recent-date)
849 (function-item gnus-thread-sort-by-random)
850 (function-item gnus-thread-sort-by-total-score)
851 (function :tag "other"))
852 (boolean :tag "Reverse order"))))
eec82323
LMI
853
854(defcustom gnus-thread-score-function '+
855 "*Function used for calculating the total score of a thread.
856
857The function is called with the scores of the article and each
858subthread and should then return the score of the thread.
859
860Some functions you can use are `+', `max', or `min'."
861 :group 'gnus-summary-sort
862 :type 'function)
863
864(defcustom gnus-summary-expunge-below nil
6748645f
LMI
865 "All articles that have a score less than this variable will be expunged.
866This variable is local to the summary buffers."
eec82323
LMI
867 :group 'gnus-score-default
868 :type '(choice (const :tag "off" nil)
869 integer))
870
871(defcustom gnus-thread-expunge-below nil
872 "All threads that have a total score less than this variable will be expunged.
873See `gnus-thread-score-function' for en explanation of what a
6748645f
LMI
874\"thread score\" is.
875
876This variable is local to the summary buffers."
16409b0b 877 :group 'gnus-threading
eec82323
LMI
878 :group 'gnus-score-default
879 :type '(choice (const :tag "off" nil)
880 integer))
881
882(defcustom gnus-summary-mode-hook nil
883 "*A hook for Gnus summary mode.
884This hook is run before any variables are set in the summary buffer."
23f87bed 885 :options '(turn-on-gnus-mailing-list-mode gnus-pick-mode)
eec82323
LMI
886 :group 'gnus-summary-various
887 :type 'hook)
888
23f87bed
MB
889;; Extracted from gnus-xmas-redefine in order to preserve user settings
890(when (featurep 'xemacs)
891 (add-hook 'gnus-summary-mode-hook 'gnus-xmas-summary-menu-add)
892 (add-hook 'gnus-summary-mode-hook 'gnus-xmas-setup-summary-toolbar)
893 (add-hook 'gnus-summary-mode-hook
894 'gnus-xmas-switch-horizontal-scrollbar-off))
895
eec82323
LMI
896(defcustom gnus-summary-menu-hook nil
897 "*Hook run after the creation of the summary mode menu."
898 :group 'gnus-summary-visual
899 :type 'hook)
900
901(defcustom gnus-summary-exit-hook nil
902 "*A hook called on exit from the summary buffer.
903It will be called with point in the group buffer."
904 :group 'gnus-summary-exit
905 :type 'hook)
906
907(defcustom gnus-summary-prepare-hook nil
908 "*A hook called after the summary buffer has been generated.
909If you want to modify the summary buffer, you can use this hook."
910 :group 'gnus-summary-various
911 :type 'hook)
912
6748645f
LMI
913(defcustom gnus-summary-prepared-hook nil
914 "*A hook called as the last thing after the summary buffer has been generated."
915 :group 'gnus-summary-various
916 :type 'hook)
917
eec82323
LMI
918(defcustom gnus-summary-generate-hook nil
919 "*A hook run just before generating the summary buffer.
920This hook is commonly used to customize threading variables and the
921like."
922 :group 'gnus-summary-various
923 :type 'hook)
924
925(defcustom gnus-select-group-hook nil
926 "*A hook called when a newsgroup is selected.
927
928If you'd like to simplify subjects like the
929`gnus-summary-next-same-subject' command does, you can use the
930following hook:
931
23f87bed
MB
932 (add-hook gnus-select-group-hook
933 (lambda ()
934 (mapcar (lambda (header)
935 (mail-header-set-subject
936 header
937 (gnus-simplify-subject
938 (mail-header-subject header) 're-only)))
939 gnus-newsgroup-headers)))"
eec82323
LMI
940 :group 'gnus-group-select
941 :type 'hook)
942
943(defcustom gnus-select-article-hook nil
944 "*A hook called when an article is selected."
945 :group 'gnus-summary-choose
23f87bed 946 :options '(gnus-agent-fetch-selected-article)
eec82323
LMI
947 :type 'hook)
948
949(defcustom gnus-visual-mark-article-hook
950 (list 'gnus-highlight-selected-summary)
951 "*Hook run after selecting an article in the summary buffer.
952It is meant to be used for highlighting the article in some way. It
953is not run if `gnus-visual' is nil."
954 :group 'gnus-summary-visual
955 :type 'hook)
956
16409b0b 957(defcustom gnus-parse-headers-hook nil
eec82323
LMI
958 "*A hook called before parsing the headers."
959 :group 'gnus-various
960 :type 'hook)
961
962(defcustom gnus-exit-group-hook nil
16409b0b
GM
963 "*A hook called when exiting summary mode.
964This hook is not called from the non-updating exit commands like `Q'."
eec82323
LMI
965 :group 'gnus-various
966 :type 'hook)
967
968(defcustom gnus-summary-update-hook
969 (list 'gnus-summary-highlight-line)
970 "*A hook called when a summary line is changed.
971The hook will not be called if `gnus-visual' is nil.
972
973The default function `gnus-summary-highlight-line' will
974highlight the line according to the `gnus-summary-highlight'
975variable."
976 :group 'gnus-summary-visual
977 :type 'hook)
978
979(defcustom gnus-mark-article-hook '(gnus-summary-mark-read-and-unread-as-read)
980 "*A hook called when an article is selected for the first time.
981The hook is intended to mark an article as read (or unread)
982automatically when it is selected."
983 :group 'gnus-summary-choose
984 :type 'hook)
985
986(defcustom gnus-group-no-more-groups-hook nil
987 "*A hook run when returning to group mode having no more (unread) groups."
988 :group 'gnus-group-select
989 :type 'hook)
990
991(defcustom gnus-ps-print-hook nil
992 "*A hook run before ps-printing something from Gnus."
993 :group 'gnus-summary
994 :type 'hook)
995
23f87bed
MB
996(defcustom gnus-summary-article-move-hook nil
997 "*A hook called after an article is moved, copied, respooled, or crossposted."
bf247b6e 998 :version "22.1"
23f87bed
MB
999 :group 'gnus-summary
1000 :type 'hook)
1001
1002(defcustom gnus-summary-article-delete-hook nil
1003 "*A hook called after an article is deleted."
bf247b6e 1004 :version "22.1"
23f87bed
MB
1005 :group 'gnus-summary
1006 :type 'hook)
1007
1008(defcustom gnus-summary-article-expire-hook nil
1009 "*A hook called after an article is expired."
bf247b6e 1010 :version "22.1"
23f87bed
MB
1011 :group 'gnus-summary
1012 :type 'hook)
1013
1014(defcustom gnus-summary-display-arrow
1015 (and (fboundp 'display-graphic-p)
1016 (display-graphic-p))
1017 "*If non-nil, display an arrow highlighting the current article."
bf247b6e 1018 :version "22.1"
23f87bed
MB
1019 :group 'gnus-summary
1020 :type 'boolean)
1021
0f49874b 1022(defcustom gnus-summary-selected-face 'gnus-summary-selected
eec82323
LMI
1023 "Face used for highlighting the current article in the summary buffer."
1024 :group 'gnus-summary-visual
1025 :type 'face)
1026
23f87bed
MB
1027(defvar gnus-tmp-downloaded nil)
1028
eec82323 1029(defcustom gnus-summary-highlight
23f87bed 1030 '(((eq mark gnus-canceled-mark)
0f49874b 1031 . gnus-summary-cancelled)
23f87bed 1032 ((and uncached (> score default-high))
0f49874b 1033 . gnus-summary-high-undownloaded)
23f87bed 1034 ((and uncached (< score default-low))
0f49874b 1035 . gnus-summary-low-undownloaded)
23f87bed 1036 (uncached
0f49874b 1037 . gnus-summary-normal-undownloaded)
23f87bed
MB
1038 ((and (> score default-high)
1039 (or (eq mark gnus-dormant-mark)
1040 (eq mark gnus-ticked-mark)))
0f49874b 1041 . gnus-summary-high-ticked)
23f87bed
MB
1042 ((and (< score default-low)
1043 (or (eq mark gnus-dormant-mark)
1044 (eq mark gnus-ticked-mark)))
0f49874b 1045 . gnus-summary-low-ticked)
23f87bed
MB
1046 ((or (eq mark gnus-dormant-mark)
1047 (eq mark gnus-ticked-mark))
0f49874b 1048 . gnus-summary-normal-ticked)
23f87bed 1049 ((and (> score default-high) (eq mark gnus-ancient-mark))
0f49874b 1050 . gnus-summary-high-ancient)
23f87bed 1051 ((and (< score default-low) (eq mark gnus-ancient-mark))
0f49874b 1052 . gnus-summary-low-ancient)
23f87bed 1053 ((eq mark gnus-ancient-mark)
0f49874b 1054 . gnus-summary-normal-ancient)
23f87bed 1055 ((and (> score default-high) (eq mark gnus-unread-mark))
0f49874b 1056 . gnus-summary-high-unread)
23f87bed 1057 ((and (< score default-low) (eq mark gnus-unread-mark))
0f49874b 1058 . gnus-summary-low-unread)
23f87bed 1059 ((eq mark gnus-unread-mark)
0f49874b 1060 . gnus-summary-normal-unread)
23f87bed 1061 ((> score default-high)
0f49874b 1062 . gnus-summary-high-read)
23f87bed 1063 ((< score default-low)
0f49874b 1064 . gnus-summary-low-read)
eec82323 1065 (t
0f49874b 1066 . gnus-summary-normal-read))
6748645f 1067 "*Controls the highlighting of summary buffer lines.
eec82323 1068
107cf8ec 1069A list of (FORM . FACE) pairs. When deciding how a particular
23f87bed
MB
1070summary line should be displayed, each form is evaluated. The content
1071of the face field after the first true form is used. You can change
1072how those summary lines are displayed, by editing the face field.
eec82323
LMI
1073
1074You can use the following variables in the FORM field.
1075
107cf8ec 1076score: The article's score.
23f87bed
MB
1077default: The default article score.
1078default-high: The default score for high scored articles.
1079default-low: The default score for low scored articles.
1080below: The score below which articles are automatically marked as read.
1081mark: The article's mark.
1082uncached: Non-nil if the article is uncached."
eec82323
LMI
1083 :group 'gnus-summary-visual
1084 :type '(repeat (cons (sexp :tag "Form" nil)
1085 face)))
c12ecb0a 1086(put 'gnus-summary-highlight 'risky-local-variable t)
eec82323 1087
6748645f
LMI
1088(defcustom gnus-alter-header-function nil
1089 "Function called to allow alteration of article header structures.
1090The function is called with one parameter, the article header vector,
0ab0f2d3
SZ
1091which it may alter in any way."
1092 :type '(choice (const :tag "None" nil)
1093 function)
1094 :group 'gnus-summary)
eec82323 1095
16409b0b 1096(defvar gnus-decode-encoded-word-function 'mail-decode-encoded-word-string
343d6628
MB
1097 "Function used to decode a string with encoded words.")
1098
1099(defvar gnus-decode-encoded-address-function
1100 'mail-decode-encoded-address-string
1101 "Function used to decode addresses with encoded words.")
16409b0b 1102
23f87bed 1103(defcustom gnus-extra-headers '(To Newsgroups)
16409b0b 1104 "*Extra headers to parse."
58e39d05 1105 :version "21.1"
16409b0b
GM
1106 :group 'gnus-summary
1107 :type '(repeat symbol))
1108
1109(defcustom gnus-ignored-from-addresses
343d6628 1110 (and user-mail-address
7cd9f860
CY
1111 (not (string= user-mail-address ""))
1112 (regexp-quote user-mail-address))
01c52d31
MB
1113 "*From headers that may be suppressed in favor of To headers.
1114This can be a regexp or a list of regexps."
58e39d05 1115 :version "21.1"
16409b0b 1116 :group 'gnus-summary
01c52d31
MB
1117 :type '(choice regexp
1118 (repeat :tag "Regexp List" regexp)))
1119
1120(defsubst gnus-ignored-from-addresses ()
1121 (gmm-regexp-concat gnus-ignored-from-addresses))
1122
1123(defcustom gnus-summary-to-prefix "-> "
1124 "*String prefixed to the To field in the summary line when
1125using `gnus-ignored-from-addresses'."
1126 :version "22.1"
1127 :group 'gnus-summary
1128 :type 'string)
1129
1130(defcustom gnus-summary-newsgroup-prefix "=> "
1131 "*String prefixed to the Newsgroup field in the summary
1132line when using `gnus-ignored-from-addresses'."
1133 :version "22.1"
1134 :group 'gnus-summary
1135 :type 'string)
16409b0b 1136
16409b0b
GM
1137(defcustom gnus-newsgroup-ignored-charsets '(unknown-8bit x-unknown)
1138 "List of charsets that should be ignored.
1139When these charsets are used in the \"charset\" parameter, the
1140default charset will be used instead."
58e39d05 1141 :version "21.1"
16409b0b
GM
1142 :type '(repeat symbol)
1143 :group 'gnus-charset)
1144
4b70e299
MB
1145(defcustom gnus-newsgroup-maximum-articles nil
1146 "The maximum number of articles a newsgroup.
1147If this is a number, old articles in a newsgroup exceeding this number
1148are silently ignored. If it is nil, no article is ignored. Note that
1149setting this variable to a number might prevent you from reading very
1150old articles."
1151 :group 'gnus-group-select
1152 :version "22.2"
1153 :type '(choice (const :tag "No limit" nil)
1154 integer))
1155
23f87bed
MB
1156(gnus-define-group-parameter
1157 ignored-charsets
1158 :type list
1159 :function-document
1160 "Return the ignored charsets of GROUP."
1161 :variable gnus-group-ignored-charsets-alist
1162 :variable-default
1163 '(("alt\\.chinese\\.text" iso-8859-1))
1164 :variable-document
1165 "Alist of regexps (to match group names) and charsets that should be ignored.
16409b0b
GM
1166When these charsets are used in the \"charset\" parameter, the
1167default charset will be used instead."
23f87bed
MB
1168 :variable-group gnus-charset
1169 :variable-type '(repeat (cons (regexp :tag "Group")
1170 (repeat symbol)))
1171 :parameter-type '(choice :tag "Ignored charsets"
1172 :value nil
1173 (repeat (symbol)))
1174 :parameter-document "\
1175List of charsets that should be ignored.
1176
1177When these charsets are used in the \"charset\" parameter, the
1178default charset will be used instead.")
16409b0b
GM
1179
1180(defcustom gnus-group-highlight-words-alist nil
1181 "Alist of group regexps and highlight regexps.
1182This variable uses the same syntax as `gnus-emphasis-alist'."
58e39d05 1183 :version "21.1"
16409b0b
GM
1184 :type '(repeat (cons (regexp :tag "Group")
1185 (repeat (list (regexp :tag "Highlight regexp")
1186 (number :tag "Group for entire word" 0)
1187 (number :tag "Group for displayed part" 0)
1188 (symbol :tag "Face"
1189 gnus-emphasis-highlight-words)))))
1190 :group 'gnus-summary-visual)
1191
1192(defcustom gnus-summary-show-article-charset-alist
1193 nil
1194 "Alist of number and charset.
1195The article will be shown with the charset corresponding to the
1196numbered argument.
1197For example: ((1 . cn-gb-2312) (2 . big5))."
58e39d05 1198 :version "21.1"
16409b0b
GM
1199 :type '(repeat (cons (number :tag "Argument" 1)
1200 (symbol :tag "Charset")))
1201 :group 'gnus-charset)
1202
1203(defcustom gnus-preserve-marks t
1204 "Whether marks are preserved when moving, copying and respooling messages."
58e39d05 1205 :version "21.1"
16409b0b
GM
1206 :type 'boolean
1207 :group 'gnus-summary-marks)
1208
3a23a519
MB
1209(defcustom gnus-propagate-marks t
1210 "If non-nil, do not propagate marks to the backends."
f8a29505 1211 :version "23.1" ;; No Gnus
3a23a519
MB
1212 :type 'boolean
1213 :group 'gnus-summary-marks)
1214
16409b0b
GM
1215(defcustom gnus-alter-articles-to-read-function nil
1216 "Function to be called to alter the list of articles to be selected."
8fc7a9a1 1217 :type '(choice (const nil) function)
16409b0b
GM
1218 :group 'gnus-summary)
1219
1220(defcustom gnus-orphan-score nil
1221 "*All orphans get this score added. Set in the score file."
1222 :group 'gnus-score-default
1223 :type '(choice (const nil)
1224 integer))
1225
8b93df01 1226(defcustom gnus-summary-save-parts-default-mime "image/.*"
23f87bed
MB
1227 "*A regexp to match MIME parts when saving multiple parts of a
1228message with `gnus-summary-save-parts' (\\<gnus-summary-mode-map>\\[gnus-summary-save-parts]).
1229This regexp will be used by default when prompting the user for which
1230type of files to save."
8b93df01
DL
1231 :group 'gnus-summary
1232 :type 'regexp)
1233
23f87bed
MB
1234(defcustom gnus-read-all-available-headers nil
1235 "Whether Gnus should parse all headers made available to it.
1236This is mostly relevant for slow back ends where the user may
1237wish to widen the summary buffer to include all headers
1238that were fetched. Say, for nnultimate groups."
bf247b6e 1239 :version "22.1"
23f87bed
MB
1240 :group 'gnus-summary
1241 :type '(choice boolean regexp))
1242
1243(defcustom gnus-summary-muttprint-program "muttprint"
1244 "Command (and optional arguments) used to run Muttprint."
bf247b6e 1245 :version "22.1"
23f87bed
MB
1246 :group 'gnus-summary
1247 :type 'string)
1248
01c52d31 1249(defcustom gnus-article-loose-mime t
23f87bed
MB
1250 "If non-nil, don't require MIME-Version header.
1251Some brain-damaged MUA/MTA, e.g. Lotus Domino 5.0.6 clients, does not
a08b59c9 1252supply the MIME-Version header or deliberately strip it from the mail.
01c52d31
MB
1253If non-nil (the default), Gnus will treat some articles as MIME
1254even if the MIME-Version header is missing."
bf247b6e 1255 :version "22.1"
23f87bed
MB
1256 :type 'boolean
1257 :group 'gnus-article-mime)
1258
1259(defcustom gnus-article-emulate-mime t
1260 "If non-nil, use MIME emulation for uuencode and the like.
1261This means that Gnus will search message bodies for text that look
1262like uuencoded bits, yEncoded bits, and so on, and present that using
1263the normal Gnus MIME machinery."
bf247b6e 1264 :version "22.1"
23f87bed
MB
1265 :type 'boolean
1266 :group 'gnus-article-mime)
8b93df01 1267
eec82323
LMI
1268;;; Internal variables
1269
23f87bed 1270(defvar gnus-summary-display-cache nil)
16409b0b
GM
1271(defvar gnus-article-mime-handles nil)
1272(defvar gnus-article-decoded-p nil)
23f87bed
MB
1273(defvar gnus-article-charset nil)
1274(defvar gnus-article-ignored-charsets nil)
eec82323
LMI
1275(defvar gnus-scores-exclude-files nil)
1276(defvar gnus-page-broken nil)
1277
1278(defvar gnus-original-article nil)
1279(defvar gnus-article-internal-prepare-hook nil)
1280(defvar gnus-newsgroup-process-stack nil)
1281
1282(defvar gnus-thread-indent-array nil)
1283(defvar gnus-thread-indent-array-level gnus-thread-indent-level)
16409b0b
GM
1284(defvar gnus-sort-gathered-threads-function 'gnus-thread-sort-by-number
1285 "Function called to sort the articles within a thread after it has been gathered together.")
eec82323 1286
8b93df01 1287(defvar gnus-summary-save-parts-type-history nil)
23f87bed 1288(defvar gnus-summary-save-parts-last-directory mm-default-directory)
8b93df01 1289
eec82323
LMI
1290;; Avoid highlighting in kill files.
1291(defvar gnus-summary-inhibit-highlight nil)
1292(defvar gnus-newsgroup-selected-overlay nil)
1293(defvar gnus-inhibit-limiting nil)
1294(defvar gnus-newsgroup-adaptive-score-file nil)
1295(defvar gnus-current-score-file nil)
1296(defvar gnus-current-move-group nil)
1297(defvar gnus-current-copy-group nil)
1298(defvar gnus-current-crosspost-group nil)
23f87bed 1299(defvar gnus-newsgroup-display nil)
eec82323
LMI
1300
1301(defvar gnus-newsgroup-dependencies nil)
1302(defvar gnus-newsgroup-adaptive nil)
1303(defvar gnus-summary-display-article-function nil)
1304(defvar gnus-summary-highlight-line-function nil
1305 "Function called after highlighting a summary line.")
1306
1307(defvar gnus-summary-line-format-alist
1308 `((?N ,(macroexpand '(mail-header-number gnus-tmp-header)) ?d)
1309 (?S ,(macroexpand '(mail-header-subject gnus-tmp-header)) ?s)
1310 (?s gnus-tmp-subject-or-nil ?s)
1311 (?n gnus-tmp-name ?s)
1312 (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from)))
1313 ?s)
1314 (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from))
1315 gnus-tmp-from) ?s)
1316 (?F gnus-tmp-from ?s)
1317 (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s)
1318 (?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s)
1319 (?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s)
6748645f 1320 (?o (gnus-date-iso8601 (mail-header-date gnus-tmp-header)) ?s)
eec82323
LMI
1321 (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s)
1322 (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s)
1323 (?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
23f87bed
MB
1324 (?k (gnus-summary-line-message-size gnus-tmp-header) ?s)
1325 (?L gnus-tmp-lines ?s)
1326 (?O gnus-tmp-downloaded ?c)
eec82323
LMI
1327 (?I gnus-tmp-indentation ?s)
1328 (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
1329 (?R gnus-tmp-replied ?c)
1330 (?\[ gnus-tmp-opening-bracket ?c)
1331 (?\] gnus-tmp-closing-bracket ?c)
1332 (?\> (make-string gnus-tmp-level ? ) ?s)
1333 (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s)
1334 (?i gnus-tmp-score ?d)
1335 (?z gnus-tmp-score-char ?c)
eec82323
LMI
1336 (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d)
1337 (?U gnus-tmp-unread ?c)
23f87bed
MB
1338 (?f (gnus-summary-from-or-to-or-newsgroups gnus-tmp-header gnus-tmp-from)
1339 ?s)
eec82323
LMI
1340 (?t (gnus-summary-number-of-articles-in-thread
1341 (and (boundp 'thread) (car thread)) gnus-tmp-level)
1342 ?d)
1343 (?e (gnus-summary-number-of-articles-in-thread
1344 (and (boundp 'thread) (car thread)) gnus-tmp-level t)
1345 ?c)
1346 (?u gnus-tmp-user-defined ?s)
23f87bed
MB
1347 (?P (gnus-pick-line-number) ?d)
1348 (?B gnus-tmp-thread-tree-header-string ?s)
1349 (user-date (gnus-user-date
1350 ,(macroexpand '(mail-header-date gnus-tmp-header))) ?s))
16409b0b
GM
1351 "An alist of format specifications that can appear in summary lines.
1352These are paired with what variables they correspond with, along with
1353the type of the variable (string, integer, character, etc).")
eec82323
LMI
1354
1355(defvar gnus-summary-dummy-line-format-alist
1356 `((?S gnus-tmp-subject ?s)
1357 (?N gnus-tmp-number ?d)
1358 (?u gnus-tmp-user-defined ?s)))
1359
1360(defvar gnus-summary-mode-line-format-alist
1361 `((?G gnus-tmp-group-name ?s)
1362 (?g (gnus-short-group-name gnus-tmp-group-name) ?s)
1363 (?p (gnus-group-real-name gnus-tmp-group-name) ?s)
1364 (?A gnus-tmp-article-number ?d)
1365 (?Z gnus-tmp-unread-and-unselected ?s)
1366 (?V gnus-version ?s)
1367 (?U gnus-tmp-unread-and-unticked ?d)
1368 (?S gnus-tmp-subject ?s)
1369 (?e gnus-tmp-unselected ?d)
1370 (?u gnus-tmp-user-defined ?s)
1371 (?d (length gnus-newsgroup-dormant) ?d)
1372 (?t (length gnus-newsgroup-marked) ?d)
23f87bed 1373 (?h (length gnus-newsgroup-spam-marked) ?d)
eec82323 1374 (?r (length gnus-newsgroup-reads) ?d)
6748645f 1375 (?z (gnus-summary-article-score gnus-tmp-article-number) ?d)
eec82323
LMI
1376 (?E gnus-newsgroup-expunged-tally ?d)
1377 (?s (gnus-current-score-file-nondirectory) ?s)))
1378
c1717fbd
GM
1379;; This is here rather than in gnus-art for compilation reasons.
1380(defvar gnus-article-mode-line-format-alist
1381 (nconc '((?w (gnus-article-wash-status) ?s)
1382 (?m (gnus-article-mime-part-status) ?s))
1383 gnus-summary-mode-line-format-alist))
1384
eec82323
LMI
1385(defvar gnus-last-search-regexp nil
1386 "Default regexp for article search command.")
1387
1388(defvar gnus-last-shell-command nil
1389 "Default shell command on article.")
1390
23f87bed
MB
1391(defvar gnus-newsgroup-agentized nil
1392 "Locally bound in each summary buffer to indicate whether the server has been agentized.")
eec82323
LMI
1393(defvar gnus-newsgroup-begin nil)
1394(defvar gnus-newsgroup-end nil)
1395(defvar gnus-newsgroup-last-rmail nil)
1396(defvar gnus-newsgroup-last-mail nil)
1397(defvar gnus-newsgroup-last-folder nil)
1398(defvar gnus-newsgroup-last-file nil)
26c9afc3 1399(defvar gnus-newsgroup-last-directory nil)
eec82323
LMI
1400(defvar gnus-newsgroup-auto-expire nil)
1401(defvar gnus-newsgroup-active nil)
1402
1403(defvar gnus-newsgroup-data nil)
1404(defvar gnus-newsgroup-data-reverse nil)
1405(defvar gnus-newsgroup-limit nil)
1406(defvar gnus-newsgroup-limits nil)
23f87bed 1407(defvar gnus-summary-use-undownloaded-faces nil)
eec82323
LMI
1408
1409(defvar gnus-newsgroup-unreads nil
23f87bed 1410 "Sorted list of unread articles in the current newsgroup.")
eec82323
LMI
1411
1412(defvar gnus-newsgroup-unselected nil
23f87bed 1413 "Sorted list of unselected unread articles in the current newsgroup.")
eec82323
LMI
1414
1415(defvar gnus-newsgroup-reads nil
1416 "Alist of read articles and article marks in the current newsgroup.")
1417
1418(defvar gnus-newsgroup-expunged-tally nil)
1419
1420(defvar gnus-newsgroup-marked nil
23f87bed
MB
1421 "Sorted list of ticked articles in the current newsgroup (a subset of unread art).")
1422
1423(defvar gnus-newsgroup-spam-marked nil
1424 "List of ranges of articles that have been marked as spam.")
eec82323
LMI
1425
1426(defvar gnus-newsgroup-killed nil
1427 "List of ranges of articles that have been through the scoring process.")
1428
1429(defvar gnus-newsgroup-cached nil
23f87bed 1430 "Sorted list of articles that come from the article cache.")
eec82323
LMI
1431
1432(defvar gnus-newsgroup-saved nil
1433 "List of articles that have been saved.")
1434
1435(defvar gnus-newsgroup-kill-headers nil)
1436
1437(defvar gnus-newsgroup-replied nil
1438 "List of articles that have been replied to in the current newsgroup.")
1439
23f87bed
MB
1440(defvar gnus-newsgroup-forwarded nil
1441 "List of articles that have been forwarded in the current newsgroup.")
1442
1443(defvar gnus-newsgroup-recent nil
1444 "List of articles that have are recent in the current newsgroup.")
1445
eec82323 1446(defvar gnus-newsgroup-expirable nil
23f87bed 1447 "Sorted list of articles in the current newsgroup that can be expired.")
eec82323
LMI
1448
1449(defvar gnus-newsgroup-processable nil
1450 "List of articles in the current newsgroup that can be processed.")
1451
6748645f 1452(defvar gnus-newsgroup-downloadable nil
23f87bed
MB
1453 "Sorted list of articles in the current newsgroup that can be processed.")
1454
1455(defvar gnus-newsgroup-unfetched nil
1456 "Sorted list of articles in the current newsgroup whose headers have
1457not been fetched into the agent.
1458
1459This list will always be a subset of gnus-newsgroup-undownloaded.")
6748645f
LMI
1460
1461(defvar gnus-newsgroup-undownloaded nil
23f87bed 1462 "List of articles in the current newsgroup that haven't been downloaded.")
6748645f
LMI
1463
1464(defvar gnus-newsgroup-unsendable nil
1465 "List of articles in the current newsgroup that won't be sent.")
1466
eec82323
LMI
1467(defvar gnus-newsgroup-bookmarks nil
1468 "List of articles in the current newsgroup that have bookmarks.")
1469
1470(defvar gnus-newsgroup-dormant nil
23f87bed
MB
1471 "Sorted list of dormant articles in the current newsgroup.")
1472
1473(defvar gnus-newsgroup-unseen nil
1474 "List of unseen articles in the current newsgroup.")
1475
1476(defvar gnus-newsgroup-seen nil
1477 "Range of seen articles in the current newsgroup.")
1478
1479(defvar gnus-newsgroup-articles nil
1480 "List of articles in the current newsgroup.")
eec82323
LMI
1481
1482(defvar gnus-newsgroup-scored nil
1483 "List of scored articles in the current newsgroup.")
1484
1485(defvar gnus-newsgroup-headers nil
1486 "List of article headers in the current newsgroup.")
1487
1488(defvar gnus-newsgroup-threads nil)
1489
1490(defvar gnus-newsgroup-prepared nil
1491 "Whether the current group has been prepared properly.")
1492
1493(defvar gnus-newsgroup-ancient nil
1494 "List of `gnus-fetch-old-headers' articles in the current newsgroup.")
1495
1496(defvar gnus-newsgroup-sparse nil)
1497
1498(defvar gnus-current-article nil)
1499(defvar gnus-article-current nil)
1500(defvar gnus-current-headers nil)
1501(defvar gnus-have-all-headers nil)
1502(defvar gnus-last-article nil)
1503(defvar gnus-newsgroup-history nil)
16409b0b
GM
1504(defvar gnus-newsgroup-charset nil)
1505(defvar gnus-newsgroup-ephemeral-charset nil)
1506(defvar gnus-newsgroup-ephemeral-ignored-charsets nil)
eec82323 1507
23f87bed
MB
1508(defvar gnus-article-before-search nil)
1509
1510(defvar gnus-summary-local-variables
eec82323
LMI
1511 '(gnus-newsgroup-name
1512 gnus-newsgroup-begin gnus-newsgroup-end
1513 gnus-newsgroup-last-rmail gnus-newsgroup-last-mail
1514 gnus-newsgroup-last-folder gnus-newsgroup-last-file
26c9afc3 1515 gnus-newsgroup-last-directory
eec82323
LMI
1516 gnus-newsgroup-auto-expire gnus-newsgroup-unreads
1517 gnus-newsgroup-unselected gnus-newsgroup-marked
23f87bed 1518 gnus-newsgroup-spam-marked
eec82323 1519 gnus-newsgroup-reads gnus-newsgroup-saved
23f87bed
MB
1520 gnus-newsgroup-replied gnus-newsgroup-forwarded
1521 gnus-newsgroup-recent
1522 gnus-newsgroup-expirable
eec82323 1523 gnus-newsgroup-processable gnus-newsgroup-killed
6748645f 1524 gnus-newsgroup-downloadable gnus-newsgroup-undownloaded
23f87bed
MB
1525 gnus-newsgroup-unfetched
1526 gnus-newsgroup-unsendable gnus-newsgroup-unseen
1527 gnus-newsgroup-seen gnus-newsgroup-articles
eec82323
LMI
1528 gnus-newsgroup-bookmarks gnus-newsgroup-dormant
1529 gnus-newsgroup-headers gnus-newsgroup-threads
1530 gnus-newsgroup-prepared gnus-summary-highlight-line-function
1531 gnus-current-article gnus-current-headers gnus-have-all-headers
1532 gnus-last-article gnus-article-internal-prepare-hook
1533 gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay
1534 gnus-newsgroup-scored gnus-newsgroup-kill-headers
1535 gnus-thread-expunge-below
16409b0b
GM
1536 gnus-score-alist gnus-current-score-file
1537 (gnus-summary-expunge-below . global)
eec82323 1538 (gnus-summary-mark-below . global)
16409b0b 1539 (gnus-orphan-score . global)
eec82323
LMI
1540 gnus-newsgroup-active gnus-scores-exclude-files
1541 gnus-newsgroup-history gnus-newsgroup-ancient
1542 gnus-newsgroup-sparse gnus-newsgroup-process-stack
1543 (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring)
1544 gnus-newsgroup-adaptive-score-file (gnus-reffed-article-number . -1)
1545 (gnus-newsgroup-expunged-tally . 0)
1546 gnus-cache-removable-articles gnus-newsgroup-cached
1547 gnus-newsgroup-data gnus-newsgroup-data-reverse
16409b0b 1548 gnus-newsgroup-limit gnus-newsgroup-limits
23f87bed
MB
1549 gnus-newsgroup-charset gnus-newsgroup-display
1550 gnus-summary-use-undownloaded-faces)
eec82323
LMI
1551 "Variables that are buffer-local to the summary buffers.")
1552
23f87bed
MB
1553(defvar gnus-newsgroup-variables nil
1554 "A list of variables that have separate values in different newsgroups.
1555A list of newsgroup (summary buffer) local variables, or cons of
1556variables and their default expressions to be evalled (when the default
1557values are not nil), that should be made global while the summary buffer
1558is active.
1559
1560Note: The default expressions will be evaluated (using function `eval')
1561before assignment to the local variable rather than just assigned to it.
1562If the default expression is the symbol `global', that symbol will not
1563be evaluated but the global value of the local variable will be used
1564instead.
1565
1566These variables can be used to set variables in the group parameters
1567while still allowing them to affect operations done in other buffers.
1568For example:
1569
1570\(setq gnus-newsgroup-variables
1571 '(message-use-followup-to
1572 (gnus-visible-headers .
1573 \"^From:\\\\|^Newsgroups:\\\\|^Subject:\\\\|^Date:\\\\|^To:\")))
1574")
1575
23f87bed
MB
1576(eval-when-compile
1577 ;; Bind features so that require will believe that gnus-sum has
1578 ;; already been loaded (avoids infinite recursion)
1579 (let ((features (cons 'gnus-sum features)))
23f87bed 1580 (require 'gnus-art)))
eec82323 1581
16409b0b
GM
1582;; MIME stuff.
1583
1584(defvar gnus-decode-encoded-word-methods
1585 '(mail-decode-encoded-word-string)
1586 "List of methods used to decode encoded words.
1587
23f87bed
MB
1588This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item
1589is FUNCTION, FUNCTION will be apply to all newsgroups. If item is a
1590\(REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups
16409b0b
GM
1591whose names match REGEXP.
1592
1593For example:
23f87bed 1594\((\"chinese\" . gnus-decode-encoded-word-string-by-guess)
16409b0b
GM
1595 mail-decode-encoded-word-string
1596 (\"chinese\" . rfc1843-decode-string))")
1597
1598(defvar gnus-decode-encoded-word-methods-cache nil)
1599
1600(defun gnus-multi-decode-encoded-word-string (string)
1601 "Apply the functions from `gnus-encoded-word-methods' that match."
1602 (unless (and gnus-decode-encoded-word-methods-cache
1603 (eq gnus-newsgroup-name
1604 (car gnus-decode-encoded-word-methods-cache)))
1605 (setq gnus-decode-encoded-word-methods-cache (list gnus-newsgroup-name))
01c52d31
MB
1606 (dolist (method gnus-decode-encoded-word-methods)
1607 (if (symbolp method)
1608 (nconc gnus-decode-encoded-word-methods-cache (list method))
1609 (if (and gnus-newsgroup-name
1610 (string-match (car method) gnus-newsgroup-name))
1611 (nconc gnus-decode-encoded-word-methods-cache
1612 (list (cdr method)))))))
1613 (dolist (method (cdr gnus-decode-encoded-word-methods-cache) string)
1614 (setq string (funcall method string))))
16409b0b 1615
eec82323
LMI
1616;; Subject simplification.
1617
6748645f 1618(defun gnus-simplify-whitespace (str)
16409b0b 1619 "Remove excessive whitespace from STR."
23f87bed
MB
1620 ;; Multiple spaces.
1621 (while (string-match "[ \t][ \t]+" str)
1622 (setq str (concat (substring str 0 (match-beginning 0))
1623 " "
1624 (substring str (match-end 0)))))
1625 ;; Leading spaces.
1626 (when (string-match "^[ \t]+" str)
1627 (setq str (substring str (match-end 0))))
1628 ;; Trailing spaces.
1629 (when (string-match "[ \t]+$" str)
1630 (setq str (substring str 0 (match-beginning 0))))
1631 str)
1632
1633(defun gnus-simplify-all-whitespace (str)
1634 "Remove all whitespace from STR."
1635 (while (string-match "[ \t\n]+" str)
1636 (setq str (replace-match "" nil nil str)))
1637 str)
6748645f 1638
eec82323
LMI
1639(defsubst gnus-simplify-subject-re (subject)
1640 "Remove \"Re:\" from subject lines."
23f87bed 1641 (if (string-match message-subject-re-regexp subject)
eec82323
LMI
1642 (substring subject (match-end 0))
1643 subject))
1644
1645(defun gnus-simplify-subject (subject &optional re-only)
1646 "Remove `Re:' and words in parentheses.
1647If RE-ONLY is non-nil, strip leading `Re:'s only."
1648 (let ((case-fold-search t)) ;Ignore case.
1649 ;; Remove `Re:', `Re^N:', `Re(n)', and `Re[n]:'.
1650 (when (string-match "\\`\\(re\\([[(^][0-9]+[])]?\\)?:[ \t]*\\)+" subject)
1651 (setq subject (substring subject (match-end 0))))
1652 ;; Remove uninteresting prefixes.
1653 (when (and (not re-only)
1654 gnus-simplify-ignored-prefixes
1655 (string-match gnus-simplify-ignored-prefixes subject))
1656 (setq subject (substring subject (match-end 0))))
1657 ;; Remove words in parentheses from end.
1658 (unless re-only
1659 (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject)
1660 (setq subject (substring subject 0 (match-beginning 0)))))
1661 ;; Return subject string.
1662 subject))
1663
1664;; Remove any leading "re:"s, any trailing paren phrases, and simplify
1665;; all whitespace.
1666(defsubst gnus-simplify-buffer-fuzzy-step (regexp &optional newtext)
1667 (goto-char (point-min))
1668 (while (re-search-forward regexp nil t)
16409b0b 1669 (replace-match (or newtext ""))))
eec82323
LMI
1670
1671(defun gnus-simplify-buffer-fuzzy ()
1672 "Simplify string in the buffer fuzzily.
1673The string in the accessible portion of the current buffer is simplified.
1674It is assumed to be a single-line subject.
1675Whitespace is generally cleaned up, and miscellaneous leading/trailing
1676matter is removed. Additional things can be deleted by setting
16409b0b 1677`gnus-simplify-subject-fuzzy-regexp'."
eec82323
LMI
1678 (let ((case-fold-search t)
1679 (modified-tick))
1680 (gnus-simplify-buffer-fuzzy-step "\t" " ")
1681
1682 (while (not (eq modified-tick (buffer-modified-tick)))
1683 (setq modified-tick (buffer-modified-tick))
1684 (cond
1685 ((listp gnus-simplify-subject-fuzzy-regexp)
01c52d31
MB
1686 (mapc 'gnus-simplify-buffer-fuzzy-step
1687 gnus-simplify-subject-fuzzy-regexp))
eec82323
LMI
1688 (gnus-simplify-subject-fuzzy-regexp
1689 (gnus-simplify-buffer-fuzzy-step gnus-simplify-subject-fuzzy-regexp)))
1690 (gnus-simplify-buffer-fuzzy-step "^ *\\[[-+?*!][-+?*!]\\] *")
1691 (gnus-simplify-buffer-fuzzy-step
1692 "^ *\\(re\\|fw\\|fwd\\)[[{(^0-9]*[])}]?[:;] *")
1693 (gnus-simplify-buffer-fuzzy-step "^[[].*:\\( .*\\)[]]$" "\\1"))
1694
1695 (gnus-simplify-buffer-fuzzy-step " *[[{(][^()\n]*[]})] *$")
1696 (gnus-simplify-buffer-fuzzy-step " +" " ")
1697 (gnus-simplify-buffer-fuzzy-step " $")
1698 (gnus-simplify-buffer-fuzzy-step "^ +")))
1699
1700(defun gnus-simplify-subject-fuzzy (subject)
1701 "Simplify a subject string fuzzily.
6748645f 1702See `gnus-simplify-buffer-fuzzy' for details."
eec82323
LMI
1703 (save-excursion
1704 (gnus-set-work-buffer)
1705 (let ((case-fold-search t))
6748645f
LMI
1706 ;; Remove uninteresting prefixes.
1707 (when (and gnus-simplify-ignored-prefixes
1708 (string-match gnus-simplify-ignored-prefixes subject))
1709 (setq subject (substring subject (match-end 0))))
eec82323
LMI
1710 (insert subject)
1711 (inline (gnus-simplify-buffer-fuzzy))
1712 (buffer-string))))
1713
1714(defsubst gnus-simplify-subject-fully (subject)
23f87bed 1715 "Simplify a subject string according to `gnus-summary-gather-subject-limit'."
eec82323 1716 (cond
6748645f
LMI
1717 (gnus-simplify-subject-functions
1718 (gnus-map-function gnus-simplify-subject-functions subject))
eec82323
LMI
1719 ((null gnus-summary-gather-subject-limit)
1720 (gnus-simplify-subject-re subject))
1721 ((eq gnus-summary-gather-subject-limit 'fuzzy)
1722 (gnus-simplify-subject-fuzzy subject))
1723 ((numberp gnus-summary-gather-subject-limit)
01c52d31
MB
1724 (truncate-string-to-width (gnus-simplify-subject-re subject)
1725 gnus-summary-gather-subject-limit))
eec82323
LMI
1726 (t
1727 subject)))
1728
1729(defsubst gnus-subject-equal (s1 s2 &optional simple-first)
6748645f 1730 "Check whether two subjects are equal.
23f87bed 1731If optional argument SIMPLE-FIRST is t, first argument is already
6748645f 1732simplified."
eec82323
LMI
1733 (cond
1734 ((null simple-first)
1735 (equal (gnus-simplify-subject-fully s1)
1736 (gnus-simplify-subject-fully s2)))
1737 (t
1738 (equal s1
1739 (gnus-simplify-subject-fully s2)))))
1740
1741(defun gnus-summary-bubble-group ()
1742 "Increase the score of the current group.
1743This is a handy function to add to `gnus-summary-exit-hook' to
1744increase the score of each group you read."
1745 (gnus-group-add-score gnus-newsgroup-name))
1746
1747\f
1748;;;
1749;;; Gnus summary mode
1750;;;
1751
1752(put 'gnus-summary-mode 'mode-class 'special)
1753
1653df0f
SZ
1754(defvar gnus-article-commands-menu)
1755
23f87bed
MB
1756;; Non-orthogonal keys
1757
1758(gnus-define-keys gnus-summary-mode-map
1759 " " gnus-summary-next-page
1760 "\177" gnus-summary-prev-page
1761 [delete] gnus-summary-prev-page
1762 [backspace] gnus-summary-prev-page
1763 "\r" gnus-summary-scroll-up
1764 "\M-\r" gnus-summary-scroll-down
1765 "n" gnus-summary-next-unread-article
1766 "p" gnus-summary-prev-unread-article
1767 "N" gnus-summary-next-article
1768 "P" gnus-summary-prev-article
1769 "\M-\C-n" gnus-summary-next-same-subject
1770 "\M-\C-p" gnus-summary-prev-same-subject
1771 "\M-n" gnus-summary-next-unread-subject
1772 "\M-p" gnus-summary-prev-unread-subject
1773 "." gnus-summary-first-unread-article
1774 "," gnus-summary-best-unread-article
1775 "\M-s" gnus-summary-search-article-forward
1776 "\M-r" gnus-summary-search-article-backward
01c52d31
MB
1777 "\M-S" gnus-summary-repeat-search-article-forward
1778 "\M-R" gnus-summary-repeat-search-article-backward
23f87bed
MB
1779 "<" gnus-summary-beginning-of-article
1780 ">" gnus-summary-end-of-article
1781 "j" gnus-summary-goto-article
1782 "^" gnus-summary-refer-parent-article
1783 "\M-^" gnus-summary-refer-article
1784 "u" gnus-summary-tick-article-forward
1785 "!" gnus-summary-tick-article-forward
1786 "U" gnus-summary-tick-article-backward
1787 "d" gnus-summary-mark-as-read-forward
1788 "D" gnus-summary-mark-as-read-backward
1789 "E" gnus-summary-mark-as-expirable
1790 "\M-u" gnus-summary-clear-mark-forward
1791 "\M-U" gnus-summary-clear-mark-backward
1792 "k" gnus-summary-kill-same-subject-and-select
1793 "\C-k" gnus-summary-kill-same-subject
1794 "\M-\C-k" gnus-summary-kill-thread
1795 "\M-\C-l" gnus-summary-lower-thread
1796 "e" gnus-summary-edit-article
1797 "#" gnus-summary-mark-as-processable
1798 "\M-#" gnus-summary-unmark-as-processable
1799 "\M-\C-t" gnus-summary-toggle-threads
1800 "\M-\C-s" gnus-summary-show-thread
1801 "\M-\C-h" gnus-summary-hide-thread
1802 "\M-\C-f" gnus-summary-next-thread
1803 "\M-\C-b" gnus-summary-prev-thread
1804 [(meta down)] gnus-summary-next-thread
1805 [(meta up)] gnus-summary-prev-thread
1806 "\M-\C-u" gnus-summary-up-thread
1807 "\M-\C-d" gnus-summary-down-thread
1808 "&" gnus-summary-execute-command
1809 "c" gnus-summary-catchup-and-exit
1810 "\C-w" gnus-summary-mark-region-as-read
1811 "\C-t" gnus-summary-toggle-truncation
1812 "?" gnus-summary-mark-as-dormant
1813 "\C-c\M-\C-s" gnus-summary-limit-include-expunged
1814 "\C-c\C-s\C-n" gnus-summary-sort-by-number
1815 "\C-c\C-s\C-l" gnus-summary-sort-by-lines
1816 "\C-c\C-s\C-c" gnus-summary-sort-by-chars
1817 "\C-c\C-s\C-a" gnus-summary-sort-by-author
01c52d31 1818 "\C-c\C-s\C-t" gnus-summary-sort-by-recipient
23f87bed
MB
1819 "\C-c\C-s\C-s" gnus-summary-sort-by-subject
1820 "\C-c\C-s\C-d" gnus-summary-sort-by-date
1821 "\C-c\C-s\C-i" gnus-summary-sort-by-score
1822 "\C-c\C-s\C-o" gnus-summary-sort-by-original
1823 "\C-c\C-s\C-r" gnus-summary-sort-by-random
1824 "=" gnus-summary-expand-window
1825 "\C-x\C-s" gnus-summary-reselect-current-group
1826 "\M-g" gnus-summary-rescan-group
1827 "w" gnus-summary-stop-page-breaking
1828 "\C-c\C-r" gnus-summary-caesar-message
1829 "f" gnus-summary-followup
1830 "F" gnus-summary-followup-with-original
1831 "C" gnus-summary-cancel-article
1832 "r" gnus-summary-reply
1833 "R" gnus-summary-reply-with-original
1834 "\C-c\C-f" gnus-summary-mail-forward
1835 "o" gnus-summary-save-article
1836 "\C-o" gnus-summary-save-article-mail
1837 "|" gnus-summary-pipe-output
1838 "\M-k" gnus-summary-edit-local-kill
1839 "\M-K" gnus-summary-edit-global-kill
1840 ;; "V" gnus-version
1841 "\C-c\C-d" gnus-summary-describe-group
1842 "q" gnus-summary-exit
1843 "Q" gnus-summary-exit-no-update
1844 "\C-c\C-i" gnus-info-find-node
1845 gnus-mouse-2 gnus-mouse-pick-article
132cf96d 1846 [follow-link] mouse-face
23f87bed
MB
1847 "m" gnus-summary-mail-other-window
1848 "a" gnus-summary-post-news
1849 "i" gnus-summary-news-other-window
1850 "x" gnus-summary-limit-to-unread
1851 "s" gnus-summary-isearch-article
1852 "t" gnus-summary-toggle-header
1853 "g" gnus-summary-show-article
1854 "l" gnus-summary-goto-last-article
1855 "\C-c\C-v\C-v" gnus-uu-decode-uu-view
1856 "\C-d" gnus-summary-enter-digest-group
1857 "\M-\C-d" gnus-summary-read-document
1858 "\M-\C-e" gnus-summary-edit-parameters
1859 "\M-\C-a" gnus-summary-customize-parameters
1860 "\C-c\C-b" gnus-bug
1861 "*" gnus-cache-enter-article
1862 "\M-*" gnus-cache-remove-article
1863 "\M-&" gnus-summary-universal-argument
1864 "\C-l" gnus-recenter
1865 "I" gnus-summary-increase-score
1866 "L" gnus-summary-lower-score
1867 "\M-i" gnus-symbolic-argument
1868 "h" gnus-summary-select-article-buffer
1869
1870 "b" gnus-article-view-part
1871 "\M-t" gnus-summary-toggle-display-buttonized
1872
1873 "V" gnus-summary-score-map
1874 "X" gnus-uu-extract-map
1875 "S" gnus-summary-send-map)
1876
1877;; Sort of orthogonal keymap
1878(gnus-define-keys (gnus-summary-mark-map "M" gnus-summary-mode-map)
1879 "t" gnus-summary-tick-article-forward
1880 "!" gnus-summary-tick-article-forward
1881 "d" gnus-summary-mark-as-read-forward
1882 "r" gnus-summary-mark-as-read-forward
1883 "c" gnus-summary-clear-mark-forward
1884 " " gnus-summary-clear-mark-forward
1885 "e" gnus-summary-mark-as-expirable
1886 "x" gnus-summary-mark-as-expirable
1887 "?" gnus-summary-mark-as-dormant
1888 "b" gnus-summary-set-bookmark
1889 "B" gnus-summary-remove-bookmark
1890 "#" gnus-summary-mark-as-processable
1891 "\M-#" gnus-summary-unmark-as-processable
1892 "S" gnus-summary-limit-include-expunged
1893 "C" gnus-summary-catchup
1894 "H" gnus-summary-catchup-to-here
1895 "h" gnus-summary-catchup-from-here
1896 "\C-c" gnus-summary-catchup-all
1897 "k" gnus-summary-kill-same-subject-and-select
1898 "K" gnus-summary-kill-same-subject
1899 "P" gnus-uu-mark-map)
1900
1901(gnus-define-keys (gnus-summary-mscore-map "V" gnus-summary-mark-map)
1902 "c" gnus-summary-clear-above
1903 "u" gnus-summary-tick-above
1904 "m" gnus-summary-mark-above
1905 "k" gnus-summary-kill-below)
1906
1907(gnus-define-keys (gnus-summary-limit-map "/" gnus-summary-mode-map)
1908 "/" gnus-summary-limit-to-subject
1909 "n" gnus-summary-limit-to-articles
01c52d31
MB
1910 "b" gnus-summary-limit-to-bodies
1911 "h" gnus-summary-limit-to-headers
23f87bed
MB
1912 "w" gnus-summary-pop-limit
1913 "s" gnus-summary-limit-to-subject
1914 "a" gnus-summary-limit-to-author
1915 "u" gnus-summary-limit-to-unread
1916 "m" gnus-summary-limit-to-marks
1917 "M" gnus-summary-limit-exclude-marks
1918 "v" gnus-summary-limit-to-score
1919 "*" gnus-summary-limit-include-cached
1920 "D" gnus-summary-limit-include-dormant
1921 "T" gnus-summary-limit-include-thread
1922 "d" gnus-summary-limit-exclude-dormant
1923 "t" gnus-summary-limit-to-age
1924 "." gnus-summary-limit-to-unseen
1925 "x" gnus-summary-limit-to-extra
1926 "p" gnus-summary-limit-to-display-predicate
1927 "E" gnus-summary-limit-include-expunged
1928 "c" gnus-summary-limit-exclude-childless-dormant
1929 "C" gnus-summary-limit-mark-excluded-as-read
1930 "o" gnus-summary-insert-old-articles
01c52d31
MB
1931 "N" gnus-summary-insert-new-articles
1932 "S" gnus-summary-limit-to-singletons
1933 "r" gnus-summary-limit-to-replied
1934 "R" gnus-summary-limit-to-recipient
1935 "A" gnus-summary-limit-to-address)
23f87bed
MB
1936
1937(gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map)
1938 "n" gnus-summary-next-unread-article
1939 "p" gnus-summary-prev-unread-article
1940 "N" gnus-summary-next-article
1941 "P" gnus-summary-prev-article
1942 "\C-n" gnus-summary-next-same-subject
1943 "\C-p" gnus-summary-prev-same-subject
1944 "\M-n" gnus-summary-next-unread-subject
1945 "\M-p" gnus-summary-prev-unread-subject
1946 "f" gnus-summary-first-unread-article
1947 "b" gnus-summary-best-unread-article
1948 "j" gnus-summary-goto-article
1949 "g" gnus-summary-goto-subject
1950 "l" gnus-summary-goto-last-article
1951 "o" gnus-summary-pop-article)
1952
1953(gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map)
1954 "k" gnus-summary-kill-thread
01c52d31 1955 "E" gnus-summary-expire-thread
23f87bed
MB
1956 "l" gnus-summary-lower-thread
1957 "i" gnus-summary-raise-thread
1958 "T" gnus-summary-toggle-threads
1959 "t" gnus-summary-rethread-current
1960 "^" gnus-summary-reparent-thread
01c52d31 1961 "\M-^" gnus-summary-reparent-children
23f87bed
MB
1962 "s" gnus-summary-show-thread
1963 "S" gnus-summary-show-all-threads
1964 "h" gnus-summary-hide-thread
1965 "H" gnus-summary-hide-all-threads
1966 "n" gnus-summary-next-thread
1967 "p" gnus-summary-prev-thread
1968 "u" gnus-summary-up-thread
1969 "o" gnus-summary-top-thread
1970 "d" gnus-summary-down-thread
1971 "#" gnus-uu-mark-thread
1972 "\M-#" gnus-uu-unmark-thread)
1973
1974(gnus-define-keys (gnus-summary-buffer-map "Y" gnus-summary-mode-map)
1975 "g" gnus-summary-prepare
1976 "c" gnus-summary-insert-cached-articles
01c52d31
MB
1977 "d" gnus-summary-insert-dormant-articles
1978 "t" gnus-summary-insert-ticked-articles)
23f87bed
MB
1979
1980(gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map)
1981 "c" gnus-summary-catchup-and-exit
1982 "C" gnus-summary-catchup-all-and-exit
1983 "E" gnus-summary-exit-no-update
1984 "Q" gnus-summary-exit
1985 "Z" gnus-summary-exit
1986 "n" gnus-summary-catchup-and-goto-next-group
01c52d31 1987 "p" gnus-summary-catchup-and-goto-prev-group
23f87bed
MB
1988 "R" gnus-summary-reselect-current-group
1989 "G" gnus-summary-rescan-group
1990 "N" gnus-summary-next-group
1991 "s" gnus-summary-save-newsrc
1992 "P" gnus-summary-prev-group)
1993
1994(gnus-define-keys (gnus-summary-article-map "A" gnus-summary-mode-map)
1995 " " gnus-summary-next-page
1996 "n" gnus-summary-next-page
1997 "\177" gnus-summary-prev-page
1998 [delete] gnus-summary-prev-page
1999 "p" gnus-summary-prev-page
2000 "\r" gnus-summary-scroll-up
2001 "\M-\r" gnus-summary-scroll-down
2002 "<" gnus-summary-beginning-of-article
2003 ">" gnus-summary-end-of-article
2004 "b" gnus-summary-beginning-of-article
2005 "e" gnus-summary-end-of-article
2006 "^" gnus-summary-refer-parent-article
2007 "r" gnus-summary-refer-parent-article
2008 "D" gnus-summary-enter-digest-group
2009 "R" gnus-summary-refer-references
2010 "T" gnus-summary-refer-thread
2011 "g" gnus-summary-show-article
2012 "s" gnus-summary-isearch-article
2013 "P" gnus-summary-print-article
01c52d31 2014 "S" gnus-sticky-article
23f87bed
MB
2015 "M" gnus-mailing-list-insinuate
2016 "t" gnus-article-babel)
2017
2018(gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map)
2019 "b" gnus-article-add-buttons
2020 "B" gnus-article-add-buttons-to-head
2021 "o" gnus-article-treat-overstrike
2022 "e" gnus-article-emphasize
2023 "w" gnus-article-fill-cited-article
2024 "Q" gnus-article-fill-long-lines
01c52d31 2025 "L" gnus-article-toggle-truncate-lines
23f87bed
MB
2026 "C" gnus-article-capitalize-sentences
2027 "c" gnus-article-remove-cr
2028 "q" gnus-article-de-quoted-unreadable
2029 "6" gnus-article-de-base64-unreadable
2030 "Z" gnus-article-decode-HZ
01c52d31 2031 "A" gnus-article-treat-ansi-sequences
23f87bed
MB
2032 "h" gnus-article-wash-html
2033 "u" gnus-article-unsplit-urls
2034 "s" gnus-summary-force-verify-and-decrypt
2035 "f" gnus-article-display-x-face
2036 "l" gnus-summary-stop-page-breaking
2037 "r" gnus-summary-caesar-message
2038 "m" gnus-summary-morse-message
2039 "t" gnus-summary-toggle-header
2040 "g" gnus-treat-smiley
2041 "v" gnus-summary-verbose-headers
2042 "a" gnus-article-strip-headers-in-body ;; mnemonic: wash archive
2043 "p" gnus-article-verify-x-pgp-sig
01c52d31
MB
2044 "d" gnus-article-treat-dumbquotes
2045 "i" gnus-summary-idna-message)
23f87bed
MB
2046
2047(gnus-define-keys (gnus-summary-wash-deuglify-map "Y" gnus-summary-wash-map)
2048 ;; mnemonic: deuglif*Y*
2049 "u" gnus-article-outlook-unwrap-lines
2050 "a" gnus-article-outlook-repair-attribution
2051 "c" gnus-article-outlook-rearrange-citation
2052 "f" gnus-article-outlook-deuglify-article) ;; mnemonic: full deuglify
2053
2054(gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
2055 "a" gnus-article-hide
2056 "h" gnus-article-hide-headers
2057 "b" gnus-article-hide-boring-headers
2058 "s" gnus-article-hide-signature
2059 "c" gnus-article-hide-citation
2060 "C" gnus-article-hide-citation-in-followups
2061 "l" gnus-article-hide-list-identifiers
2062 "B" gnus-article-strip-banner
2063 "P" gnus-article-hide-pem
2064 "\C-c" gnus-article-hide-citation-maybe)
2065
2066(gnus-define-keys (gnus-summary-wash-highlight-map "H" gnus-summary-wash-map)
2067 "a" gnus-article-highlight
2068 "h" gnus-article-highlight-headers
2069 "c" gnus-article-highlight-citation
2070 "s" gnus-article-highlight-signature)
2071
2072(gnus-define-keys (gnus-summary-wash-header-map "G" gnus-summary-wash-map)
2073 "f" gnus-article-treat-fold-headers
2074 "u" gnus-article-treat-unfold-headers
2075 "n" gnus-article-treat-fold-newsgroups)
2076
2077(gnus-define-keys (gnus-summary-wash-display-map "D" gnus-summary-wash-map)
2078 "x" gnus-article-display-x-face
2079 "d" gnus-article-display-face
2080 "s" gnus-treat-smiley
2081 "D" gnus-article-remove-images
2082 "f" gnus-treat-from-picon
2083 "m" gnus-treat-mail-picon
2084 "n" gnus-treat-newsgroups-picon)
2085
2086(gnus-define-keys (gnus-summary-wash-mime-map "M" gnus-summary-wash-map)
2087 "w" gnus-article-decode-mime-words
2088 "c" gnus-article-decode-charset
2089 "v" gnus-mime-view-all-parts
2090 "b" gnus-article-view-part)
2091
2092(gnus-define-keys (gnus-summary-wash-time-map "T" gnus-summary-wash-map)
2093 "z" gnus-article-date-ut
2094 "u" gnus-article-date-ut
2095 "l" gnus-article-date-local
2096 "p" gnus-article-date-english
2097 "e" gnus-article-date-lapsed
2098 "o" gnus-article-date-original
2099 "i" gnus-article-date-iso8601
2100 "s" gnus-article-date-user)
2101
2102(gnus-define-keys (gnus-summary-wash-empty-map "E" gnus-summary-wash-map)
2103 "t" gnus-article-remove-trailing-blank-lines
2104 "l" gnus-article-strip-leading-blank-lines
2105 "m" gnus-article-strip-multiple-blank-lines
2106 "a" gnus-article-strip-blank-lines
2107 "A" gnus-article-strip-all-blank-lines
2108 "s" gnus-article-strip-leading-space
2109 "e" gnus-article-strip-trailing-space
2110 "w" gnus-article-remove-leading-whitespace)
2111
2112(gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map)
2113 "v" gnus-version
2114 "f" gnus-summary-fetch-faq
2115 "d" gnus-summary-describe-group
2116 "h" gnus-summary-describe-briefly
2117 "i" gnus-info-find-node
2118 "c" gnus-group-fetch-charter
2119 "C" gnus-group-fetch-control)
2120
2121(gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map)
2122 "e" gnus-summary-expire-articles
2123 "\M-\C-e" gnus-summary-expire-articles-now
2124 "\177" gnus-summary-delete-article
2125 [delete] gnus-summary-delete-article
2126 [backspace] gnus-summary-delete-article
2127 "m" gnus-summary-move-article
2128 "r" gnus-summary-respool-article
2129 "w" gnus-summary-edit-article
2130 "c" gnus-summary-copy-article
2131 "B" gnus-summary-crosspost-article
2132 "q" gnus-summary-respool-query
2133 "t" gnus-summary-respool-trace
2134 "i" gnus-summary-import-article
2135 "I" gnus-summary-create-article
2136 "p" gnus-summary-article-posted-p)
2137
2138(gnus-define-keys (gnus-summary-save-map "O" gnus-summary-mode-map)
2139 "o" gnus-summary-save-article
2140 "m" gnus-summary-save-article-mail
2141 "F" gnus-summary-write-article-file
2142 "r" gnus-summary-save-article-rmail
2143 "f" gnus-summary-save-article-file
2144 "b" gnus-summary-save-article-body-file
26c9afc3 2145 "B" gnus-summary-write-article-body-file
23f87bed
MB
2146 "h" gnus-summary-save-article-folder
2147 "v" gnus-summary-save-article-vm
2148 "p" gnus-summary-pipe-output
2149 "P" gnus-summary-muttprint
2150 "s" gnus-soup-add-article)
2151
2152(gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map)
2153 "b" gnus-summary-display-buttonized
2154 "m" gnus-summary-repair-multipart
2155 "v" gnus-article-view-part
2156 "o" gnus-article-save-part
01c52d31
MB
2157 "O" gnus-article-save-part-and-strip
2158 "r" gnus-article-replace-part
2159 "d" gnus-article-delete-part
2160 "t" gnus-article-view-part-as-type
2161 "j" gnus-article-jump-to-part
23f87bed
MB
2162 "c" gnus-article-copy-part
2163 "C" gnus-article-view-part-as-charset
2164 "e" gnus-article-view-part-externally
01c52d31 2165 "H" gnus-article-browse-html-article
23f87bed
MB
2166 "E" gnus-article-encrypt-body
2167 "i" gnus-article-inline-part
2168 "|" gnus-article-pipe-part)
2169
2170(gnus-define-keys (gnus-uu-mark-map "P" gnus-summary-mark-map)
2171 "p" gnus-summary-mark-as-processable
2172 "u" gnus-summary-unmark-as-processable
2173 "U" gnus-summary-unmark-all-processable
2174 "v" gnus-uu-mark-over
2175 "s" gnus-uu-mark-series
2176 "r" gnus-uu-mark-region
2177 "g" gnus-uu-unmark-region
2178 "R" gnus-uu-mark-by-regexp
2179 "G" gnus-uu-unmark-by-regexp
2180 "t" gnus-uu-mark-thread
2181 "T" gnus-uu-unmark-thread
2182 "a" gnus-uu-mark-all
2183 "b" gnus-uu-mark-buffer
2184 "S" gnus-uu-mark-sparse
2185 "k" gnus-summary-kill-process-mark
2186 "y" gnus-summary-yank-process-mark
2187 "w" gnus-summary-save-process-mark
2188 "i" gnus-uu-invert-processable)
2189
2190(gnus-define-keys (gnus-uu-extract-map "X" gnus-summary-mode-map)
2191 ;;"x" gnus-uu-extract-any
2192 "m" gnus-summary-save-parts
2193 "u" gnus-uu-decode-uu
2194 "U" gnus-uu-decode-uu-and-save
2195 "s" gnus-uu-decode-unshar
2196 "S" gnus-uu-decode-unshar-and-save
2197 "o" gnus-uu-decode-save
2198 "O" gnus-uu-decode-save
2199 "b" gnus-uu-decode-binhex
2200 "B" gnus-uu-decode-binhex
b890d447 2201 "Y" gnus-uu-decode-yenc
23f87bed
MB
2202 "p" gnus-uu-decode-postscript
2203 "P" gnus-uu-decode-postscript-and-save)
2204
2205(gnus-define-keys
2206 (gnus-uu-extract-view-map "v" gnus-uu-extract-map)
2207 "u" gnus-uu-decode-uu-view
2208 "U" gnus-uu-decode-uu-and-save-view
2209 "s" gnus-uu-decode-unshar-view
2210 "S" gnus-uu-decode-unshar-and-save-view
2211 "o" gnus-uu-decode-save-view
2212 "O" gnus-uu-decode-save-view
2213 "b" gnus-uu-decode-binhex-view
2214 "B" gnus-uu-decode-binhex-view
2215 "p" gnus-uu-decode-postscript-view
2216 "P" gnus-uu-decode-postscript-and-save-view)
2217
2218(defvar gnus-article-post-menu nil)
2219
2220(defconst gnus-summary-menu-maxlen 20)
2221
2222(defun gnus-summary-menu-split (menu)
2223 ;; If we have lots of elements, divide them into groups of 20
2224 ;; and make a pane (or submenu) for each one.
2225 (if (> (length menu) (/ (* gnus-summary-menu-maxlen 3) 2))
2226 (let ((menu menu) sublists next
2227 (i 1))
2228 (while menu
2229 ;; Pull off the next gnus-summary-menu-maxlen elements
2230 ;; and make them the next element of sublist.
2231 (setq next (nthcdr gnus-summary-menu-maxlen menu))
2232 (if next
2233 (setcdr (nthcdr (1- gnus-summary-menu-maxlen) menu)
2234 nil))
2235 (setq sublists (cons (cons (format "%s ... %s" (aref (car menu) 0)
2236 (aref (car (last menu)) 0)) menu)
2237 sublists))
2238 (setq i (1+ i))
2239 (setq menu next))
2240 (nreverse sublists))
2241 ;; Few elements--put them all in one pane.
2242 menu))
eec82323
LMI
2243
2244(defun gnus-summary-make-menu-bar ()
2245 (gnus-turn-off-edit-menu 'summary)
2246
2247 (unless (boundp 'gnus-summary-misc-menu)
2248
2249 (easy-menu-define
23f87bed
MB
2250 gnus-summary-kill-menu gnus-summary-mode-map ""
2251 (cons
2252 "Score"
2253 (nconc
2254 (list
2255 ["Customize" gnus-score-customize t])
2256 (gnus-make-score-map 'increase)
2257 (gnus-make-score-map 'lower)
2258 '(("Mark"
2259 ["Kill below" gnus-summary-kill-below t]
2260 ["Mark above" gnus-summary-mark-above t]
2261 ["Tick above" gnus-summary-tick-above t]
2262 ["Clear above" gnus-summary-clear-above t])
2263 ["Current score" gnus-summary-current-score t]
2264 ["Set score" gnus-summary-set-score t]
2265 ["Switch current score file..." gnus-score-change-score-file t]
2266 ["Set mark below..." gnus-score-set-mark-below t]
2267 ["Set expunge below..." gnus-score-set-expunge-below t]
2268 ["Edit current score file" gnus-score-edit-current-scores t]
59429511 2269 ["Edit score file..." gnus-score-edit-file t]
23f87bed
MB
2270 ["Trace score" gnus-score-find-trace t]
2271 ["Find words" gnus-score-find-favourite-words t]
2272 ["Rescore buffer" gnus-summary-rescore t]
2273 ["Increase score..." gnus-summary-increase-score t]
2274 ["Lower score..." gnus-summary-lower-score t]))))
2275
2276 ;; Define both the Article menu in the summary buffer and the
2277 ;; equivalent Commands menu in the article buffer here for
2278 ;; consistency.
6748645f 2279 (let ((innards
23f87bed
MB
2280 `(("Hide"
2281 ["All" gnus-article-hide t]
2282 ["Headers" gnus-article-hide-headers t]
2283 ["Signature" gnus-article-hide-signature t]
2284 ["Citation" gnus-article-hide-citation t]
16409b0b 2285 ["List identifiers" gnus-article-hide-list-identifiers t]
16409b0b 2286 ["Banner" gnus-article-strip-banner t]
23f87bed
MB
2287 ["Boring headers" gnus-article-hide-boring-headers t])
2288 ("Highlight"
2289 ["All" gnus-article-highlight t]
2290 ["Headers" gnus-article-highlight-headers t]
2291 ["Signature" gnus-article-highlight-signature t]
2292 ["Citation" gnus-article-highlight-citation t])
16409b0b
GM
2293 ("MIME"
2294 ["Words" gnus-article-decode-mime-words t]
2295 ["Charset" gnus-article-decode-charset t]
2296 ["QP" gnus-article-de-quoted-unreadable t]
2297 ["Base64" gnus-article-de-base64-unreadable t]
23f87bed
MB
2298 ["View MIME buttons" gnus-summary-display-buttonized t]
2299 ["View all" gnus-mime-view-all-parts t]
2300 ["Verify and Decrypt" gnus-summary-force-verify-and-decrypt t]
2301 ["Encrypt body" gnus-article-encrypt-body
2302 :active (not (gnus-group-read-only-p))
2303 ,@(if (featurep 'xemacs) nil
2304 '(:help "Encrypt the message body on disk"))]
2305 ["Extract all parts..." gnus-summary-save-parts t]
2306 ("Multipart"
2307 ["Repair multipart" gnus-summary-repair-multipart t]
2308 ["Pipe part..." gnus-article-pipe-part t]
2309 ["Inline part" gnus-article-inline-part t]
01c52d31 2310 ["View part as type..." gnus-article-view-part-as-type t]
23f87bed
MB
2311 ["Encrypt body" gnus-article-encrypt-body
2312 :active (not (gnus-group-read-only-p))
2313 ,@(if (featurep 'xemacs) nil
2314 '(:help "Encrypt the message body on disk"))]
2315 ["View part externally" gnus-article-view-part-externally t]
01c52d31 2316 ["View HTML parts in browser" gnus-article-browse-html-article t]
23f87bed
MB
2317 ["View part with charset..." gnus-article-view-part-as-charset t]
2318 ["Copy part" gnus-article-copy-part t]
2319 ["Save part..." gnus-article-save-part t]
2320 ["View part" gnus-article-view-part t]))
2321 ("Date"
2322 ["Local" gnus-article-date-local t]
2323 ["ISO8601" gnus-article-date-iso8601 t]
2324 ["UT" gnus-article-date-ut t]
2325 ["Original" gnus-article-date-original t]
2326 ["Lapsed" gnus-article-date-lapsed t]
2327 ["User-defined" gnus-article-date-user t])
2328 ("Display"
2329 ["Remove images" gnus-article-remove-images t]
2330 ["Toggle smiley" gnus-treat-smiley t]
2331 ["Show X-Face" gnus-article-display-x-face t]
2332 ["Show picons in From" gnus-treat-from-picon t]
2333 ["Show picons in mail headers" gnus-treat-mail-picon t]
2334 ["Show picons in news headers" gnus-treat-newsgroups-picon t]
2335 ("View as different encoding"
2336 ,@(gnus-summary-menu-split
2337 (mapcar
2338 (lambda (cs)
2339 ;; Since easymenu under Emacs doesn't allow
2340 ;; lambda forms for menu commands, we should
2341 ;; provide intern'ed function symbols.
2342 (let ((command (intern (format "\
2343gnus-summary-show-article-from-menu-as-charset-%s" cs))))
2344 (fset command
2345 `(lambda ()
2346 (interactive)
2347 (let ((gnus-summary-show-article-charset-alist
2348 '((1 . ,cs))))
2349 (gnus-summary-show-article 1))))
2350 `[,(symbol-name cs) ,command t]))
2351 (sort (if (fboundp 'coding-system-list)
2352 (coding-system-list)
2353 (mapcar 'car mm-mime-mule-charset-alist))
2354 'string<)))))
2355 ("Washing"
2356 ("Remove Blanks"
2357 ["Leading" gnus-article-strip-leading-blank-lines t]
2358 ["Multiple" gnus-article-strip-multiple-blank-lines t]
2359 ["Trailing" gnus-article-remove-trailing-blank-lines t]
2360 ["All of the above" gnus-article-strip-blank-lines t]
2361 ["All" gnus-article-strip-all-blank-lines t]
2362 ["Leading space" gnus-article-strip-leading-space t]
2363 ["Trailing space" gnus-article-strip-trailing-space t]
2364 ["Leading space in headers"
2365 gnus-article-remove-leading-whitespace t])
2366 ["Overstrike" gnus-article-treat-overstrike t]
2367 ["Dumb quotes" gnus-article-treat-dumbquotes t]
2368 ["Emphasis" gnus-article-emphasize t]
2369 ["Word wrap" gnus-article-fill-cited-article t]
16409b0b 2370 ["Fill long lines" gnus-article-fill-long-lines t]
01c52d31 2371 ["Toggle truncate long lines" gnus-article-toggle-truncate-lines t]
16409b0b 2372 ["Capitalize sentences" gnus-article-capitalize-sentences t]
23f87bed
MB
2373 ["Remove CR" gnus-article-remove-cr t]
2374 ["Quoted-Printable" gnus-article-de-quoted-unreadable t]
2375 ["Base64" gnus-article-de-base64-unreadable t]
2376 ["Rot 13" gnus-summary-caesar-message
2377 ,@(if (featurep 'xemacs) '(t)
2378 '(:help "\"Caesar rotate\" article by 13"))]
01c52d31 2379 ["De-IDNA" gnus-summary-idna-message t]
23f87bed
MB
2380 ["Morse decode" gnus-summary-morse-message t]
2381 ["Unix pipe..." gnus-summary-pipe-message t]
2382 ["Add buttons" gnus-article-add-buttons t]
2383 ["Add buttons to head" gnus-article-add-buttons-to-head t]
2384 ["Stop page breaking" gnus-summary-stop-page-breaking t]
2385 ["Verbose header" gnus-summary-verbose-headers t]
2386 ["Toggle header" gnus-summary-toggle-header t]
2387 ["Unfold headers" gnus-article-treat-unfold-headers t]
2388 ["Fold newsgroups" gnus-article-treat-fold-newsgroups t]
16409b0b 2389 ["Html" gnus-article-wash-html t]
23f87bed
MB
2390 ["Unsplit URLs" gnus-article-unsplit-urls t]
2391 ["Verify X-PGP-Sig" gnus-article-verify-x-pgp-sig t]
2392 ["Decode HZ" gnus-article-decode-HZ t]
01c52d31 2393 ["ANSI sequences" gnus-article-treat-ansi-sequences t]
23f87bed
MB
2394 ("(Outlook) Deuglify"
2395 ["Unwrap lines" gnus-article-outlook-unwrap-lines t]
2396 ["Repair attribution" gnus-article-outlook-repair-attribution t]
2397 ["Rearrange citation" gnus-article-outlook-rearrange-citation t]
2398 ["Full (Outlook) deuglify"
2399 gnus-article-outlook-deuglify-article t])
2400 )
2401 ("Output"
2402 ["Save in default format..." gnus-summary-save-article
2403 ,@(if (featurep 'xemacs) '(t)
2404 '(:help "Save article using default method"))]
2405 ["Save in file..." gnus-summary-save-article-file
2406 ,@(if (featurep 'xemacs) '(t)
2407 '(:help "Save article in file"))]
2408 ["Save in Unix mail format..." gnus-summary-save-article-mail t]
2409 ["Save in MH folder..." gnus-summary-save-article-folder t]
2410 ["Save in VM folder..." gnus-summary-save-article-vm t]
2411 ["Save in RMAIL mbox..." gnus-summary-save-article-rmail t]
2412 ["Save body in file..." gnus-summary-save-article-body-file t]
2413 ["Pipe through a filter..." gnus-summary-pipe-output t]
2414 ["Add to SOUP packet" gnus-soup-add-article t]
2415 ["Print with Muttprint..." gnus-summary-muttprint t]
531e5812
MB
2416 ["Print" gnus-summary-print-article
2417 ,@(if (featurep 'xemacs) '(t)
2418 '(:help "Generate and print a PostScript image"))])
2419 ("Copy, move,... (Backend)"
707f2b38 2420 ,@(if (featurep 'xemacs) nil
531e5812 2421 '(:help "Copying, moving, expiring articles..."))
23f87bed
MB
2422 ["Respool article..." gnus-summary-respool-article t]
2423 ["Move article..." gnus-summary-move-article
2424 (gnus-check-backend-function
2425 'request-move-article gnus-newsgroup-name)]
2426 ["Copy article..." gnus-summary-copy-article t]
2427 ["Crosspost article..." gnus-summary-crosspost-article
2428 (gnus-check-backend-function
2429 'request-replace-article gnus-newsgroup-name)]
2430 ["Import file..." gnus-summary-import-article
2431 (gnus-check-backend-function
2432 'request-accept-article gnus-newsgroup-name)]
2433 ["Create article..." gnus-summary-create-article
2434 (gnus-check-backend-function
2435 'request-accept-article gnus-newsgroup-name)]
2436 ["Check if posted" gnus-summary-article-posted-p t]
2437 ["Edit article" gnus-summary-edit-article
2438 (not (gnus-group-read-only-p))]
2439 ["Delete article" gnus-summary-delete-article
2440 (gnus-check-backend-function
2441 'request-expire-articles gnus-newsgroup-name)]
2442 ["Query respool" gnus-summary-respool-query t]
6748645f 2443 ["Trace respool" gnus-summary-respool-trace t]
23f87bed
MB
2444 ["Delete expirable articles" gnus-summary-expire-articles-now
2445 (gnus-check-backend-function
2446 'request-expire-articles gnus-newsgroup-name)])
2447 ("Extract"
2448 ["Uudecode" gnus-uu-decode-uu
2449 ,@(if (featurep 'xemacs) '(t)
2450 '(:help "Decode uuencoded article(s)"))]
2451 ["Uudecode and save" gnus-uu-decode-uu-and-save t]
2452 ["Unshar" gnus-uu-decode-unshar t]
2453 ["Unshar and save" gnus-uu-decode-unshar-and-save t]
2454 ["Save" gnus-uu-decode-save t]
2455 ["Binhex" gnus-uu-decode-binhex t]
2456 ["Postscript" gnus-uu-decode-postscript t]
2457 ["All MIME parts" gnus-summary-save-parts t])
2458 ("Cache"
2459 ["Enter article" gnus-cache-enter-article t]
2460 ["Remove article" gnus-cache-remove-article t])
16409b0b 2461 ["Translate" gnus-article-babel t]
23f87bed 2462 ["Select article buffer" gnus-summary-select-article-buffer t]
01c52d31 2463 ["Make article buffer sticky" gnus-sticky-article t]
23f87bed
MB
2464 ["Enter digest buffer" gnus-summary-enter-digest-group t]
2465 ["Isearch article..." gnus-summary-isearch-article t]
2466 ["Beginning of the article" gnus-summary-beginning-of-article t]
2467 ["End of the article" gnus-summary-end-of-article t]
2468 ["Fetch parent of article" gnus-summary-refer-parent-article t]
2469 ["Fetch referenced articles" gnus-summary-refer-references t]
2470 ["Fetch current thread" gnus-summary-refer-thread t]
2471 ["Fetch article with id..." gnus-summary-refer-article t]
2472 ["Setup Mailing List Params" gnus-mailing-list-insinuate t]
2473 ["Redisplay" gnus-summary-show-article t]
2474 ["Raw article" gnus-summary-show-raw-article :keys "C-u g"])))
6748645f 2475 (easy-menu-define
23f87bed
MB
2476 gnus-summary-article-menu gnus-summary-mode-map ""
2477 (cons "Article" innards))
6748645f 2478
1653df0f
SZ
2479 (if (not (keymapp gnus-summary-article-menu))
2480 (easy-menu-define
2481 gnus-article-commands-menu gnus-article-mode-map ""
2482 (cons "Commands" innards))
2483 ;; in Emacs, don't share menu.
a1506d29 2484 (setq gnus-article-commands-menu
1653df0f
SZ
2485 (copy-keymap gnus-summary-article-menu))
2486 (define-key gnus-article-mode-map [menu-bar commands]
2487 (cons "Commands" gnus-article-commands-menu))))
eec82323
LMI
2488
2489 (easy-menu-define
23f87bed
MB
2490 gnus-summary-thread-menu gnus-summary-mode-map ""
2491 '("Threads"
2492 ["Find all messages in thread" gnus-summary-refer-thread t]
2493 ["Toggle threading" gnus-summary-toggle-threads t]
2494 ["Hide threads" gnus-summary-hide-all-threads t]
2495 ["Show threads" gnus-summary-show-all-threads t]
2496 ["Hide thread" gnus-summary-hide-thread t]
2497 ["Show thread" gnus-summary-show-thread t]
2498 ["Go to next thread" gnus-summary-next-thread t]
2499 ["Go to previous thread" gnus-summary-prev-thread t]
2500 ["Go down thread" gnus-summary-down-thread t]
2501 ["Go up thread" gnus-summary-up-thread t]
2502 ["Top of thread" gnus-summary-top-thread t]
2503 ["Mark thread as read" gnus-summary-kill-thread t]
01c52d31 2504 ["Mark thread as expired" gnus-summary-expire-thread t]
23f87bed
MB
2505 ["Lower thread score" gnus-summary-lower-thread t]
2506 ["Raise thread score" gnus-summary-raise-thread t]
2507 ["Rethread current" gnus-summary-rethread-current t]))
eec82323
LMI
2508
2509 (easy-menu-define
23f87bed
MB
2510 gnus-summary-post-menu gnus-summary-mode-map ""
2511 `("Post"
2512 ["Send a message (mail or news)" gnus-summary-post-news
2513 ,@(if (featurep 'xemacs) '(t)
531e5812 2514 '(:help "Compose a new message (mail or news)"))]
23f87bed
MB
2515 ["Followup" gnus-summary-followup
2516 ,@(if (featurep 'xemacs) '(t)
2517 '(:help "Post followup to this article"))]
2518 ["Followup and yank" gnus-summary-followup-with-original
2519 ,@(if (featurep 'xemacs) '(t)
2520 '(:help "Post followup to this article, quoting its contents"))]
2521 ["Supersede article" gnus-summary-supersede-article t]
2522 ["Cancel article" gnus-summary-cancel-article
2523 ,@(if (featurep 'xemacs) '(t)
2524 '(:help "Cancel an article you posted"))]
2525 ["Reply" gnus-summary-reply t]
2526 ["Reply and yank" gnus-summary-reply-with-original t]
2527 ["Wide reply" gnus-summary-wide-reply t]
2528 ["Wide reply and yank" gnus-summary-wide-reply-with-original
2529 ,@(if (featurep 'xemacs) '(t)
2530 '(:help "Mail a reply, quoting this article"))]
2531 ["Very wide reply" gnus-summary-very-wide-reply t]
2532 ["Very wide reply and yank" gnus-summary-very-wide-reply-with-original
2533 ,@(if (featurep 'xemacs) '(t)
2534 '(:help "Mail a very wide reply, quoting this article"))]
2535 ["Mail forward" gnus-summary-mail-forward t]
2536 ["Post forward" gnus-summary-post-forward t]
2537 ["Digest and mail" gnus-uu-digest-mail-forward t]
2538 ["Digest and post" gnus-uu-digest-post-forward t]
2539 ["Resend message" gnus-summary-resend-message t]
2540 ["Resend message edit" gnus-summary-resend-message-edit t]
2541 ["Send bounced mail" gnus-summary-resend-bounced-mail t]
2542 ["Send a mail" gnus-summary-mail-other-window t]
2543 ["Create a local message" gnus-summary-news-other-window t]
2544 ["Uuencode and post" gnus-uu-post-news
2545 ,@(if (featurep 'xemacs) '(t)
2546 '(:help "Post a uuencoded article"))]
2547 ["Followup via news" gnus-summary-followup-to-mail t]
2548 ["Followup via news and yank"
2549 gnus-summary-followup-to-mail-with-original t]
9b3ebcb6
MB
2550 ["Strip signature on reply"
2551 (lambda ()
2552 (interactive)
2553 (if (not (memq message-cite-function
2554 '(message-cite-original-without-signature
2555 message-cite-original)))
2556 ;; Stupid workaround for XEmacs not honoring :visible.
2557 (message "Can't toggle this value of `message-cite-function'")
2558 (setq message-cite-function
2559 (if (eq message-cite-function
2560 'message-cite-original-without-signature)
2561 'message-cite-original
2562 'message-cite-original-without-signature))))
2563 ;; XEmacs barfs on :visible.
2564 ,@(if (featurep 'xemacs) nil
2565 '(:visible (memq message-cite-function
2566 '(message-cite-original-without-signature
2567 message-cite-original))))
2568 :style toggle
2569 :selected (eq message-cite-function
2570 'message-cite-original-without-signature)
2571 ,@(if (featurep 'xemacs) nil
2572 '(:help "Strip signature from cited article when replying."))]
23f87bed
MB
2573 ;;("Draft"
2574 ;;["Send" gnus-summary-send-draft t]
2575 ;;["Send bounced" gnus-resend-bounced-mail t])
2576 ))
2577
2578 (cond
2579 ((not (keymapp gnus-summary-post-menu))
2580 (setq gnus-article-post-menu gnus-summary-post-menu))
2581 ((not gnus-article-post-menu)
2582 ;; Don't share post menu.
2583 (setq gnus-article-post-menu
2584 (copy-keymap gnus-summary-post-menu))))
2585 (define-key gnus-article-mode-map [menu-bar post]
2586 (cons "Post" gnus-article-post-menu))
eec82323
LMI
2587
2588 (easy-menu-define
23f87bed
MB
2589 gnus-summary-misc-menu gnus-summary-mode-map ""
2590 `("Gnus"
2591 ("Mark Read"
2592 ["Mark as read" gnus-summary-mark-as-read-forward t]
2593 ["Mark same subject and select"
2594 gnus-summary-kill-same-subject-and-select t]
2595 ["Mark same subject" gnus-summary-kill-same-subject t]
2596 ["Catchup" gnus-summary-catchup
2597 ,@(if (featurep 'xemacs) '(t)
2598 '(:help "Mark unread articles in this group as read"))]
2599 ["Catchup all" gnus-summary-catchup-all t]
2600 ["Catchup to here" gnus-summary-catchup-to-here t]
2601 ["Catchup from here" gnus-summary-catchup-from-here t]
2602 ["Catchup region" gnus-summary-mark-region-as-read
2603 (gnus-mark-active-p)]
2604 ["Mark excluded" gnus-summary-limit-mark-excluded-as-read t])
2605 ("Mark Various"
2606 ["Tick" gnus-summary-tick-article-forward t]
2607 ["Mark as dormant" gnus-summary-mark-as-dormant t]
2608 ["Remove marks" gnus-summary-clear-mark-forward t]
2609 ["Set expirable mark" gnus-summary-mark-as-expirable t]
2610 ["Set bookmark" gnus-summary-set-bookmark t]
2611 ["Remove bookmark" gnus-summary-remove-bookmark t])
8f7abae3
MB
2612 ("Registry Mark"
2613 ["Important" gnus-registry-set-article-Important-mark t]
2614 ["Not Important" gnus-registry-remove-article-Important-mark t]
2615 ["Work" gnus-registry-set-article-Work-mark t]
2616 ["Not Work" gnus-registry-remove-article-Work-mark t]
2617 ["Later" gnus-registry-set-article-Later-mark t]
2618 ["Not Later" gnus-registry-remove-article-Later-mark t]
2619 ["Personal" gnus-registry-set-article-Personal-mark t]
2620 ["Not Personal" gnus-registry-remove-article-Personal-mark t]
2621 ["To Do" gnus-registry-set-article-To-Do-mark t]
2622 ["Not To Do" gnus-registry-remove-article-To-Do-mark t])
23f87bed
MB
2623 ("Limit to"
2624 ["Marks..." gnus-summary-limit-to-marks t]
2625 ["Subject..." gnus-summary-limit-to-subject t]
2626 ["Author..." gnus-summary-limit-to-author t]
01c52d31
MB
2627 ["Recipient..." gnus-summary-limit-to-recipient t]
2628 ["Address..." gnus-summary-limit-to-address t]
23f87bed
MB
2629 ["Age..." gnus-summary-limit-to-age t]
2630 ["Extra..." gnus-summary-limit-to-extra t]
2631 ["Score..." gnus-summary-limit-to-score t]
2632 ["Display Predicate" gnus-summary-limit-to-display-predicate t]
2633 ["Unread" gnus-summary-limit-to-unread t]
2634 ["Unseen" gnus-summary-limit-to-unseen t]
01c52d31
MB
2635 ["Singletons" gnus-summary-limit-to-singletons t]
2636 ["Replied" gnus-summary-limit-to-replied t]
23f87bed 2637 ["Non-dormant" gnus-summary-limit-exclude-dormant t]
996aa8c1 2638 ["Next or process marked articles" gnus-summary-limit-to-articles t]
23f87bed
MB
2639 ["Pop limit" gnus-summary-pop-limit t]
2640 ["Show dormant" gnus-summary-limit-include-dormant t]
2641 ["Hide childless dormant"
2642 gnus-summary-limit-exclude-childless-dormant t]
2643 ;;["Hide thread" gnus-summary-limit-exclude-thread t]
2644 ["Hide marked" gnus-summary-limit-exclude-marks t]
2645 ["Show expunged" gnus-summary-limit-include-expunged t])
2646 ("Process Mark"
2647 ["Set mark" gnus-summary-mark-as-processable t]
2648 ["Remove mark" gnus-summary-unmark-as-processable t]
2649 ["Remove all marks" gnus-summary-unmark-all-processable t]
01c52d31 2650 ["Invert marks" gnus-uu-invert-processable t]
23f87bed
MB
2651 ["Mark above" gnus-uu-mark-over t]
2652 ["Mark series" gnus-uu-mark-series t]
2653 ["Mark region" gnus-uu-mark-region (gnus-mark-active-p)]
2654 ["Unmark region" gnus-uu-unmark-region (gnus-mark-active-p)]
2655 ["Mark by regexp..." gnus-uu-mark-by-regexp t]
2656 ["Unmark by regexp..." gnus-uu-unmark-by-regexp t]
2657 ["Mark all" gnus-uu-mark-all t]
2658 ["Mark buffer" gnus-uu-mark-buffer t]
2659 ["Mark sparse" gnus-uu-mark-sparse t]
2660 ["Mark thread" gnus-uu-mark-thread t]
2661 ["Unmark thread" gnus-uu-unmark-thread t]
2662 ("Process Mark Sets"
2663 ["Kill" gnus-summary-kill-process-mark t]
2664 ["Yank" gnus-summary-yank-process-mark
2665 gnus-newsgroup-process-stack]
2666 ["Save" gnus-summary-save-process-mark t]
2667 ["Run command on marked..." gnus-summary-universal-argument t]))
2668 ("Scroll article"
2669 ["Page forward" gnus-summary-next-page
2670 ,@(if (featurep 'xemacs) '(t)
2671 '(:help "Show next page of article"))]
2672 ["Page backward" gnus-summary-prev-page
2673 ,@(if (featurep 'xemacs) '(t)
2674 '(:help "Show previous page of article"))]
2675 ["Line forward" gnus-summary-scroll-up t])
2676 ("Move"
2677 ["Next unread article" gnus-summary-next-unread-article t]
2678 ["Previous unread article" gnus-summary-prev-unread-article t]
2679 ["Next article" gnus-summary-next-article t]
2680 ["Previous article" gnus-summary-prev-article t]
2681 ["Next unread subject" gnus-summary-next-unread-subject t]
2682 ["Previous unread subject" gnus-summary-prev-unread-subject t]
2683 ["Next article same subject" gnus-summary-next-same-subject t]
2684 ["Previous article same subject" gnus-summary-prev-same-subject t]
2685 ["First unread article" gnus-summary-first-unread-article t]
2686 ["Best unread article" gnus-summary-best-unread-article t]
2687 ["Go to subject number..." gnus-summary-goto-subject t]
2688 ["Go to article number..." gnus-summary-goto-article t]
2689 ["Go to the last article" gnus-summary-goto-last-article t]
2690 ["Pop article off history" gnus-summary-pop-article t])
2691 ("Sort"
2692 ["Sort by number" gnus-summary-sort-by-number t]
2693 ["Sort by author" gnus-summary-sort-by-author t]
01c52d31 2694 ["Sort by recipient" gnus-summary-sort-by-recipient t]
23f87bed
MB
2695 ["Sort by subject" gnus-summary-sort-by-subject t]
2696 ["Sort by date" gnus-summary-sort-by-date t]
2697 ["Sort by score" gnus-summary-sort-by-score t]
2698 ["Sort by lines" gnus-summary-sort-by-lines t]
2699 ["Sort by characters" gnus-summary-sort-by-chars t]
2700 ["Randomize" gnus-summary-sort-by-random t]
2701 ["Original sort" gnus-summary-sort-by-original t])
2702 ("Help"
2703 ["Fetch group FAQ" gnus-summary-fetch-faq t]
2704 ["Describe group" gnus-summary-describe-group t]
2705 ["Fetch charter" gnus-group-fetch-charter
2706 ,@(if (featurep 'xemacs) nil
2707 '(:help "Display the charter of the current group"))]
2708 ["Fetch control message" gnus-group-fetch-control
2709 ,@(if (featurep 'xemacs) nil
2710 '(:help "Display the archived control message for the current group"))]
2711 ["Read manual" gnus-info-find-node t])
2712 ("Modes"
2713 ["Pick and read" gnus-pick-mode t]
2714 ["Binary" gnus-binary-mode t])
2715 ("Regeneration"
2716 ["Regenerate" gnus-summary-prepare t]
2717 ["Insert cached articles" gnus-summary-insert-cached-articles t]
2718 ["Insert dormant articles" gnus-summary-insert-dormant-articles t]
01c52d31 2719 ["Insert ticked articles" gnus-summary-insert-ticked-articles t]
23f87bed
MB
2720 ["Toggle threading" gnus-summary-toggle-threads t])
2721 ["See old articles" gnus-summary-insert-old-articles t]
2722 ["See new articles" gnus-summary-insert-new-articles t]
2723 ["Filter articles..." gnus-summary-execute-command t]
2724 ["Run command on articles..." gnus-summary-universal-argument t]
2725 ["Search articles forward..." gnus-summary-search-article-forward t]
2726 ["Search articles backward..." gnus-summary-search-article-backward t]
2727 ["Toggle line truncation" gnus-summary-toggle-truncation t]
2728 ["Expand window" gnus-summary-expand-window t]
2729 ["Expire expirable articles" gnus-summary-expire-articles
2730 (gnus-check-backend-function
2731 'request-expire-articles gnus-newsgroup-name)]
2732 ["Edit local kill file" gnus-summary-edit-local-kill t]
2733 ["Edit main kill file" gnus-summary-edit-global-kill t]
2734 ["Edit group parameters" gnus-summary-edit-parameters t]
2735 ["Customize group parameters" gnus-summary-customize-parameters t]
2736 ["Send a bug report" gnus-bug t]
2737 ("Exit"
2738 ["Catchup and exit" gnus-summary-catchup-and-exit
2739 ,@(if (featurep 'xemacs) '(t)
2740 '(:help "Mark unread articles in this group as read, then exit"))]
2741 ["Catchup all and exit" gnus-summary-catchup-all-and-exit t]
2742 ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t]
01c52d31 2743 ["Catchup and goto prev" gnus-summary-catchup-and-goto-prev-group t]
23f87bed
MB
2744 ["Exit group" gnus-summary-exit
2745 ,@(if (featurep 'xemacs) '(t)
2746 '(:help "Exit current group, return to group selection mode"))]
2747 ["Exit group without updating" gnus-summary-exit-no-update t]
2748 ["Exit and goto next group" gnus-summary-next-group t]
2749 ["Exit and goto prev group" gnus-summary-prev-group t]
2750 ["Reselect group" gnus-summary-reselect-current-group t]
2751 ["Rescan group" gnus-summary-rescan-group t]
2752 ["Update dribble" gnus-summary-save-newsrc t])))
eec82323 2753
6748645f 2754 (gnus-run-hooks 'gnus-summary-menu-hook)))
eec82323 2755
60bd5589
DL
2756(defvar gnus-summary-tool-bar-map nil)
2757
18c06a99
RS
2758;; Note: The :set function in the `gnus-summary-tool-bar*' variables will only
2759;; affect _new_ message buffers. We might add a function that walks thru all
2760;; summary-mode buffers and force the update.
2761(defun gnus-summary-tool-bar-update (&optional symbol value)
2762 "Update summary mode toolbar.
2763Setter function for custom variables."
2764 (setq-default gnus-summary-tool-bar-map nil)
2765 (when symbol
2766 ;; When used as ":set" function:
2767 (set-default symbol value))
2768 (when (gnus-buffer-live-p gnus-summary-buffer)
2769 (with-current-buffer gnus-summary-buffer
2770 (gnus-summary-make-tool-bar))))
2771
2772(defcustom gnus-summary-tool-bar (if (eq gmm-tool-bar-style 'gnome)
2773 'gnus-summary-tool-bar-gnome
2774 'gnus-summary-tool-bar-retro)
2775 "Specifies the Gnus summary tool bar.
2776
2777It can be either a list or a symbol refering to a list. See
2778`gmm-tool-bar-from-list' for the format of the list. The
2779default key map is `gnus-summary-mode-map'.
2780
2781Pre-defined symbols include `gnus-summary-tool-bar-gnome' and
2782`gnus-summary-tool-bar-retro'."
2783 :type '(choice (const :tag "GNOME style" gnus-summary-tool-bar-gnome)
2784 (const :tag "Retro look" gnus-summary-tool-bar-retro)
2785 (repeat :tag "User defined list" gmm-tool-bar-item)
2786 (symbol))
330f707b 2787 :version "23.1" ;; No Gnus
18c06a99
RS
2788 :initialize 'custom-initialize-default
2789 :set 'gnus-summary-tool-bar-update
2790 :group 'gnus-summary)
2791
2792(defcustom gnus-summary-tool-bar-gnome
2793 '((gnus-summary-post-news "mail/compose" nil)
2794 (gnus-summary-insert-new-articles "mail/inbox" nil
2795 :visible (or (not gnus-agent)
2796 gnus-plugged))
2797 (gnus-summary-reply-with-original "mail/reply")
2798 (gnus-summary-reply "mail/reply" nil :visible nil)
2799 (gnus-summary-followup-with-original "mail/reply-all")
2800 (gnus-summary-followup "mail/reply-all" nil :visible nil)
2801 (gnus-summary-mail-forward "mail/forward")
2802 (gnus-summary-save-article "mail/save")
2803 (gnus-summary-search-article-forward "search" nil :visible nil)
2804 (gnus-summary-print-article "print")
2805 (gnus-summary-tick-article-forward "flag-followup" nil :visible nil)
2806 ;; Some new commands that may need more suitable icons:
2807 (gnus-summary-save-newsrc "save" nil :visible nil)
2808 ;; (gnus-summary-show-article "stock_message-display" nil :visible nil)
2809 (gnus-summary-prev-article "left-arrow")
2810 (gnus-summary-next-article "right-arrow")
2811 (gnus-summary-next-page "next-page")
2812 ;; (gnus-summary-enter-digest-group "right_arrow" nil :visible nil)
2813 ;;
2814 ;; Maybe some sort-by-... could be added:
2815 ;; (gnus-summary-sort-by-author "sort-a-z" nil :visible nil)
2816 ;; (gnus-summary-sort-by-date "sort-1-9" nil :visible nil)
2817 (gnus-summary-mark-as-expirable
2818 "delete" nil
2819 :visible (gnus-check-backend-function 'request-expire-articles
2820 gnus-newsgroup-name))
2821 (gnus-summary-mark-as-spam
2822 "mail/spam" t
2823 :visible (and (fboundp 'spam-group-ham-contents-p)
2824 (spam-group-ham-contents-p gnus-newsgroup-name))
2825 :help "Mark as spam")
2826 (gnus-summary-mark-as-read-forward
2827 "mail/not-spam" nil
2828 :visible (and (fboundp 'spam-group-spam-contents-p)
2829 (spam-group-spam-contents-p gnus-newsgroup-name)))
2830 ;;
2831 (gnus-summary-exit "exit")
2832 (gmm-customize-mode "preferences" t :help "Edit mode preferences")
2833 (gnus-info-find-node "help"))
2834 "List of functions for the summary tool bar (GNOME style).
2835
2836See `gmm-tool-bar-from-list' for the format of the list."
2837 :type '(repeat gmm-tool-bar-item)
330f707b 2838 :version "23.1" ;; No Gnus
18c06a99
RS
2839 :initialize 'custom-initialize-default
2840 :set 'gnus-summary-tool-bar-update
2841 :group 'gnus-summary)
2842
2843(defcustom gnus-summary-tool-bar-retro
2844 '((gnus-summary-prev-unread-article "gnus/prev-ur")
2845 (gnus-summary-next-unread-article "gnus/next-ur")
2846 (gnus-summary-post-news "gnus/post")
2847 (gnus-summary-followup-with-original "gnus/fuwo")
2848 (gnus-summary-followup "gnus/followup")
2849 (gnus-summary-reply-with-original "gnus/reply-wo")
2850 (gnus-summary-reply "gnus/reply")
2851 (gnus-summary-caesar-message "gnus/rot13")
2852 (gnus-uu-decode-uu "gnus/uu-decode")
2853 (gnus-summary-save-article-file "gnus/save-aif")
2854 (gnus-summary-save-article "gnus/save-art")
2855 (gnus-uu-post-news "gnus/uu-post")
2856 (gnus-summary-catchup "gnus/catchup")
2857 (gnus-summary-catchup-and-exit "gnus/cu-exit")
2858 (gnus-summary-exit "gnus/exit-summ")
2859 ;; Some new command that may need more suitable icons:
2860 (gnus-summary-print-article "gnus/print" nil :visible nil)
2861 (gnus-summary-mark-as-expirable "gnus/close" nil :visible nil)
2862 (gnus-summary-save-newsrc "gnus/save" nil :visible nil)
2863 ;; (gnus-summary-enter-digest-group "gnus/right_arrow" nil :visible nil)
2864 (gnus-summary-search-article-forward "gnus/search" nil :visible nil)
2865 ;; (gnus-summary-insert-new-articles "gnus/paste" nil :visible nil)
2866 ;; (gnus-summary-toggle-threads "gnus/open" nil :visible nil)
2867 ;;
2868 (gnus-info-find-node "gnus/help" nil :visible nil))
2869 "List of functions for the summary tool bar (retro look).
2870
2871See `gmm-tool-bar-from-list' for the format of the list."
2872 :type '(repeat gmm-tool-bar-item)
330f707b 2873 :version "23.1" ;; No Gnus
18c06a99
RS
2874 :initialize 'custom-initialize-default
2875 :set 'gnus-summary-tool-bar-update
2876 :group 'gnus-summary)
2877
2878(defcustom gnus-summary-tool-bar-zap-list t
2879 "List of icon items from the global tool bar.
2880These items are not displayed in the Gnus summary mode tool bar.
2881
2882See `gmm-tool-bar-from-list' for the format of the list."
2883 :type 'gmm-tool-bar-zap-list
330f707b 2884 :version "23.1" ;; No Gnus
18c06a99
RS
2885 :initialize 'custom-initialize-default
2886 :set 'gnus-summary-tool-bar-update
2887 :group 'gnus-summary)
2888
2889(defvar image-load-path)
2890
2891(defun gnus-summary-make-tool-bar (&optional force)
2892 "Make a summary mode tool bar from `gnus-summary-tool-bar'.
2893When FORCE, rebuild the tool bar."
2894 (when (and (not (featurep 'xemacs))
2895 (boundp 'tool-bar-mode)
2896 tool-bar-mode
2897 (or (not gnus-summary-tool-bar-map) force))
2898 (let* ((load-path
2899 (gmm-image-load-path-for-library "gnus"
2900 "mail/save.xpm"
2901 nil t))
2902 (image-load-path (cons (car load-path)
2903 (when (boundp 'image-load-path)
2904 image-load-path)))
2905 (map (gmm-tool-bar-from-list gnus-summary-tool-bar
2906 gnus-summary-tool-bar-zap-list
2907 'gnus-summary-mode-map)))
2908 (when map
2909 ;; Need to set `gnus-summary-tool-bar-map' because `gnus-article-mode'
2910 ;; uses it's value.
2911 (setq gnus-summary-tool-bar-map map))))
2912 (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map))
60bd5589 2913
eec82323
LMI
2914(defun gnus-score-set-default (var value)
2915 "A version of set that updates the GNU Emacs menu-bar."
2916 (set var value)
2917 ;; It is the message that forces the active status to be updated.
2918 (message ""))
2919
2920(defun gnus-make-score-map (type)
2921 "Make a summary score map of type TYPE."
2922 (if t
2923 nil
2924 (let ((headers '(("author" "from" string)
2925 ("subject" "subject" string)
2926 ("article body" "body" string)
2927 ("article head" "head" string)
2928 ("xref" "xref" string)
16409b0b 2929 ("extra header" "extra" string)
eec82323
LMI
2930 ("lines" "lines" number)
2931 ("followups to author" "followup" string)))
2932 (types '((number ("less than" <)
2933 ("greater than" >)
2934 ("equal" =))
2935 (string ("substring" s)
2936 ("exact string" e)
2937 ("fuzzy string" f)
2938 ("regexp" r))))
2939 (perms '(("temporary" (current-time-string))
2940 ("permanent" nil)
2941 ("immediate" now)))
2942 header)
2943 (list
2944 (apply
2945 'nconc
2946 (list
2947 (if (eq type 'lower)
2948 "Lower score"
2949 "Increase score"))
2950 (let (outh)
2951 (while headers
2952 (setq header (car headers))
2953 (setq outh
2954 (cons
2955 (apply
2956 'nconc
2957 (list (car header))
2958 (let ((ts (cdr (assoc (nth 2 header) types)))
2959 outt)
2960 (while ts
2961 (setq outt
2962 (cons
2963 (apply
2964 'nconc
2965 (list (caar ts))
2966 (let ((ps perms)
2967 outp)
2968 (while ps
2969 (setq outp
2970 (cons
2971 (vector
2972 (caar ps)
2973 (list
2974 'gnus-summary-score-entry
2975 (nth 1 header)
2976 (if (or (string= (nth 1 header)
2977 "head")
2978 (string= (nth 1 header)
2979 "body"))
2980 ""
2981 (list 'gnus-summary-header
2982 (nth 1 header)))
2983 (list 'quote (nth 1 (car ts)))
16409b0b
GM
2984 (list 'gnus-score-delta-default
2985 nil)
eec82323
LMI
2986 (nth 1 (car ps))
2987 t)
2988 t)
2989 outp))
2990 (setq ps (cdr ps)))
2991 (list (nreverse outp))))
2992 outt))
2993 (setq ts (cdr ts)))
2994 (list (nreverse outt))))
2995 outh))
2996 (setq headers (cdr headers)))
2997 (list (nreverse outh))))))))
2998
704f1663
GM
2999
3000(declare-function turn-on-gnus-mailing-list-mode "gnus-ml" ())
3001
eec82323
LMI
3002\f
3003
3004(defun gnus-summary-mode (&optional group)
3005 "Major mode for reading articles.
3006
3007All normal editing commands are switched off.
3008\\<gnus-summary-mode-map>
3009Each line in this buffer represents one article. To read an
3010article, you can, for instance, type `\\[gnus-summary-next-page]'. To move forwards
3011and backwards while displaying articles, type `\\[gnus-summary-next-unread-article]' and `\\[gnus-summary-prev-unread-article]',
3012respectively.
3013
3014You can also post articles and send mail from this buffer. To
23f87bed 3015follow up an article, type `\\[gnus-summary-followup]'. To mail a reply to the author
eec82323
LMI
3016of an article, type `\\[gnus-summary-reply]'.
3017
3018There are approx. one gazillion commands you can execute in this
3019buffer; read the info pages for more information (`\\[gnus-info-find-node]').
3020
3021The following commands are available:
3022
3023\\{gnus-summary-mode-map}"
3024 (interactive)
eec82323 3025 (kill-all-local-variables)
01c52d31
MB
3026 (let ((gnus-summary-local-variables gnus-newsgroup-variables))
3027 (gnus-summary-make-local-variables))
3028 (gnus-summary-make-local-variables)
3029 (setq gnus-newsgroup-name group)
60bd5589
DL
3030 (when (gnus-visual-p 'summary-menu 'menu)
3031 (gnus-summary-make-menu-bar)
3032 (gnus-summary-make-tool-bar))
eec82323
LMI
3033 (gnus-make-thread-indent-array)
3034 (gnus-simplify-mode-line)
3035 (setq major-mode 'gnus-summary-mode)
3036 (setq mode-name "Summary")
3037 (make-local-variable 'minor-mode-alist)
3038 (use-local-map gnus-summary-mode-map)
16409b0b 3039 (buffer-disable-undo)
01c52d31
MB
3040 (setq buffer-read-only t ;Disable modification
3041 show-trailing-whitespace nil)
eec82323
LMI
3042 (setq truncate-lines t)
3043 (setq selective-display t)
3044 (setq selective-display-ellipses t) ;Display `...'
3045 (gnus-summary-set-display-table)
3046 (gnus-set-default-directory)
eec82323
LMI
3047 (make-local-variable 'gnus-summary-line-format)
3048 (make-local-variable 'gnus-summary-line-format-spec)
6748645f
LMI
3049 (make-local-variable 'gnus-summary-dummy-line-format)
3050 (make-local-variable 'gnus-summary-dummy-line-format-spec)
eec82323 3051 (make-local-variable 'gnus-summary-mark-positions)
23f87bed 3052 (gnus-make-local-hook 'pre-command-hook)
6748645f 3053 (add-hook 'pre-command-hook 'gnus-set-global-variables nil t)
cfcd5c91 3054 (gnus-run-mode-hooks 'gnus-summary-mode-hook)
23f87bed 3055 (turn-on-gnus-mailing-list-mode)
87545352 3056 (mm-enable-multibyte)
eec82323
LMI
3057 (gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy)
3058 (gnus-update-summary-mark-positions))
3059
3060(defun gnus-summary-make-local-variables ()
3061 "Make all the local summary buffer variables."
16409b0b
GM
3062 (let (global)
3063 (dolist (local gnus-summary-local-variables)
eec82323
LMI
3064 (if (consp local)
3065 (progn
3066 (if (eq (cdr local) 'global)
3067 ;; Copy the global value of the variable.
3068 (setq global (symbol-value (car local)))
3069 ;; Use the value from the list.
3070 (setq global (eval (cdr local))))
16409b0b 3071 (set (make-local-variable (car local)) global))
eec82323 3072 ;; Simple nil-valued local variable.
16409b0b 3073 (set (make-local-variable local) nil)))))
eec82323
LMI
3074
3075(defun gnus-summary-clear-local-variables ()
3076 (let ((locals gnus-summary-local-variables))
3077 (while locals
3078 (if (consp (car locals))
01c52d31 3079 (and (symbolp (caar locals))
eec82323 3080 (set (caar locals) nil))
01c52d31 3081 (and (symbolp (car locals))
eec82323
LMI
3082 (set (car locals) nil)))
3083 (setq locals (cdr locals)))))
3084
3085;; Summary data functions.
3086
3087(defmacro gnus-data-number (data)
3088 `(car ,data))
3089
3090(defmacro gnus-data-set-number (data number)
3091 `(setcar ,data ,number))
3092
3093(defmacro gnus-data-mark (data)
3094 `(nth 1 ,data))
3095
3096(defmacro gnus-data-set-mark (data mark)
3097 `(setcar (nthcdr 1 ,data) ,mark))
3098
3099(defmacro gnus-data-pos (data)
3100 `(nth 2 ,data))
3101
3102(defmacro gnus-data-set-pos (data pos)
3103 `(setcar (nthcdr 2 ,data) ,pos))
3104
3105(defmacro gnus-data-header (data)
3106 `(nth 3 ,data))
3107
3108(defmacro gnus-data-set-header (data header)
3109 `(setf (nth 3 ,data) ,header))
3110
3111(defmacro gnus-data-level (data)
3112 `(nth 4 ,data))
3113
3114(defmacro gnus-data-unread-p (data)
3115 `(= (nth 1 ,data) gnus-unread-mark))
3116
3117(defmacro gnus-data-read-p (data)
3118 `(/= (nth 1 ,data) gnus-unread-mark))
3119
3120(defmacro gnus-data-pseudo-p (data)
3121 `(consp (nth 3 ,data)))
3122
3123(defmacro gnus-data-find (number)
3124 `(assq ,number gnus-newsgroup-data))
3125
3126(defmacro gnus-data-find-list (number &optional data)
3127 `(let ((bdata ,(or data 'gnus-newsgroup-data)))
3128 (memq (assq ,number bdata)
3129 bdata)))
3130
3131(defmacro gnus-data-make (number mark pos header level)
3132 `(list ,number ,mark ,pos ,header ,level))
3133
3134(defun gnus-data-enter (after-article number mark pos header level offset)
3135 (let ((data (gnus-data-find-list after-article)))
3136 (unless data
3137 (error "No such article: %d" after-article))
3138 (setcdr data (cons (gnus-data-make number mark pos header level)
3139 (cdr data)))
3140 (setq gnus-newsgroup-data-reverse nil)
3141 (gnus-data-update-list (cddr data) offset)))
3142
3143(defun gnus-data-enter-list (after-article list &optional offset)
3144 (when list
3145 (let ((data (and after-article (gnus-data-find-list after-article)))
3146 (ilist list))
6748645f
LMI
3147 (if (not (or data
3148 after-article))
3149 (let ((odata gnus-newsgroup-data))
3150 (setq gnus-newsgroup-data (nconc list gnus-newsgroup-data))
eec82323 3151 (when offset
6748645f 3152 (gnus-data-update-list odata offset)))
01c52d31 3153 ;; Find the last element in the list to be spliced into the main
6748645f 3154 ;; list.
01c52d31 3155 (setq list (last list))
6748645f
LMI
3156 (if (not data)
3157 (progn
3158 (setcdr list gnus-newsgroup-data)
3159 (setq gnus-newsgroup-data ilist)
3160 (when offset
3161 (gnus-data-update-list (cdr list) offset)))
3162 (setcdr list (cdr data))
3163 (setcdr data ilist)
3164 (when offset
3165 (gnus-data-update-list (cdr list) offset))))
eec82323
LMI
3166 (setq gnus-newsgroup-data-reverse nil))))
3167
3168(defun gnus-data-remove (article &optional offset)
3169 (let ((data gnus-newsgroup-data))
3170 (if (= (gnus-data-number (car data)) article)
3171 (progn
3172 (setq gnus-newsgroup-data (cdr gnus-newsgroup-data)
3173 gnus-newsgroup-data-reverse nil)
3174 (when offset
3175 (gnus-data-update-list gnus-newsgroup-data offset)))
3176 (while (cdr data)
3177 (when (= (gnus-data-number (cadr data)) article)
3178 (setcdr data (cddr data))
3179 (when offset
3180 (gnus-data-update-list (cdr data) offset))
3181 (setq data nil
3182 gnus-newsgroup-data-reverse nil))
3183 (setq data (cdr data))))))
3184
3185(defmacro gnus-data-list (backward)
3186 `(if ,backward
3187 (or gnus-newsgroup-data-reverse
3188 (setq gnus-newsgroup-data-reverse
3189 (reverse gnus-newsgroup-data)))
3190 gnus-newsgroup-data))
3191
3192(defun gnus-data-update-list (data offset)
3193 "Add OFFSET to the POS of all data entries in DATA."
6748645f 3194 (setq gnus-newsgroup-data-reverse nil)
eec82323
LMI
3195 (while data
3196 (setcar (nthcdr 2 (car data)) (+ offset (nth 2 (car data))))
3197 (setq data (cdr data))))
3198
eec82323
LMI
3199(defun gnus-summary-article-pseudo-p (article)
3200 "Say whether this article is a pseudo article or not."
3201 (not (vectorp (gnus-data-header (gnus-data-find article)))))
3202
3203(defmacro gnus-summary-article-sparse-p (article)
3204 "Say whether this article is a sparse article or not."
a8151ef7 3205 `(memq ,article gnus-newsgroup-sparse))
eec82323
LMI
3206
3207(defmacro gnus-summary-article-ancient-p (article)
3208 "Say whether this article is a sparse article or not."
3209 `(memq ,article gnus-newsgroup-ancient))
3210
3211(defun gnus-article-parent-p (number)
3212 "Say whether this article is a parent or not."
3213 (let ((data (gnus-data-find-list number)))
23f87bed 3214 (and (cdr data) ; There has to be an article after...
eec82323
LMI
3215 (< (gnus-data-level (car data)) ; And it has to have a higher level.
3216 (gnus-data-level (nth 1 data))))))
3217
3218(defun gnus-article-children (number)
3219 "Return a list of all children to NUMBER."
3220 (let* ((data (gnus-data-find-list number))
3221 (level (gnus-data-level (car data)))
3222 children)
3223 (setq data (cdr data))
3224 (while (and data
3225 (= (gnus-data-level (car data)) (1+ level)))
3226 (push (gnus-data-number (car data)) children)
3227 (setq data (cdr data)))
3228 children))
3229
3230(defmacro gnus-summary-skip-intangible ()
3231 "If the current article is intangible, then jump to a different article."
3232 '(let ((to (get-text-property (point) 'gnus-intangible)))
3233 (and to (gnus-summary-goto-subject to))))
3234
3235(defmacro gnus-summary-article-intangible-p ()
3236 "Say whether this article is intangible or not."
3237 '(get-text-property (point) 'gnus-intangible))
3238
3239(defun gnus-article-read-p (article)
3240 "Say whether ARTICLE is read or not."
3241 (not (or (memq article gnus-newsgroup-marked)
23f87bed 3242 (memq article gnus-newsgroup-spam-marked)
eec82323
LMI
3243 (memq article gnus-newsgroup-unreads)
3244 (memq article gnus-newsgroup-unselected)
3245 (memq article gnus-newsgroup-dormant))))
3246
3247;; Some summary mode macros.
3248
3249(defmacro gnus-summary-article-number ()
3250 "The article number of the article on the current line.
8f688cb0 3251If there isn't an article number here, then we return the current
eec82323
LMI
3252article number."
3253 '(progn
3254 (gnus-summary-skip-intangible)
3255 (or (get-text-property (point) 'gnus-number)
3256 (gnus-summary-last-subject))))
3257
3258(defmacro gnus-summary-article-header (&optional number)
6748645f 3259 "Return the header of article NUMBER."
eec82323
LMI
3260 `(gnus-data-header (gnus-data-find
3261 ,(or number '(gnus-summary-article-number)))))
3262
3263(defmacro gnus-summary-thread-level (&optional number)
6748645f 3264 "Return the level of thread that starts with article NUMBER."
eec82323
LMI
3265 `(if (and (eq gnus-summary-make-false-root 'dummy)
3266 (get-text-property (point) 'gnus-intangible))
3267 0
3268 (gnus-data-level (gnus-data-find
3269 ,(or number '(gnus-summary-article-number))))))
3270
3271(defmacro gnus-summary-article-mark (&optional number)
6748645f 3272 "Return the mark of article NUMBER."
eec82323
LMI
3273 `(gnus-data-mark (gnus-data-find
3274 ,(or number '(gnus-summary-article-number)))))
3275
3276(defmacro gnus-summary-article-pos (&optional number)
6748645f 3277 "Return the position of the line of article NUMBER."
eec82323
LMI
3278 `(gnus-data-pos (gnus-data-find
3279 ,(or number '(gnus-summary-article-number)))))
3280
3281(defalias 'gnus-summary-subject-string 'gnus-summary-article-subject)
3282(defmacro gnus-summary-article-subject (&optional number)
3283 "Return current subject string or nil if nothing."
3284 `(let ((headers
3285 ,(if number
3286 `(gnus-data-header (assq ,number gnus-newsgroup-data))
3287 '(gnus-data-header (assq (gnus-summary-article-number)
3288 gnus-newsgroup-data)))))
3289 (and headers
3290 (vectorp headers)
3291 (mail-header-subject headers))))
3292
3293(defmacro gnus-summary-article-score (&optional number)
3294 "Return current article score."
3295 `(or (cdr (assq ,(or number '(gnus-summary-article-number))
3296 gnus-newsgroup-scored))
3297 gnus-summary-default-score 0))
3298
3299(defun gnus-summary-article-children (&optional number)
6748645f 3300 "Return a list of article numbers that are children of article NUMBER."
eec82323
LMI
3301 (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))))
3302 (level (gnus-data-level (car data)))
3303 l children)
3304 (while (and (setq data (cdr data))
3305 (> (setq l (gnus-data-level (car data))) level))
3306 (and (= (1+ level) l)
3307 (push (gnus-data-number (car data))
3308 children)))
3309 (nreverse children)))
3310
3311(defun gnus-summary-article-parent (&optional number)
6748645f 3312 "Return the article number of the parent of article NUMBER."
eec82323
LMI
3313 (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))
3314 (gnus-data-list t)))
3315 (level (gnus-data-level (car data))))
3316 (if (zerop level)
3317 () ; This is a root.
3318 ;; We search until we find an article with a level less than
3319 ;; this one. That function has to be the parent.
3320 (while (and (setq data (cdr data))
3321 (not (< (gnus-data-level (car data)) level))))
3322 (and data (gnus-data-number (car data))))))
3323
3324(defun gnus-unread-mark-p (mark)
3325 "Say whether MARK is the unread mark."
3326 (= mark gnus-unread-mark))
3327
3328(defun gnus-read-mark-p (mark)
3329 "Say whether MARK is one of the marks that mark as read.
3330This is all marks except unread, ticked, dormant, and expirable."
3331 (not (or (= mark gnus-unread-mark)
3332 (= mark gnus-ticked-mark)
23f87bed 3333 (= mark gnus-spam-mark)
eec82323
LMI
3334 (= mark gnus-dormant-mark)
3335 (= mark gnus-expirable-mark))))
3336
3337(defmacro gnus-article-mark (number)
6748645f
LMI
3338 "Return the MARK of article NUMBER.
3339This macro should only be used when computing the mark the \"first\"
3340time; i.e., when generating the summary lines. After that,
3341`gnus-summary-article-mark' should be used to examine the
3342marks of articles."
eec82323 3343 `(cond
6748645f 3344 ((memq ,number gnus-newsgroup-unsendable) gnus-unsendable-mark)
6748645f 3345 ((memq ,number gnus-newsgroup-downloadable) gnus-downloadable-mark)
eec82323
LMI
3346 ((memq ,number gnus-newsgroup-unreads) gnus-unread-mark)
3347 ((memq ,number gnus-newsgroup-marked) gnus-ticked-mark)
23f87bed 3348 ((memq ,number gnus-newsgroup-spam-marked) gnus-spam-mark)
eec82323
LMI
3349 ((memq ,number gnus-newsgroup-dormant) gnus-dormant-mark)
3350 ((memq ,number gnus-newsgroup-expirable) gnus-expirable-mark)
3351 (t (or (cdr (assq ,number gnus-newsgroup-reads))
3352 gnus-ancient-mark))))
3353
3354;; Saving hidden threads.
3355
eec82323
LMI
3356(defmacro gnus-save-hidden-threads (&rest forms)
3357 "Save hidden threads, eval FORMS, and restore the hidden threads."
3358 (let ((config (make-symbol "config")))
3359 `(let ((,config (gnus-hidden-threads-configuration)))
3360 (unwind-protect
3361 (save-excursion
3362 ,@forms)
3363 (gnus-restore-hidden-threads-configuration ,config)))))
23f87bed
MB
3364(put 'gnus-save-hidden-threads 'lisp-indent-function 0)
3365(put 'gnus-save-hidden-threads 'edebug-form-spec '(body))
eec82323 3366
107ecebb
AS
3367(defun gnus-data-compute-positions ()
3368 "Compute the positions of all articles."
3369 (setq gnus-newsgroup-data-reverse nil)
3370 (let ((data gnus-newsgroup-data))
3371 (save-excursion
3372 (gnus-save-hidden-threads
3373 (gnus-summary-show-all-threads)
3374 (goto-char (point-min))
3375 (while data
3376 (while (get-text-property (point) 'gnus-intangible)
3377 (forward-line 1))
3378 (gnus-data-set-pos (car data) (+ (point) 3))
3379 (setq data (cdr data))
3380 (forward-line 1))))))
3381
16409b0b
GM
3382(defun gnus-hidden-threads-configuration ()
3383 "Return the current hidden threads configuration."
3384 (save-excursion
3385 (let (config)
3386 (goto-char (point-min))
3387 (while (search-forward "\r" nil t)
3388 (push (1- (point)) config))
3389 config)))
3390
3391(defun gnus-restore-hidden-threads-configuration (config)
3392 "Restore hidden threads configuration from CONFIG."
3393 (save-excursion
c7a91ce1 3394 (let (point (inhibit-read-only t))
16409b0b
GM
3395 (while (setq point (pop config))
3396 (when (and (< point (point-max))
3397 (goto-char point)
3398 (eq (char-after) ?\n))
3399 (subst-char-in-region point (1+ point) ?\n ?\r))))))
3400
eec82323
LMI
3401;; Various summary mode internalish functions.
3402
3403(defun gnus-mouse-pick-article (e)
3404 (interactive "e")
3405 (mouse-set-point e)
3406 (gnus-summary-next-page nil t))
3407
3408(defun gnus-summary-set-display-table ()
16409b0b
GM
3409 "Change the display table.
3410Odd characters have a tendency to mess
3411up nicely formatted displays - we make all possible glyphs
3412display only a single character."
eec82323
LMI
3413
3414 ;; We start from the standard display table, if any.
3415 (let ((table (or (copy-sequence standard-display-table)
3416 (make-display-table)))
3417 (i 32))
3418 ;; Nix out all the control chars...
3419 (while (>= (setq i (1- i)) 0)
3420 (aset table i [??]))
23f87bed 3421 ;; ... but not newline and cr, of course. (cr is necessary for the
eec82323
LMI
3422 ;; selective display).
3423 (aset table ?\n nil)
3424 (aset table ?\r nil)
6748645f
LMI
3425 ;; We keep TAB as well.
3426 (aset table ?\t nil)
719120ef 3427 ;; We nix out any glyphs 127 through 255, or 127 through 159 in
fe62aacc 3428 ;; Emacs 23 (unicode), that are not set already.
719120ef
MB
3429 (let ((i (if (ignore-errors (= (make-char 'latin-iso8859-1 160) 160))
3430 160
3431 256)))
eec82323
LMI
3432 (while (>= (setq i (1- i)) 127)
3433 ;; Only modify if the entry is nil.
3434 (unless (aref table i)
3435 (aset table i [??]))))
3436 (setq buffer-display-table table)))
3437
23f87bed
MB
3438(defun gnus-summary-set-article-display-arrow (pos)
3439 "Update the overlay arrow to point to line at position POS."
3440 (when (and gnus-summary-display-arrow
3441 (boundp 'overlay-arrow-position)
3442 (boundp 'overlay-arrow-string))
3443 (save-excursion
3444 (goto-char pos)
3445 (beginning-of-line)
3446 (unless overlay-arrow-position
3447 (setq overlay-arrow-position (make-marker)))
3448 (setq overlay-arrow-string "=>"
3449 overlay-arrow-position (set-marker overlay-arrow-position
3450 (point)
3451 (current-buffer))))))
3452
eec82323
LMI
3453(defun gnus-summary-setup-buffer (group)
3454 "Initialize summary buffer."
23f87bed
MB
3455 (let ((buffer (gnus-summary-buffer-name group))
3456 (dead-name (concat "*Dead Summary "
3457 (gnus-group-decoded-name group) "*")))
3458 ;; If a dead summary buffer exists, we kill it.
3459 (when (gnus-buffer-live-p dead-name)
3460 (gnus-kill-buffer dead-name))
eec82323
LMI
3461 (if (get-buffer buffer)
3462 (progn
3463 (set-buffer buffer)
3464 (setq gnus-summary-buffer (current-buffer))
3465 (not gnus-newsgroup-prepared))
3466 ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
6748645f 3467 (setq gnus-summary-buffer (set-buffer (gnus-get-buffer-create buffer)))
eec82323
LMI
3468 (gnus-summary-mode group)
3469 (when gnus-carpal
3470 (gnus-carpal-setup-buffer 'summary))
01c52d31
MB
3471 (when (gnus-group-quit-config group)
3472 (set (make-local-variable 'gnus-single-article-buffer) nil))
3473 (make-local-variable 'gnus-article-buffer)
3474 (make-local-variable 'gnus-article-current)
3475 (make-local-variable 'gnus-original-article-buffer)
eec82323 3476 (setq gnus-newsgroup-name group)
23f87bed
MB
3477 ;; Set any local variables in the group parameters.
3478 (gnus-summary-set-local-parameters gnus-newsgroup-name)
eec82323
LMI
3479 t)))
3480
3481(defun gnus-set-global-variables ()
16409b0b
GM
3482 "Set the global equivalents of the buffer-local variables.
3483They are set to the latest values they had. These reflect the summary
3484buffer that was in action when the last article was fetched."
eec82323
LMI
3485 (when (eq major-mode 'gnus-summary-mode)
3486 (setq gnus-summary-buffer (current-buffer))
3487 (let ((name gnus-newsgroup-name)
3488 (marked gnus-newsgroup-marked)
23f87bed 3489 (spam gnus-newsgroup-spam-marked)
eec82323
LMI
3490 (unread gnus-newsgroup-unreads)
3491 (headers gnus-current-headers)
3492 (data gnus-newsgroup-data)
3493 (summary gnus-summary-buffer)
3494 (article-buffer gnus-article-buffer)
3495 (original gnus-original-article-buffer)
3496 (gac gnus-article-current)
3497 (reffed gnus-reffed-article-number)
16409b0b 3498 (score-file gnus-current-score-file)
23f87bed
MB
3499 (default-charset gnus-newsgroup-charset)
3500 vlist)
3501 (let ((locals gnus-newsgroup-variables))
3502 (while locals
3503 (if (consp (car locals))
3504 (push (eval (caar locals)) vlist)
3505 (push (eval (car locals)) vlist))
3506 (setq locals (cdr locals)))
3507 (setq vlist (nreverse vlist)))
01c52d31 3508 (with-current-buffer gnus-group-buffer
6748645f
LMI
3509 (setq gnus-newsgroup-name name
3510 gnus-newsgroup-marked marked
23f87bed 3511 gnus-newsgroup-spam-marked spam
6748645f
LMI
3512 gnus-newsgroup-unreads unread
3513 gnus-current-headers headers
3514 gnus-newsgroup-data data
3515 gnus-article-current gac
3516 gnus-summary-buffer summary
3517 gnus-article-buffer article-buffer
3518 gnus-original-article-buffer original
3519 gnus-reffed-article-number reffed
16409b0b
GM
3520 gnus-current-score-file score-file
3521 gnus-newsgroup-charset default-charset)
23f87bed
MB
3522 (let ((locals gnus-newsgroup-variables))
3523 (while locals
3524 (if (consp (car locals))
3525 (set (caar locals) (pop vlist))
3526 (set (car locals) (pop vlist)))
3527 (setq locals (cdr locals))))
eec82323
LMI
3528 ;; The article buffer also has local variables.
3529 (when (gnus-buffer-live-p gnus-article-buffer)
3530 (set-buffer gnus-article-buffer)
3531 (setq gnus-summary-buffer summary))))))
3532
3533(defun gnus-summary-article-unread-p (article)
3534 "Say whether ARTICLE is unread or not."
3535 (memq article gnus-newsgroup-unreads))
3536
3537(defun gnus-summary-first-article-p (&optional article)
3538 "Return whether ARTICLE is the first article in the buffer."
3539 (if (not (setq article (or article (gnus-summary-article-number))))
3540 nil
3541 (eq article (caar gnus-newsgroup-data))))
3542
3543(defun gnus-summary-last-article-p (&optional article)
3544 "Return whether ARTICLE is the last article in the buffer."
3545 (if (not (setq article (or article (gnus-summary-article-number))))
16409b0b
GM
3546 ;; All non-existent numbers are the last article. :-)
3547 t
eec82323
LMI
3548 (not (cdr (gnus-data-find-list article)))))
3549
4921bbdd
CY
3550(defun gnus-make-thread-indent-array (&optional n)
3551 (when (or n
3552 (progn (setq n 200) nil)
3553 (null gnus-thread-indent-array)
3554 (/= gnus-thread-indent-level gnus-thread-indent-array-level))
3555 (setq gnus-thread-indent-array (make-vector (1+ n) "")
3556 gnus-thread-indent-array-level gnus-thread-indent-level)
3557 (while (>= n 0)
3558 (aset gnus-thread-indent-array n
6a30c01d 3559 (make-string (* n gnus-thread-indent-level) ? ))
4921bbdd 3560 (setq n (1- n)))))
eec82323
LMI
3561
3562(defun gnus-update-summary-mark-positions ()
3563 "Compute where the summary marks are to go."
3564 (save-excursion
6748645f 3565 (when (gnus-buffer-exists-p gnus-summary-buffer)
eec82323 3566 (set-buffer gnus-summary-buffer))
5153a47a
MB
3567 (let ((spec gnus-summary-line-format-spec)
3568 pos)
eec82323
LMI
3569 (save-excursion
3570 (gnus-set-work-buffer)
5153a47a
MB
3571 (let ((gnus-tmp-unread ?Z)
3572 (gnus-replied-mark ?Z)
3573 (gnus-score-below-mark ?Z)
3574 (gnus-score-over-mark ?Z)
3575 (gnus-undownloaded-mark ?Z)
3576 (gnus-summary-line-format-spec spec)
54506618 3577 (gnus-newsgroup-downloadable '(0))
5153a47a
MB
3578 (header [0 "" "" "05 Apr 2001 23:33:09 +0400" "" "" 0 0 "" nil])
3579 case-fold-search ignores)
3580 ;; Here, all marks are bound to Z.
3581 (gnus-summary-insert-line header
3582 0 nil t gnus-tmp-unread t nil "" nil 1)
3583 (goto-char (point-min))
3584 ;; Memorize the positions of the same characters as dummy marks.
3585 (while (re-search-forward "[A-D]" nil t)
3586 (push (point) ignores))
54506618 3587 (erase-buffer)
5153a47a
MB
3588 ;; We use A-D as dummy marks in order to know column positions
3589 ;; where marks should be inserted.
3590 (setq gnus-tmp-unread ?A
3591 gnus-replied-mark ?B
3592 gnus-score-below-mark ?C
3593 gnus-score-over-mark ?C
3594 gnus-undownloaded-mark ?D)
3595 (gnus-summary-insert-line header
3596 0 nil t gnus-tmp-unread t nil "" nil 1)
3597 ;; Ignore characters which aren't dummy marks.
3598 (dolist (p ignores)
3599 (delete-region (goto-char (1- p)) p)
3600 (insert ?Z))
eec82323 3601 (goto-char (point-min))
7c3bb5a5 3602 (setq pos (list (cons 'unread
5153a47a 3603 (and (search-forward "A" nil t)
7c3bb5a5 3604 (- (point) (point-min) 1)))))
eec82323 3605 (goto-char (point-min))
5153a47a 3606 (push (cons 'replied (and (search-forward "B" nil t)
667e0ba6 3607 (- (point) (point-min) 1)))
eec82323
LMI
3608 pos)
3609 (goto-char (point-min))
5153a47a 3610 (push (cons 'score (and (search-forward "C" nil t)
667e0ba6 3611 (- (point) (point-min) 1)))
6748645f
LMI
3612 pos)
3613 (goto-char (point-min))
5153a47a 3614 (push (cons 'download (and (search-forward "D" nil t)
7c3bb5a5 3615 (- (point) (point-min) 1)))
eec82323
LMI
3616 pos)))
3617 (setq gnus-summary-mark-positions pos))))
3618
3619(defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number)
3620 "Insert a dummy root in the summary buffer."
3621 (beginning-of-line)
3622 (gnus-add-text-properties
3623 (point) (progn (eval gnus-summary-dummy-line-format-spec) (point))
3624 (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number)))
3625
23f87bed
MB
3626(defun gnus-summary-extract-address-component (from)
3627 (or (car (funcall gnus-extract-address-components from))
3628 from))
3629
3630(defun gnus-summary-from-or-to-or-newsgroups (header gnus-tmp-from)
3631 (let ((mail-parse-charset gnus-newsgroup-charset)
01c52d31 3632 (ignored-from-addresses (gnus-ignored-from-addresses))
23f87bed
MB
3633 ; Is it really necessary to do this next part for each summary line?
3634 ; Luckily, doesn't seem to slow things down much.
16409b0b 3635 (mail-parse-ignored-charsets
01c52d31
MB
3636 (with-current-buffer gnus-summary-buffer
3637 gnus-newsgroup-ignored-charsets)))
23f87bed 3638 (or
01c52d31
MB
3639 (and ignored-from-addresses
3640 (string-match ignored-from-addresses gnus-tmp-from)
23f87bed
MB
3641 (let ((extra-headers (mail-header-extra header))
3642 to
3643 newsgroups)
3644 (cond
3645 ((setq to (cdr (assq 'To extra-headers)))
01c52d31 3646 (concat gnus-summary-to-prefix
23f87bed
MB
3647 (inline
3648 (gnus-summary-extract-address-component
343d6628 3649 (funcall gnus-decode-encoded-address-function to)))))
01c52d31
MB
3650 ((setq newsgroups
3651 (or
3652 (cdr (assq 'Newsgroups extra-headers))
3653 (and
3654 (memq 'Newsgroups gnus-extra-headers)
3655 (eq (car (gnus-find-method-for-group
3656 gnus-newsgroup-name)) 'nntp)
3657 (gnus-group-real-name gnus-newsgroup-name))))
3658 (concat gnus-summary-newsgroup-prefix newsgroups)))))
23f87bed 3659 (inline (gnus-summary-extract-address-component gnus-tmp-from)))))
16409b0b 3660
eec82323
LMI
3661(defun gnus-summary-insert-line (gnus-tmp-header
3662 gnus-tmp-level gnus-tmp-current
23f87bed 3663 undownloaded gnus-tmp-unread gnus-tmp-replied
eec82323
LMI
3664 gnus-tmp-expirable gnus-tmp-subject-or-nil
3665 &optional gnus-tmp-dummy gnus-tmp-score
3666 gnus-tmp-process)
4921bbdd
CY
3667 (if (>= gnus-tmp-level (length gnus-thread-indent-array))
3668 (gnus-make-thread-indent-array (max (* 2 (length gnus-thread-indent-array))
3669 gnus-tmp-level)))
eec82323
LMI
3670 (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level))
3671 (gnus-tmp-lines (mail-header-lines gnus-tmp-header))
3672 (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0))
3673 (gnus-tmp-score-char
3674 (if (or (null gnus-summary-default-score)
3675 (<= (abs (- gnus-tmp-score gnus-summary-default-score))
3676 gnus-summary-zcore-fuzz))
23f87bed 3677 ? ;Whitespace
eec82323
LMI
3678 (if (< gnus-tmp-score gnus-summary-default-score)
3679 gnus-score-below-mark gnus-score-over-mark)))
23f87bed 3680 (gnus-tmp-number (mail-header-number gnus-tmp-header))
eec82323
LMI
3681 (gnus-tmp-replied
3682 (cond (gnus-tmp-process gnus-process-mark)
3683 ((memq gnus-tmp-current gnus-newsgroup-cached)
3684 gnus-cached-mark)
3685 (gnus-tmp-replied gnus-replied-mark)
23f87bed
MB
3686 ((memq gnus-tmp-current gnus-newsgroup-forwarded)
3687 gnus-forwarded-mark)
eec82323
LMI
3688 ((memq gnus-tmp-current gnus-newsgroup-saved)
3689 gnus-saved-mark)
23f87bed
MB
3690 ((memq gnus-tmp-number gnus-newsgroup-recent)
3691 gnus-recent-mark)
3692 ((memq gnus-tmp-number gnus-newsgroup-unseen)
3693 gnus-unseen-mark)
3694 (t gnus-no-mark)))
3695 (gnus-tmp-downloaded
3696 (cond (undownloaded
3697 gnus-undownloaded-mark)
3698 (gnus-newsgroup-agentized
3699 gnus-downloaded-mark)
3700 (t
3701 gnus-no-mark)))
eec82323
LMI
3702 (gnus-tmp-from (mail-header-from gnus-tmp-header))
3703 (gnus-tmp-name
3704 (cond
3705 ((string-match "<[^>]+> *$" gnus-tmp-from)
3706 (let ((beg (match-beginning 0)))
23f87bed
MB
3707 (or (and (string-match "^\".+\"" gnus-tmp-from)
3708 (substring gnus-tmp-from 1 (1- (match-end 0))))
eec82323
LMI
3709 (substring gnus-tmp-from 0 beg))))
3710 ((string-match "(.+)" gnus-tmp-from)
3711 (substring gnus-tmp-from
3712 (1+ (match-beginning 0)) (1- (match-end 0))))
3713 (t gnus-tmp-from)))
3714 (gnus-tmp-subject (mail-header-subject gnus-tmp-header))
eec82323
LMI
3715 (gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[))
3716 (gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\]))
c7a91ce1 3717 (inhibit-read-only t))
eec82323
LMI
3718 (when (string= gnus-tmp-name "")
3719 (setq gnus-tmp-name gnus-tmp-from))
3720 (unless (numberp gnus-tmp-lines)
23f87bed
MB
3721 (setq gnus-tmp-lines -1))
3722 (if (= gnus-tmp-lines -1)
3723 (setq gnus-tmp-lines "?")
3724 (setq gnus-tmp-lines (number-to-string gnus-tmp-lines)))
3725 (gnus-put-text-property
eec82323
LMI
3726 (point)
3727 (progn (eval gnus-summary-line-format-spec) (point))
23f87bed 3728 'gnus-number gnus-tmp-number)
eec82323
LMI
3729 (when (gnus-visual-p 'summary-highlight 'highlight)
3730 (forward-line -1)
6748645f 3731 (gnus-run-hooks 'gnus-summary-update-hook)
eec82323
LMI
3732 (forward-line 1))))
3733
3734(defun gnus-summary-update-line (&optional dont-update)
16409b0b 3735 "Update summary line after change."
eec82323
LMI
3736 (when (and gnus-summary-default-score
3737 (not gnus-summary-inhibit-highlight))
3738 (let* ((gnus-summary-inhibit-highlight t) ; Prevent recursion.
3739 (article (gnus-summary-article-number))
3740 (score (gnus-summary-article-score article)))
3741 (unless dont-update
3742 (if (and gnus-summary-mark-below
3743 (< (gnus-summary-article-score)
3744 gnus-summary-mark-below))
3745 ;; This article has a low score, so we mark it as read.
3746 (when (memq article gnus-newsgroup-unreads)
3747 (gnus-summary-mark-article-as-read gnus-low-score-mark))
3748 (when (eq (gnus-summary-article-mark) gnus-low-score-mark)
3749 ;; This article was previously marked as read on account
3750 ;; of a low score, but now it has risen, so we mark it as
3751 ;; unread.
3752 (gnus-summary-mark-article-as-unread gnus-unread-mark)))
3753 (gnus-summary-update-mark
3754 (if (or (null gnus-summary-default-score)
3755 (<= (abs (- score gnus-summary-default-score))
3756 gnus-summary-zcore-fuzz))
23f87bed 3757 ? ;Whitespace
eec82323
LMI
3758 (if (< score gnus-summary-default-score)
3759 gnus-score-below-mark gnus-score-over-mark))
3760 'score))
3761 ;; Do visual highlighting.
3762 (when (gnus-visual-p 'summary-highlight 'highlight)
6748645f 3763 (gnus-run-hooks 'gnus-summary-update-hook)))))
eec82323
LMI
3764
3765(defvar gnus-tmp-new-adopts nil)
3766
3767(defun gnus-summary-number-of-articles-in-thread (thread &optional level char)
3768 "Return the number of articles in THREAD.
3769This may be 0 in some cases -- if none of the articles in
3770the thread are to be displayed."
3771 (let* ((number
23f87bed 3772 ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
eec82323
LMI
3773 (cond
3774 ((not (listp thread))
3775 1)
3776 ((and (consp thread) (cdr thread))
3777 (apply
3778 '+ 1 (mapcar
3779 'gnus-summary-number-of-articles-in-thread (cdr thread))))
3780 ((null thread)
3781 1)
3782 ((memq (mail-header-number (car thread)) gnus-newsgroup-limit)
3783 1)
3784 (t 0))))
3785 (when (and level (zerop level) gnus-tmp-new-adopts)
3786 (incf number
3787 (apply '+ (mapcar
3788 'gnus-summary-number-of-articles-in-thread
3789 gnus-tmp-new-adopts))))
3790 (if char
3791 (if (> number 1) gnus-not-empty-thread-mark
3792 gnus-empty-thread-mark)
3793 number)))
3794
23f87bed
MB
3795(defsubst gnus-summary-line-message-size (head)
3796 "Return pretty-printed version of message size.
3797This function is intended to be used in
3798`gnus-summary-line-format-alist'."
3799 (let ((c (or (mail-header-chars head) -1)))
3800 (cond ((< c 0) "n/a") ; chars not available
3801 ((< c (* 1000 10)) (format "%1.1fk" (/ c 1024.0)))
3802 ((< c (* 1000 100)) (format "%dk" (/ c 1024.0)))
3803 ((< c (* 1000 10000)) (format "%1.1fM" (/ c (* 1024.0 1024))))
3804 (t (format "%dM" (/ c (* 1024.0 1024)))))))
3805
3806
eec82323
LMI
3807(defun gnus-summary-set-local-parameters (group)
3808 "Go through the local params of GROUP and set all variable specs in that list."
01c52d31
MB
3809 (let ((vars '(quit-config))) ; Ignore quit-config.
3810 (dolist (elem (gnus-group-find-parameter group))
eec82323
LMI
3811 (and (consp elem) ; Has to be a cons.
3812 (consp (cdr elem)) ; The cdr has to be a list.
3813 (symbolp (car elem)) ; Has to be a symbol in there.
23f87bed 3814 (not (memq (car elem) vars))
eec82323 3815 (ignore-errors ; So we set it.
23f87bed 3816 (push (car elem) vars)
eec82323
LMI
3817 (make-local-variable (car elem))
3818 (set (car elem) (eval (nth 1 elem))))))))
3819
3820(defun gnus-summary-read-group (group &optional show-all no-article
6748645f
LMI
3821 kill-buffer no-display backward
3822 select-articles)
eec82323
LMI
3823 "Start reading news in newsgroup GROUP.
3824If SHOW-ALL is non-nil, already read articles are also listed.
3825If NO-ARTICLE is non-nil, no article is selected initially.
3826If NO-DISPLAY, don't generate a summary buffer."
3827 (let (result)
3828 (while (and group
3829 (null (setq result
3830 (let ((gnus-auto-select-next nil))
6748645f
LMI
3831 (or (gnus-summary-read-group-1
3832 group show-all no-article
3833 kill-buffer no-display
3834 select-articles)
3835 (setq show-all nil
16409b0b 3836 select-articles nil)))))
eec82323
LMI
3837 (eq gnus-auto-select-next 'quietly))
3838 (set-buffer gnus-group-buffer)
6748645f
LMI
3839 ;; The entry function called above goes to the next
3840 ;; group automatically, so we go two groups back
3841 ;; if we are searching for the previous group.
3842 (when backward
3843 (gnus-group-prev-unread-group 2))
eec82323
LMI
3844 (if (not (equal group (gnus-group-group-name)))
3845 (setq group (gnus-group-group-name))
3846 (setq group nil)))
3847 result))
3848
3849(defun gnus-summary-read-group-1 (group show-all no-article
6748645f
LMI
3850 kill-buffer no-display
3851 &optional select-articles)
eec82323 3852 ;; Killed foreign groups can't be entered.
23f87bed
MB
3853 ;; (when (and (not (gnus-group-native-p group))
3854 ;; (not (gnus-gethash group gnus-newsrc-hashtb)))
3855 ;; (error "Dead non-native groups can't be entered"))
3856 (gnus-message 5 "Retrieving newsgroup: %s..."
3857 (gnus-group-decoded-name group))
eec82323
LMI
3858 (let* ((new-group (gnus-summary-setup-buffer group))
3859 (quit-config (gnus-group-quit-config group))
6748645f
LMI
3860 (did-select (and new-group (gnus-select-newsgroup
3861 group show-all select-articles))))
eec82323
LMI
3862 (cond
3863 ;; This summary buffer exists already, so we just select it.
3864 ((not new-group)
3865 (gnus-set-global-variables)
3866 (when kill-buffer
3867 (gnus-kill-or-deaden-summary kill-buffer))
3868 (gnus-configure-windows 'summary 'force)
3869 (gnus-set-mode-line 'summary)
3870 (gnus-summary-position-point)
3871 (message "")
3872 t)
3873 ;; We couldn't select this group.
3874 ((null did-select)
3875 (when (and (eq major-mode 'gnus-summary-mode)
3876 (not (equal (current-buffer) kill-buffer)))
3877 (kill-buffer (current-buffer))
3878 (if (not quit-config)
3879 (progn
6748645f
LMI
3880 ;; Update the info -- marks might need to be removed,
3881 ;; for instance.
3882 (gnus-summary-update-info)
eec82323
LMI
3883 (set-buffer gnus-group-buffer)
3884 (gnus-group-jump-to-group group)
3885 (gnus-group-next-unread-group 1))
3886 (gnus-handle-ephemeral-exit quit-config)))
23f87bed
MB
3887 (let ((grpinfo (gnus-get-info group)))
3888 (if (null (gnus-info-read grpinfo))
3889 (gnus-message 3 "Group %s contains no messages"
3890 (gnus-group-decoded-name group))
3891 (gnus-message 3 "Can't select group")))
eec82323
LMI
3892 nil)
3893 ;; The user did a `C-g' while prompting for number of articles,
3894 ;; so we exit this group.
3895 ((eq did-select 'quit)
3896 (and (eq major-mode 'gnus-summary-mode)
3897 (not (equal (current-buffer) kill-buffer))
3898 (kill-buffer (current-buffer)))
3899 (when kill-buffer
3900 (gnus-kill-or-deaden-summary kill-buffer))
3901 (if (not quit-config)
3902 (progn
3903 (set-buffer gnus-group-buffer)
3904 (gnus-group-jump-to-group group)
3905 (gnus-group-next-unread-group 1)
3906 (gnus-configure-windows 'group 'force))
3907 (gnus-handle-ephemeral-exit quit-config))
3908 ;; Finally signal the quit.
3909 (signal 'quit nil))
3910 ;; The group was successfully selected.
3911 (t
3912 (gnus-set-global-variables)
3913 ;; Save the active value in effect when the group was entered.
3914 (setq gnus-newsgroup-active
3915 (gnus-copy-sequence
3916 (gnus-active gnus-newsgroup-name)))
3917 ;; You can change the summary buffer in some way with this hook.
6748645f 3918 (gnus-run-hooks 'gnus-select-group-hook)
5153a47a
MB
3919 (when (memq 'summary (gnus-update-format-specifications
3920 nil 'summary 'summary-mode 'summary-dummy))
3921 ;; The format specification for the summary line was updated,
3922 ;; so we need to update the mark positions as well.
3923 (gnus-update-summary-mark-positions))
eec82323
LMI
3924 ;; Do score processing.
3925 (when gnus-use-scoring
3926 (gnus-possibly-score-headers))
3927 ;; Check whether to fill in the gaps in the threads.
3928 (when gnus-build-sparse-threads
3929 (gnus-build-sparse-threads))
3930 ;; Find the initial limit.
26c9afc3
MB
3931 (if show-all
3932 (let ((gnus-newsgroup-dormant nil))
eec82323 3933 (gnus-summary-initial-limit show-all))
26c9afc3 3934 (gnus-summary-initial-limit show-all))
eec82323
LMI
3935 ;; Generate the summary buffer.
3936 (unless no-display
3937 (gnus-summary-prepare))
3938 (when gnus-use-trees
3939 (gnus-tree-open group)
3940 (setq gnus-summary-highlight-line-function
3941 'gnus-tree-highlight-article))
3942 ;; If the summary buffer is empty, but there are some low-scored
3943 ;; articles or some excluded dormants, we include these in the
3944 ;; buffer.
3945 (when (and (zerop (buffer-size))
3946 (not no-display))
3947 (cond (gnus-newsgroup-dormant
3948 (gnus-summary-limit-include-dormant))
3949 ((and gnus-newsgroup-scored show-all)
3950 (gnus-summary-limit-include-expunged t))))
3951 ;; Function `gnus-apply-kill-file' must be called in this hook.
6748645f 3952 (gnus-run-hooks 'gnus-apply-kill-hook)
eec82323
LMI
3953 (if (and (zerop (buffer-size))
3954 (not no-display))
3955 (progn
3956 ;; This newsgroup is empty.
3957 (gnus-summary-catchup-and-exit nil t)
3958 (gnus-message 6 "No unread news")
3959 (when kill-buffer
3960 (gnus-kill-or-deaden-summary kill-buffer))
3961 ;; Return nil from this function.
3962 nil)
3963 ;; Hide conversation thread subtrees. We cannot do this in
3964 ;; gnus-summary-prepare-hook since kill processing may not
3965 ;; work with hidden articles.
23f87bed 3966 (gnus-summary-maybe-hide-threads)
6748645f
LMI
3967 (when kill-buffer
3968 (gnus-kill-or-deaden-summary kill-buffer))
23f87bed 3969 (gnus-summary-auto-select-subject)
eec82323
LMI
3970 ;; Show first unread article if requested.
3971 (if (and (not no-article)
3972 (not no-display)
3973 gnus-newsgroup-unreads
3974 gnus-auto-select-first)
16409b0b
GM
3975 (progn
3976 (gnus-configure-windows 'summary)
23f87bed
MB
3977 (let ((art (gnus-summary-article-number)))
3978 (unless (and (not gnus-plugged)
3979 (or (memq art gnus-newsgroup-undownloaded)
3980 (memq art gnus-newsgroup-downloadable)))
3981 (gnus-summary-goto-article art))))
3982 ;; Don't select any articles.
eec82323 3983 (gnus-summary-position-point)
6748645f
LMI
3984 (gnus-configure-windows 'summary 'force)
3985 (gnus-set-mode-line 'summary))
23f87bed
MB
3986 (when (and gnus-auto-center-group
3987 (get-buffer-window gnus-group-buffer t))
eec82323
LMI
3988 ;; Gotta use windows, because recenter does weird stuff if
3989 ;; the current buffer ain't the displayed window.
3990 (let ((owin (selected-window)))
3991 (select-window (get-buffer-window gnus-group-buffer t))
3992 (when (gnus-group-goto-group group)
3993 (recenter))
3994 (select-window owin)))
3995 ;; Mark this buffer as "prepared".
3996 (setq gnus-newsgroup-prepared t)
6748645f 3997 (gnus-run-hooks 'gnus-summary-prepared-hook)
23f87bed
MB
3998 (unless (gnus-ephemeral-group-p group)
3999 (gnus-group-update-group group))
eec82323
LMI
4000 t)))))
4001
23f87bed
MB
4002(defun gnus-summary-auto-select-subject ()
4003 "Select the subject line on initial group entry."
4004 (goto-char (point-min))
4005 (cond
4006 ((eq gnus-auto-select-subject 'best)
4007 (gnus-summary-best-unread-subject))
4008 ((eq gnus-auto-select-subject 'unread)
4009 (gnus-summary-first-unread-subject))
4010 ((eq gnus-auto-select-subject 'unseen)
4011 (gnus-summary-first-unseen-subject))
4012 ((eq gnus-auto-select-subject 'unseen-or-unread)
4013 (gnus-summary-first-unseen-or-unread-subject))
4014 ((eq gnus-auto-select-subject 'first)
4015 ;; Do nothing.
4016 )
4017 ((functionp gnus-auto-select-subject)
4018 (funcall gnus-auto-select-subject))))
4019
eec82323
LMI
4020(defun gnus-summary-prepare ()
4021 "Generate the summary buffer."
4022 (interactive)
c7a91ce1 4023 (let ((inhibit-read-only t))
eec82323
LMI
4024 (erase-buffer)
4025 (setq gnus-newsgroup-data nil
4026 gnus-newsgroup-data-reverse nil)
6748645f 4027 (gnus-run-hooks 'gnus-summary-generate-hook)
eec82323
LMI
4028 ;; Generate the buffer, either with threads or without.
4029 (when gnus-newsgroup-headers
4030 (gnus-summary-prepare-threads
4031 (if gnus-show-threads
4032 (gnus-sort-gathered-threads
4033 (funcall gnus-summary-thread-gathering-function
4034 (gnus-sort-threads
4035 (gnus-cut-threads (gnus-make-threads)))))
4036 ;; Unthreaded display.
4037 (gnus-sort-articles gnus-newsgroup-headers))))
4038 (setq gnus-newsgroup-data (nreverse gnus-newsgroup-data))
4039 ;; Call hooks for modifying summary buffer.
4040 (goto-char (point-min))
6748645f 4041 (gnus-run-hooks 'gnus-summary-prepare-hook)))
eec82323
LMI
4042
4043(defsubst gnus-general-simplify-subject (subject)
23f87bed 4044 "Simplify subject by the same rules as `gnus-gather-threads-by-subject'."
eec82323
LMI
4045 (setq subject
4046 (cond
4047 ;; Truncate the subject.
6748645f
LMI
4048 (gnus-simplify-subject-functions
4049 (gnus-map-function gnus-simplify-subject-functions subject))
eec82323
LMI
4050 ((numberp gnus-summary-gather-subject-limit)
4051 (setq subject (gnus-simplify-subject-re subject))
4052 (if (> (length subject) gnus-summary-gather-subject-limit)
4053 (substring subject 0 gnus-summary-gather-subject-limit)
4054 subject))
4055 ;; Fuzzily simplify it.
4056 ((eq 'fuzzy gnus-summary-gather-subject-limit)
4057 (gnus-simplify-subject-fuzzy subject))
4058 ;; Just remove the leading "Re:".
4059 (t
4060 (gnus-simplify-subject-re subject))))
4061
4062 (if (and gnus-summary-gather-exclude-subject
4063 (string-match gnus-summary-gather-exclude-subject subject))
23f87bed 4064 nil ; This article shouldn't be gathered
eec82323
LMI
4065 subject))
4066
4067(defun gnus-summary-simplify-subject-query ()
4068 "Query where the respool algorithm would put this article."
4069 (interactive)
eec82323 4070 (gnus-summary-select-article)
274f1353 4071 (message "%s" (gnus-general-simplify-subject (gnus-summary-article-subject))))
eec82323
LMI
4072
4073(defun gnus-gather-threads-by-subject (threads)
4074 "Gather threads by looking at Subject headers."
4075 (if (not gnus-summary-make-false-root)
4076 threads
4077 (let ((hashtb (gnus-make-hashtable 1024))
4078 (prev threads)
4079 (result threads)
4080 subject hthread whole-subject)
4081 (while threads
4082 (setq subject (gnus-general-simplify-subject
4083 (setq whole-subject (mail-header-subject
4084 (caar threads)))))
4085 (when subject
4086 (if (setq hthread (gnus-gethash subject hashtb))
4087 (progn
4088 ;; We enter a dummy root into the thread, if we
4089 ;; haven't done that already.
4090 (unless (stringp (caar hthread))
4091 (setcar hthread (list whole-subject (car hthread))))
4092 ;; We add this new gathered thread to this gathered
4093 ;; thread.
4094 (setcdr (car hthread)
4095 (nconc (cdar hthread) (list (car threads))))
4096 ;; Remove it from the list of threads.
4097 (setcdr prev (cdr threads))
4098 (setq threads prev))
4099 ;; Enter this thread into the hash table.
23f87bed
MB
4100 (gnus-sethash subject
4101 (if gnus-summary-make-false-root-always
4102 (progn
4103 ;; If you want a dummy root above all
4104 ;; threads...
4105 (setcar threads (list whole-subject
4106 (car threads)))
4107 threads)
4108 threads)
4109 hashtb)))
eec82323
LMI
4110 (setq prev threads)
4111 (setq threads (cdr threads)))
4112 result)))
4113
4114(defun gnus-gather-threads-by-references (threads)
4115 "Gather threads by looking at References headers."
4116 (let ((idhashtb (gnus-make-hashtable 1024))
4117 (thhashtb (gnus-make-hashtable 1024))
4118 (prev threads)
4119 (result threads)
4120 ids references id gthread gid entered ref)
4121 (while threads
4122 (when (setq references (mail-header-references (caar threads)))
4123 (setq id (mail-header-id (caar threads))
23f87bed 4124 ids (inline (gnus-split-references references))
eec82323
LMI
4125 entered nil)
4126 (while (setq ref (pop ids))
4127 (setq ids (delete ref ids))
4128 (if (not (setq gid (gnus-gethash ref idhashtb)))
4129 (progn
4130 (gnus-sethash ref id idhashtb)
4131 (gnus-sethash id threads thhashtb))
4132 (setq gthread (gnus-gethash gid thhashtb))
4133 (unless entered
4134 ;; We enter a dummy root into the thread, if we
4135 ;; haven't done that already.
4136 (unless (stringp (caar gthread))
4137 (setcar gthread (list (mail-header-subject (caar gthread))
4138 (car gthread))))
4139 ;; We add this new gathered thread to this gathered
4140 ;; thread.
4141 (setcdr (car gthread)
4142 (nconc (cdar gthread) (list (car threads)))))
4143 ;; Add it into the thread hash table.
4144 (gnus-sethash id gthread thhashtb)
4145 (setq entered t)
4146 ;; Remove it from the list of threads.
4147 (setcdr prev (cdr threads))
4148 (setq threads prev))))
4149 (setq prev threads)
4150 (setq threads (cdr threads)))
4151 result))
4152
4153(defun gnus-sort-gathered-threads (threads)
16409b0b 4154 "Sort subtreads inside each gathered thread by `gnus-sort-gathered-threads-function'."
eec82323
LMI
4155 (let ((result threads))
4156 (while threads
4157 (when (stringp (caar threads))
4158 (setcdr (car threads)
16409b0b 4159 (sort (cdar threads) gnus-sort-gathered-threads-function)))
eec82323
LMI
4160 (setq threads (cdr threads)))
4161 result))
4162
4163(defun gnus-thread-loop-p (root thread)
4164 "Say whether ROOT is in THREAD."
4165 (let ((stack (list thread))
4166 (infloop 0)
4167 th)
4168 (while (setq thread (pop stack))
4169 (setq th (cdr thread))
4170 (while (and th
4171 (not (eq (caar th) root)))
4172 (pop th))
4173 (if th
4174 ;; We have found a loop.
4175 (let (ref-dep)
4176 (setcdr thread (delq (car th) (cdr thread)))
4177 (if (boundp (setq ref-dep (intern "none"
4178 gnus-newsgroup-dependencies)))
4179 (setcdr (symbol-value ref-dep)
4180 (nconc (cdr (symbol-value ref-dep))
4181 (list (car th))))
4182 (set ref-dep (list nil (car th))))
4183 (setq infloop 1
4184 stack nil))
4185 ;; Push all the subthreads onto the stack.
4186 (push (cdr thread) stack)))
4187 infloop))
4188
4189(defun gnus-make-threads ()
01ccbb85 4190 "Go through the dependency hashtb and find the roots. Return all threads."
eec82323
LMI
4191 (let (threads)
4192 (while (catch 'infloop
4193 (mapatoms
4194 (lambda (refs)
4195 ;; Deal with self-referencing References loops.
4196 (when (and (car (symbol-value refs))
4197 (not (zerop
4198 (apply
4199 '+
4200 (mapcar
4201 (lambda (thread)
4202 (gnus-thread-loop-p
4203 (car (symbol-value refs)) thread))
4204 (cdr (symbol-value refs)))))))
4205 (setq threads nil)
4206 (throw 'infloop t))
4207 (unless (car (symbol-value refs))
23f87bed
MB
4208 ;; These threads do not refer back to any other
4209 ;; articles, so they're roots.
eec82323
LMI
4210 (setq threads (append (cdr (symbol-value refs)) threads))))
4211 gnus-newsgroup-dependencies)))
4212 threads))
4213
6748645f 4214;; Build the thread tree.
16409b0b 4215(defsubst gnus-dependencies-add-header (header dependencies force-new)
6748645f
LMI
4216 "Enter HEADER into the DEPENDENCIES table if it is not already there.
4217
4218If FORCE-NEW is not nil, enter HEADER into the DEPENDENCIES table even
4219if it was already present.
4220
4221If `gnus-summary-ignore-duplicates' is nil then duplicate Message-IDs
4222will not be entered in the DEPENDENCIES table. Otherwise duplicate
23f87bed
MB
4223Message-IDs will be renamed to a unique Message-ID before being
4224entered.
6748645f
LMI
4225
4226Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise."
4227 (let* ((id (mail-header-id header))
4228 (id-dep (and id (intern id dependencies)))
23f87bed 4229 parent-id ref ref-dep ref-header replaced)
6748645f
LMI
4230 ;; Enter this `header' in the `dependencies' table.
4231 (cond
4232 ((not id-dep)
4233 (setq header nil))
4234 ;; The first two cases do the normal part: enter a new `header'
4235 ;; in the `dependencies' table.
4236 ((not (boundp id-dep))
4237 (set id-dep (list header)))
4238 ((null (car (symbol-value id-dep)))
4239 (setcar (symbol-value id-dep) header))
4240
4241 ;; From here the `header' was already present in the
4242 ;; `dependencies' table.
4243 (force-new
4244 ;; Overrides an existing entry;
4245 ;; just set the header part of the entry.
23f87bed
MB
4246 (setcar (symbol-value id-dep) header)
4247 (setq replaced t))
6748645f
LMI
4248
4249 ;; Renames the existing `header' to a unique Message-ID.
4250 ((not gnus-summary-ignore-duplicates)
4251 ;; An article with this Message-ID has already been seen.
4252 ;; We rename the Message-ID.
4253 (set (setq id-dep (intern (setq id (nnmail-message-id)) dependencies))
4254 (list header))
4255 (mail-header-set-id header id))
4256
4257 ;; The last case ignores an existing entry, except it adds any
4258 ;; additional Xrefs (in case the two articles came from different
4259 ;; servers.
4260 ;; Also sets `header' to `nil' meaning that the `dependencies'
4261 ;; table was *not* modified.
4262 (t
4263 (mail-header-set-xref
4264 (car (symbol-value id-dep))
4265 (concat (or (mail-header-xref (car (symbol-value id-dep)))
4266 "")
4267 (or (mail-header-xref header) "")))
4268 (setq header nil)))
4269
23f87bed
MB
4270 (when (and header (not replaced))
4271 ;; First check that we are not creating a References loop.
4272 (setq parent-id (gnus-parent-id (mail-header-references header)))
4273 (setq ref parent-id)
6748645f
LMI
4274 (while (and ref
4275 (setq ref-dep (intern-soft ref dependencies))
4276 (boundp ref-dep)
4277 (setq ref-header (car (symbol-value ref-dep))))
4278 (if (string= id ref)
4279 ;; Yuk! This is a reference loop. Make the article be a
4280 ;; root article.
4281 (progn
4282 (mail-header-set-references (car (symbol-value id-dep)) "none")
23f87bed
MB
4283 (setq ref nil)
4284 (setq parent-id nil))
6748645f 4285 (setq ref (gnus-parent-id (mail-header-references ref-header)))))
23f87bed 4286 (setq ref-dep (intern (or parent-id "none") dependencies))
6748645f
LMI
4287 (if (boundp ref-dep)
4288 (setcdr (symbol-value ref-dep)
4289 (nconc (cdr (symbol-value ref-dep))
4290 (list (symbol-value id-dep))))
4291 (set ref-dep (list nil (symbol-value id-dep)))))
4292 header))
4293
23f87bed
MB
4294(defun gnus-extract-message-id-from-in-reply-to (string)
4295 (if (string-match "<[^>]+>" string)
4296 (substring string (match-beginning 0) (match-end 0))
4297 nil))
4298
eec82323
LMI
4299(defun gnus-build-sparse-threads ()
4300 (let ((headers gnus-newsgroup-headers)
16409b0b 4301 (mail-parse-charset gnus-newsgroup-charset)
6748645f 4302 (gnus-summary-ignore-duplicates t)
eec82323 4303 header references generation relations
6748645f 4304 subject child end new-child date)
eec82323
LMI
4305 ;; First we create an alist of generations/relations, where
4306 ;; generations is how much we trust the relation, and the relation
4307 ;; is parent/child.
4308 (gnus-message 7 "Making sparse threads...")
4309 (save-excursion
4310 (nnheader-set-temp-buffer " *gnus sparse threads*")
4311 (while (setq header (pop headers))
4312 (when (and (setq references (mail-header-references header))
4313 (not (string= references "")))
4314 (insert references)
4315 (setq child (mail-header-id header)
6748645f
LMI
4316 subject (mail-header-subject header)
4317 date (mail-header-date header)
4318 generation 0)
eec82323
LMI
4319 (while (search-backward ">" nil t)
4320 (setq end (1+ (point)))
4321 (when (search-backward "<" nil t)
6748645f 4322 (setq new-child (buffer-substring (point) end))
eec82323 4323 (push (list (incf generation)
6748645f
LMI
4324 child (setq child new-child)
4325 subject date)
eec82323 4326 relations)))
6748645f
LMI
4327 (when child
4328 (push (list (1+ generation) child nil subject) relations))
eec82323
LMI
4329 (erase-buffer)))
4330 (kill-buffer (current-buffer)))
4331 ;; Sort over trustworthiness.
01c52d31
MB
4332 (dolist (relation (sort relations 'car-less-than-car))
4333 (when (gnus-dependencies-add-header
4334 (make-full-mail-header
4335 gnus-reffed-article-number
4336 (nth 3 relation) "" (or (nth 4 relation) "")
4337 (nth 1 relation)
4338 (or (nth 2 relation) "") 0 0 "")
4339 gnus-newsgroup-dependencies nil)
4340 (push gnus-reffed-article-number gnus-newsgroup-limit)
4341 (push gnus-reffed-article-number gnus-newsgroup-sparse)
4342 (push (cons gnus-reffed-article-number gnus-sparse-mark)
4343 gnus-newsgroup-reads)
4344 (decf gnus-reffed-article-number)))
eec82323
LMI
4345 (gnus-message 7 "Making sparse threads...done")))
4346
4347(defun gnus-build-old-threads ()
4348 ;; Look at all the articles that refer back to old articles, and
4349 ;; fetch the headers for the articles that aren't there. This will
4350 ;; build complete threads - if the roots haven't been expired by the
4351 ;; server, that is.
16409b0b
GM
4352 (let ((mail-parse-charset gnus-newsgroup-charset)
4353 id heads)
eec82323
LMI
4354 (mapatoms
4355 (lambda (refs)
4356 (when (not (car (symbol-value refs)))
4357 (setq heads (cdr (symbol-value refs)))
4358 (while heads
4359 (if (memq (mail-header-number (caar heads))
4360 gnus-newsgroup-dormant)
4361 (setq heads (cdr heads))
4362 (setq id (symbol-name refs))
4363 (while (and (setq id (gnus-build-get-header id))
6748645f 4364 (not (car (gnus-id-to-thread id)))))
eec82323
LMI
4365 (setq heads nil)))))
4366 gnus-newsgroup-dependencies)))
4367
23f87bed
MB
4368(defsubst gnus-remove-odd-characters (string)
4369 "Translate STRING into something that doesn't contain weird characters."
4370 (mm-subst-char-in-string
4371 ?\r ?\-
01c52d31 4372 (mm-subst-char-in-string ?\n ?\- string t) t))
23f87bed 4373
6748645f
LMI
4374;; This function has to be called with point after the article number
4375;; on the beginning of the line.
4376(defsubst gnus-nov-parse-line (number dependencies &optional force-new)
01c52d31 4377 (let ((eol (point-at-eol))
6748645f 4378 (buffer (current-buffer))
23f87bed 4379 header references in-reply-to)
6748645f
LMI
4380
4381 ;; overview: [num subject from date id refs chars lines misc]
4382 (unwind-protect
23f87bed 4383 (let (x)
6748645f
LMI
4384 (narrow-to-region (point) eol)
4385 (unless (eobp)
4386 (forward-char))
4387
4388 (setq header
4389 (make-full-mail-header
4390 number ; number
23f87bed
MB
4391 (condition-case () ; subject
4392 (gnus-remove-odd-characters
4393 (funcall gnus-decode-encoded-word-function
4394 (setq x (nnheader-nov-field))))
4395 (error x))
4396 (condition-case () ; from
4397 (gnus-remove-odd-characters
343d6628 4398 (funcall gnus-decode-encoded-address-function
23f87bed
MB
4399 (setq x (nnheader-nov-field))))
4400 (error x))
16409b0b 4401 (nnheader-nov-field) ; date
01c52d31 4402 (nnheader-nov-read-message-id number) ; id
23f87bed 4403 (setq references (nnheader-nov-field)) ; refs
16409b0b
GM
4404 (nnheader-nov-read-integer) ; chars
4405 (nnheader-nov-read-integer) ; lines
4406 (unless (eobp)
8b93df01
DL
4407 (if (looking-at "Xref: ")
4408 (goto-char (match-end 0)))
4409 (nnheader-nov-field)) ; Xref
16409b0b 4410 (nnheader-nov-parse-extra)))) ; extra
6748645f
LMI
4411
4412 (widen))
4413
23f87bed
MB
4414 (when (and (string= references "")
4415 (setq in-reply-to (mail-header-extra header))
4416 (setq in-reply-to (cdr (assq 'In-Reply-To in-reply-to))))
4417 (mail-header-set-references
4418 header (gnus-extract-message-id-from-in-reply-to in-reply-to)))
4419
6748645f
LMI
4420 (when gnus-alter-header-function
4421 (funcall gnus-alter-header-function header))
4422 (gnus-dependencies-add-header header dependencies force-new)))
4423
eec82323 4424(defun gnus-build-get-header (id)
16409b0b
GM
4425 "Look through the buffer of NOV lines and find the header to ID.
4426Enter this line into the dependencies hash table, and return
4427the id of the parent article (if any)."
eec82323
LMI
4428 (let ((deps gnus-newsgroup-dependencies)
4429 found header)
4430 (prog1
c7a91ce1 4431 (with-current-buffer nntp-server-buffer
eec82323
LMI
4432 (let ((case-fold-search nil))
4433 (goto-char (point-min))
4434 (while (and (not found)
4435 (search-forward id nil t))
4436 (beginning-of-line)
4437 (setq found (looking-at
4438 (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s"
4439 (regexp-quote id))))
4440 (or found (beginning-of-line 2)))
4441 (when found
4442 (beginning-of-line)
4443 (and
4444 (setq header (gnus-nov-parse-line
4445 (read (current-buffer)) deps))
4446 (gnus-parent-id (mail-header-references header))))))
4447 (when header
4448 (let ((number (mail-header-number header)))
4449 (push number gnus-newsgroup-limit)
4450 (push header gnus-newsgroup-headers)
4451 (if (memq number gnus-newsgroup-unselected)
4452 (progn
23f87bed
MB
4453 (setq gnus-newsgroup-unreads
4454 (gnus-add-to-sorted-list gnus-newsgroup-unreads
4455 number))
eec82323
LMI
4456 (setq gnus-newsgroup-unselected
4457 (delq number gnus-newsgroup-unselected)))
4458 (push number gnus-newsgroup-ancient)))))))
4459
6748645f
LMI
4460(defun gnus-build-all-threads ()
4461 "Read all the headers."
4462 (let ((gnus-summary-ignore-duplicates t)
16409b0b 4463 (mail-parse-charset gnus-newsgroup-charset)
6748645f
LMI
4464 (dependencies gnus-newsgroup-dependencies)
4465 header article)
c7a91ce1 4466 (with-current-buffer nntp-server-buffer
6748645f
LMI
4467 (let ((case-fold-search nil))
4468 (goto-char (point-min))
4469 (while (not (eobp))
4470 (ignore-errors
4471 (setq article (read (current-buffer))
16409b0b 4472 header (gnus-nov-parse-line article dependencies)))
6748645f 4473 (when header
01c52d31 4474 (with-current-buffer gnus-summary-buffer
6748645f
LMI
4475 (push header gnus-newsgroup-headers)
4476 (if (memq (setq article (mail-header-number header))
4477 gnus-newsgroup-unselected)
4478 (progn
23f87bed
MB
4479 (setq gnus-newsgroup-unreads
4480 (gnus-add-to-sorted-list
4481 gnus-newsgroup-unreads article))
6748645f
LMI
4482 (setq gnus-newsgroup-unselected
4483 (delq article gnus-newsgroup-unselected)))
4484 (push article gnus-newsgroup-ancient)))
4485 (forward-line 1)))))))
4486
eec82323 4487(defun gnus-summary-update-article-line (article header)
23f87bed 4488 "Update the line for ARTICLE using HEADER."
eec82323
LMI
4489 (let* ((id (mail-header-id header))
4490 (thread (gnus-id-to-thread id)))
4491 (unless thread
4492 (error "Article in no thread"))
4493 ;; Update the thread.
4494 (setcar thread header)
4495 (gnus-summary-goto-subject article)
4496 (let* ((datal (gnus-data-find-list article))
4497 (data (car datal))
c7a91ce1 4498 (inhibit-read-only t)
eec82323
LMI
4499 (level (gnus-summary-thread-level)))
4500 (gnus-delete-line)
23f87bed
MB
4501 (let ((inserted (- (point)
4502 (progn
4503 (gnus-summary-insert-line
4504 header level nil
4505 (memq article gnus-newsgroup-undownloaded)
4506 (gnus-article-mark article)
4507 (memq article gnus-newsgroup-replied)
4508 (memq article gnus-newsgroup-expirable)
4509 ;; Only insert the Subject string when it's different
4510 ;; from the previous Subject string.
4511 (if (and
4512 gnus-show-threads
4513 (gnus-subject-equal
4514 (condition-case ()
4515 (mail-header-subject
4516 (gnus-data-header
4517 (cadr
4518 (gnus-data-find-list
4519 article
4520 (gnus-data-list t)))))
4521 ;; Error on the side of excessive subjects.
4522 (error ""))
4523 (mail-header-subject header)))
4524 ""
4525 (mail-header-subject header))
4526 nil (cdr (assq article gnus-newsgroup-scored))
4527 (memq article gnus-newsgroup-processable))
4528 (point)))))
4529 (when (cdr datal)
4530 (gnus-data-update-list
4531 (cdr datal)
4532 (- (gnus-data-pos data) (gnus-data-pos (cadr datal)) inserted)))))))
eec82323
LMI
4533
4534(defun gnus-summary-update-article (article &optional iheader)
4535 "Update ARTICLE in the summary buffer."
4536 (set-buffer gnus-summary-buffer)
6748645f 4537 (let* ((header (gnus-summary-article-header article))
eec82323
LMI
4538 (id (mail-header-id header))
4539 (data (gnus-data-find article))
4540 (thread (gnus-id-to-thread id))
4541 (references (mail-header-references header))
4542 (parent
4543 (gnus-id-to-thread
4544 (or (gnus-parent-id
4545 (when (and references
4546 (not (equal "" references)))
4547 references))
4548 "none")))
c7a91ce1 4549 (inhibit-read-only t)
6748645f 4550 (old (car thread)))
eec82323 4551 (when thread
eec82323 4552 (unless iheader
6748645f
LMI
4553 (setcar thread nil)
4554 (when parent
4555 (delq thread parent)))
4556 (if (gnus-summary-insert-subject id header)
eec82323
LMI
4557 ;; Set the (possibly) new article number in the data structure.
4558 (gnus-data-set-number data (gnus-id-to-article id))
4559 (setcar thread old)
4560 nil))))
4561
6748645f
LMI
4562(defun gnus-rebuild-thread (id &optional line)
4563 "Rebuild the thread containing ID.
4564If LINE, insert the rebuilt thread starting on line LINE."
c7a91ce1 4565 (let ((inhibit-read-only t)
eec82323
LMI
4566 old-pos current thread data)
4567 (if (not gnus-show-threads)
4568 (setq thread (list (car (gnus-id-to-thread id))))
4569 ;; Get the thread this article is part of.
4570 (setq thread (gnus-remove-thread id)))
01c52d31 4571 (setq old-pos (point-at-bol))
eec82323 4572 (setq current (save-excursion
94384150 4573 (and (re-search-backward "[\r\n]" nil t)
eec82323
LMI
4574 (gnus-summary-article-number))))
4575 ;; If this is a gathered thread, we have to go some re-gathering.
4576 (when (stringp (car thread))
4577 (let ((subject (car thread))
4578 roots thr)
4579 (setq thread (cdr thread))
4580 (while thread
4581 (unless (memq (setq thr (gnus-id-to-thread
4582 (gnus-root-id
4583 (mail-header-id (caar thread)))))
4584 roots)
4585 (push thr roots))
4586 (setq thread (cdr thread)))
4587 ;; We now have all (unique) roots.
4588 (if (= (length roots) 1)
4589 ;; All the loose roots are now one solid root.
4590 (setq thread (car roots))
4591 (setq thread (cons subject (gnus-sort-threads roots))))))
4592 (let (threads)
4593 ;; We then insert this thread into the summary buffer.
6748645f
LMI
4594 (when line
4595 (goto-char (point-min))
4596 (forward-line (1- line)))
eec82323
LMI
4597 (let (gnus-newsgroup-data gnus-newsgroup-threads)
4598 (if gnus-show-threads
4599 (gnus-summary-prepare-threads (gnus-cut-threads (list thread)))
4600 (gnus-summary-prepare-unthreaded thread))
4601 (setq data (nreverse gnus-newsgroup-data))
4602 (setq threads gnus-newsgroup-threads))
4603 ;; We splice the new data into the data structure.
6748645f
LMI
4604 ;;!!! This is kinda bogus. We assume that in LINE is non-nil,
4605 ;;!!! then we want to insert at the beginning of the buffer.
4606 ;;!!! That happens to be true with Gnus now, but that may
4607 ;;!!! change in the future. Perhaps.
4608 (gnus-data-enter-list
4609 (if line nil current) data (- (point) old-pos))
4610 (setq gnus-newsgroup-threads
4611 (nconc threads gnus-newsgroup-threads))
4612 (gnus-data-compute-positions))))
eec82323
LMI
4613
4614(defun gnus-number-to-header (number)
4615 "Return the header for article NUMBER."
4616 (let ((headers gnus-newsgroup-headers))
4617 (while (and headers
4618 (not (= number (mail-header-number (car headers)))))
4619 (pop headers))
4620 (when headers
4621 (car headers))))
4622
6748645f 4623(defun gnus-parent-headers (in-headers &optional generation)
eec82323
LMI
4624 "Return the headers of the GENERATIONeth parent of HEADERS."
4625 (unless generation
4626 (setq generation 1))
a8151ef7 4627 (let ((parent t)
6748645f 4628 (headers in-headers)
a8151ef7 4629 references)
6748645f
LMI
4630 (while (and parent
4631 (not (zerop generation))
4632 (setq references (mail-header-references headers)))
4633 (setq headers (if (and references
4634 (setq parent (gnus-parent-id references)))
4635 (car (gnus-id-to-thread parent))
4636 nil))
4637 (decf generation))
4638 (and (not (eq headers in-headers))
4639 headers)))
eec82323
LMI
4640
4641(defun gnus-id-to-thread (id)
4642 "Return the (sub-)thread where ID appears."
4643 (gnus-gethash id gnus-newsgroup-dependencies))
4644
4645(defun gnus-id-to-article (id)
4646 "Return the article number of ID."
4647 (let ((thread (gnus-id-to-thread id)))
4648 (when (and thread
4649 (car thread))
4650 (mail-header-number (car thread)))))
4651
4652(defun gnus-id-to-header (id)
4653 "Return the article headers of ID."
4654 (car (gnus-id-to-thread id)))
4655
4656(defun gnus-article-displayed-root-p (article)
4657 "Say whether ARTICLE is a root(ish) article."
4658 (let ((level (gnus-summary-thread-level article))
4659 (refs (mail-header-references (gnus-summary-article-header article)))
4660 particle)
4661 (cond
4662 ((null level) nil)
4663 ((zerop level) t)
4664 ((null refs) t)
4665 ((null (gnus-parent-id refs)) t)
4666 ((and (= 1 level)
4667 (null (setq particle (gnus-id-to-article
4668 (gnus-parent-id refs))))
4669 (null (gnus-summary-thread-level particle)))))))
4670
4671(defun gnus-root-id (id)
4672 "Return the id of the root of the thread where ID appears."
4673 (let (last-id prev)
6748645f 4674 (while (and id (setq prev (car (gnus-id-to-thread id))))
eec82323
LMI
4675 (setq last-id id
4676 id (gnus-parent-id (mail-header-references prev))))
4677 last-id))
4678
6748645f
LMI
4679(defun gnus-articles-in-thread (thread)
4680 "Return the list of articles in THREAD."
4681 (cons (mail-header-number (car thread))
4682 (apply 'nconc (mapcar 'gnus-articles-in-thread (cdr thread)))))
4683
eec82323
LMI
4684(defun gnus-remove-thread (id &optional dont-remove)
4685 "Remove the thread that has ID in it."
6748645f 4686 (let (headers thread last-id)
eec82323 4687 ;; First go up in this thread until we find the root.
6748645f
LMI
4688 (setq last-id (gnus-root-id id)
4689 headers (message-flatten-list (gnus-id-to-thread last-id)))
01ccbb85 4690 ;; We have now found the real root of this thread. It might have
eec82323
LMI
4691 ;; been gathered into some loose thread, so we have to search
4692 ;; through the threads to find the thread we wanted.
4693 (let ((threads gnus-newsgroup-threads)
4694 sub)
4695 (while threads
4696 (setq sub (car threads))
4697 (if (stringp (car sub))
4698 ;; This is a gathered thread, so we look at the roots
4699 ;; below it to find whether this article is in this
4700 ;; gathered root.
4701 (progn
4702 (setq sub (cdr sub))
4703 (while sub
4704 (when (member (caar sub) headers)
4705 (setq thread (car threads)
4706 threads nil
4707 sub nil))
4708 (setq sub (cdr sub))))
4709 ;; It's an ordinary thread, so we check it.
4710 (when (eq (car sub) (car headers))
4711 (setq thread sub
4712 threads nil)))
4713 (setq threads (cdr threads)))
4714 ;; If this article is in no thread, then it's a root.
4715 (if thread
4716 (unless dont-remove
4717 (setq gnus-newsgroup-threads (delq thread gnus-newsgroup-threads)))
6748645f 4718 (setq thread (gnus-id-to-thread last-id)))
eec82323
LMI
4719 (when thread
4720 (prog1
4721 thread ; We return this thread.
4722 (unless dont-remove
4723 (if (stringp (car thread))
4724 (progn
4725 ;; If we use dummy roots, then we have to remove the
4726 ;; dummy root as well.
4727 (when (eq gnus-summary-make-false-root 'dummy)
6748645f
LMI
4728 ;; We go to the dummy root by going to
4729 ;; the first sub-"thread", and then one line up.
4730 (gnus-summary-goto-article
4731 (mail-header-number (caadr thread)))
4732 (forward-line -1)
eec82323
LMI
4733 (gnus-delete-line)
4734 (gnus-data-compute-positions))
4735 (setq thread (cdr thread))
4736 (while thread
4737 (gnus-remove-thread-1 (car thread))
4738 (setq thread (cdr thread))))
4739 (gnus-remove-thread-1 thread))))))))
4740
4741(defun gnus-remove-thread-1 (thread)
4742 "Remove the thread THREAD recursively."
4743 (let ((number (mail-header-number (pop thread)))
4744 d)
4745 (setq thread (reverse thread))
4746 (while thread
4747 (gnus-remove-thread-1 (pop thread)))
4748 (when (setq d (gnus-data-find number))
4749 (goto-char (gnus-data-pos d))
16409b0b 4750 (gnus-summary-show-thread)
eec82323
LMI
4751 (gnus-data-remove
4752 number
01c52d31 4753 (- (point-at-bol)
eec82323 4754 (prog1
01c52d31 4755 (1+ (point-at-eol))
eec82323
LMI
4756 (gnus-delete-line)))))))
4757
4921bbdd 4758(defun gnus-sort-threads-recursive (threads func)
16409b0b
GM
4759 (sort (mapcar (lambda (thread)
4760 (cons (car thread)
4761 (and (cdr thread)
4921bbdd 4762 (gnus-sort-threads-recursive (cdr thread) func))))
16409b0b
GM
4763 threads) func))
4764
4921bbdd
CY
4765(defun gnus-sort-threads-loop (threads func)
4766 (let* ((superthread (cons nil threads))
4767 (stack (list (cons superthread threads)))
4768 remaining-threads thread)
4769 (while stack
4770 (setq remaining-threads (cdr (car stack)))
4771 (if remaining-threads
4772 (progn (setq thread (car remaining-threads))
4773 (setcdr (car stack) (cdr remaining-threads))
4774 (if (cdr thread)
4775 (push (cons thread (cdr thread)) stack)))
4776 (setq thread (caar stack))
4777 (setcdr thread (sort (cdr thread) func))
4778 (pop stack)))
4779 (cdr superthread)))
4780
eec82323
LMI
4781(defun gnus-sort-threads (threads)
4782 "Sort THREADS."
4783 (if (not gnus-thread-sort-functions)
4784 threads
6748645f 4785 (gnus-message 8 "Sorting threads...")
4921bbdd
CY
4786 (prog1
4787 (condition-case nil
4788 (let ((max-lisp-eval-depth (max max-lisp-eval-depth 5000)))
4789 (gnus-sort-threads-recursive
4790 threads (gnus-make-sort-function gnus-thread-sort-functions)))
4791 ;; Even after binding max-lisp-eval-depth, the recursive
4792 ;; sorter might fail for very long threads. In that case,
4793 ;; try using a (less well-tested) non-recursive sorter.
4794 (error (gnus-sort-threads-loop
4795 threads (gnus-make-sort-function
4796 gnus-thread-sort-functions))))
4797 (gnus-message 8 "Sorting threads...done"))))
eec82323
LMI
4798
4799(defun gnus-sort-articles (articles)
4800 "Sort ARTICLES."
4801 (when gnus-article-sort-functions
4802 (gnus-message 7 "Sorting articles...")
4803 (prog1
4804 (setq gnus-newsgroup-headers
4805 (sort articles (gnus-make-sort-function
4806 gnus-article-sort-functions)))
4807 (gnus-message 7 "Sorting articles...done"))))
4808
4809;; Written by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
4810(defmacro gnus-thread-header (thread)
16409b0b
GM
4811 "Return header of first article in THREAD.
4812Note that THREAD must never, ever be anything else than a variable -
4813using some other form will lead to serious barfage."
eec82323
LMI
4814 (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread)))
4815 ;; (8% speedup to gnus-summary-prepare, just for fun :-)
16409b0b 4816 (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207"
eec82323
LMI
4817 (vector thread) 2))
4818
4819(defsubst gnus-article-sort-by-number (h1 h2)
4820 "Sort articles by article number."
4821 (< (mail-header-number h1)
4822 (mail-header-number h2)))
4823
4824(defun gnus-thread-sort-by-number (h1 h2)
4825 "Sort threads by root article number."
4826 (gnus-article-sort-by-number
4827 (gnus-thread-header h1) (gnus-thread-header h2)))
4828
23f87bed 4829(defsubst gnus-article-sort-by-random (h1 h2)
0b6799c3 4830 "Sort articles randomly."
23f87bed
MB
4831 (zerop (random 2)))
4832
4833(defun gnus-thread-sort-by-random (h1 h2)
0b6799c3 4834 "Sort threads randomly."
23f87bed
MB
4835 (gnus-article-sort-by-random
4836 (gnus-thread-header h1) (gnus-thread-header h2)))
4837
eec82323
LMI
4838(defsubst gnus-article-sort-by-lines (h1 h2)
4839 "Sort articles by article Lines header."
4840 (< (mail-header-lines h1)
4841 (mail-header-lines h2)))
4842
4843(defun gnus-thread-sort-by-lines (h1 h2)
4844 "Sort threads by root article Lines header."
4845 (gnus-article-sort-by-lines
4846 (gnus-thread-header h1) (gnus-thread-header h2)))
4847
16409b0b
GM
4848(defsubst gnus-article-sort-by-chars (h1 h2)
4849 "Sort articles by octet length."
4850 (< (mail-header-chars h1)
4851 (mail-header-chars h2)))
4852
4853(defun gnus-thread-sort-by-chars (h1 h2)
4854 "Sort threads by root article octet length."
4855 (gnus-article-sort-by-chars
4856 (gnus-thread-header h1) (gnus-thread-header h2)))
4857
eec82323
LMI
4858(defsubst gnus-article-sort-by-author (h1 h2)
4859 "Sort articles by root author."
b4fde39f 4860 (gnus-string<
eec82323
LMI
4861 (let ((extract (funcall
4862 gnus-extract-address-components
4863 (mail-header-from h1))))
4864 (or (car extract) (cadr extract) ""))
4865 (let ((extract (funcall
4866 gnus-extract-address-components
4867 (mail-header-from h2))))
4868 (or (car extract) (cadr extract) ""))))
4869
4870(defun gnus-thread-sort-by-author (h1 h2)
4871 "Sort threads by root author."
4872 (gnus-article-sort-by-author
4873 (gnus-thread-header h1) (gnus-thread-header h2)))
4874
01c52d31
MB
4875(defsubst gnus-article-sort-by-recipient (h1 h2)
4876 "Sort articles by recipient."
4877 (gnus-string<
4878 (let ((extract (funcall
4879 gnus-extract-address-components
4880 (or (cdr (assq 'To (mail-header-extra h1))) ""))))
4881 (or (car extract) (cadr extract)))
4882 (let ((extract (funcall
4883 gnus-extract-address-components
4884 (or (cdr (assq 'To (mail-header-extra h2))) ""))))
4885 (or (car extract) (cadr extract)))))
4886
4887(defun gnus-thread-sort-by-recipient (h1 h2)
4888 "Sort threads by root recipient."
4889 (gnus-article-sort-by-recipient
4890 (gnus-thread-header h1) (gnus-thread-header h2)))
4891
eec82323
LMI
4892(defsubst gnus-article-sort-by-subject (h1 h2)
4893 "Sort articles by root subject."
b4fde39f 4894 (gnus-string<
eec82323
LMI
4895 (downcase (gnus-simplify-subject-re (mail-header-subject h1)))
4896 (downcase (gnus-simplify-subject-re (mail-header-subject h2)))))
4897
4898(defun gnus-thread-sort-by-subject (h1 h2)
4899 "Sort threads by root subject."
4900 (gnus-article-sort-by-subject
4901 (gnus-thread-header h1) (gnus-thread-header h2)))
4902
4903(defsubst gnus-article-sort-by-date (h1 h2)
4904 "Sort articles by root article date."
16409b0b 4905 (time-less-p
eec82323
LMI
4906 (gnus-date-get-time (mail-header-date h1))
4907 (gnus-date-get-time (mail-header-date h2))))
4908
4909(defun gnus-thread-sort-by-date (h1 h2)
4910 "Sort threads by root article date."
4911 (gnus-article-sort-by-date
4912 (gnus-thread-header h1) (gnus-thread-header h2)))
4913
4914(defsubst gnus-article-sort-by-score (h1 h2)
4915 "Sort articles by root article score.
4916Unscored articles will be counted as having a score of zero."
4917 (> (or (cdr (assq (mail-header-number h1)
4918 gnus-newsgroup-scored))
4919 gnus-summary-default-score 0)
4920 (or (cdr (assq (mail-header-number h2)
4921 gnus-newsgroup-scored))
4922 gnus-summary-default-score 0)))
4923
4924(defun gnus-thread-sort-by-score (h1 h2)
4925 "Sort threads by root article score."
4926 (gnus-article-sort-by-score
4927 (gnus-thread-header h1) (gnus-thread-header h2)))
4928
4929(defun gnus-thread-sort-by-total-score (h1 h2)
4930 "Sort threads by the sum of all scores in the thread.
4931Unscored articles will be counted as having a score of zero."
4932 (> (gnus-thread-total-score h1) (gnus-thread-total-score h2)))
4933
4934(defun gnus-thread-total-score (thread)
16409b0b 4935 ;; This function find the total score of THREAD.
23f87bed
MB
4936 (cond
4937 ((null thread)
4938 0)
4939 ((consp thread)
4940 (if (stringp (car thread))
4941 (apply gnus-thread-score-function 0
4942 (mapcar 'gnus-thread-total-score-1 (cdr thread)))
4943 (gnus-thread-total-score-1 thread)))
4944 (t
4945 (gnus-thread-total-score-1 (list thread)))))
4946
4947(defun gnus-thread-sort-by-most-recent-number (h1 h2)
4948 "Sort threads such that the thread with the most recently arrived article comes first."
4949 (> (gnus-thread-highest-number h1) (gnus-thread-highest-number h2)))
4950
4951(defun gnus-thread-highest-number (thread)
4952 "Return the highest article number in THREAD."
4953 (apply 'max (mapcar (lambda (header)
4954 (mail-header-number header))
4955 (message-flatten-list thread))))
4956
4957(defun gnus-thread-sort-by-most-recent-date (h1 h2)
4958 "Sort threads such that the thread with the most recently dated article comes first."
4959 (> (gnus-thread-latest-date h1) (gnus-thread-latest-date h2)))
4960
4961(defun gnus-thread-latest-date (thread)
4962 "Return the highest article date in THREAD."
4963 (let ((previous-time 0))
4964 (apply 'max
4965 (mapcar
4966 (lambda (header)
4967 (setq previous-time
4968 (condition-case ()
4969 (time-to-seconds (mail-header-parse-date
4970 (mail-header-date header)))
4971 (error previous-time))))
4972 (sort
4973 (message-flatten-list thread)
4974 (lambda (h1 h2)
4975 (< (mail-header-number h1)
4976 (mail-header-number h2))))))))
eec82323
LMI
4977
4978(defun gnus-thread-total-score-1 (root)
4979 ;; This function find the total score of the thread below ROOT.
4980 (setq root (car root))
4981 (apply gnus-thread-score-function
4982 (or (append
4983 (mapcar 'gnus-thread-total-score
6748645f 4984 (cdr (gnus-id-to-thread (mail-header-id root))))
eec82323
LMI
4985 (when (> (mail-header-number root) 0)
4986 (list (or (cdr (assq (mail-header-number root)
4987 gnus-newsgroup-scored))
4988 gnus-summary-default-score 0))))
4989 (list gnus-summary-default-score)
4990 '(0))))
4991
4992;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
4993(defvar gnus-tmp-prev-subject nil)
4994(defvar gnus-tmp-false-parent nil)
4995(defvar gnus-tmp-root-expunged nil)
4996(defvar gnus-tmp-dummy-line nil)
4997
16409b0b
GM
4998(defun gnus-extra-header (type &optional header)
4999 "Return the extra header of TYPE."
5000 (or (cdr (assq type (mail-header-extra (or header gnus-tmp-header))))
5001 ""))
5002
23f87bed
MB
5003(defvar gnus-tmp-thread-tree-header-string "")
5004
5005(defcustom gnus-sum-thread-tree-root "> "
5006 "With %B spec, used for the root of a thread.
5007If nil, use subject instead."
bf247b6e 5008 :version "22.1"
ad136a7c 5009 :type '(radio (const :format "%v " nil) string)
23f87bed 5010 :group 'gnus-thread)
01c52d31 5011
23f87bed
MB
5012(defcustom gnus-sum-thread-tree-false-root "> "
5013 "With %B spec, used for a false root of a thread.
5014If nil, use subject instead."
bf247b6e 5015 :version "22.1"
ad136a7c 5016 :type '(radio (const :format "%v " nil) string)
23f87bed 5017 :group 'gnus-thread)
01c52d31 5018
23f87bed
MB
5019(defcustom gnus-sum-thread-tree-single-indent ""
5020 "With %B spec, used for a thread with just one message.
5021If nil, use subject instead."
bf247b6e 5022 :version "22.1"
ad136a7c 5023 :type '(radio (const :format "%v " nil) string)
23f87bed 5024 :group 'gnus-thread)
01c52d31 5025
23f87bed
MB
5026(defcustom gnus-sum-thread-tree-vertical "| "
5027 "With %B spec, used for drawing a vertical line."
bf247b6e 5028 :version "22.1"
23f87bed
MB
5029 :type 'string
5030 :group 'gnus-thread)
01c52d31 5031
23f87bed
MB
5032(defcustom gnus-sum-thread-tree-indent " "
5033 "With %B spec, used for indenting."
bf247b6e 5034 :version "22.1"
23f87bed
MB
5035 :type 'string
5036 :group 'gnus-thread)
01c52d31 5037
23f87bed
MB
5038(defcustom gnus-sum-thread-tree-leaf-with-other "+-> "
5039 "With %B spec, used for a leaf with brothers."
bf247b6e 5040 :version "22.1"
23f87bed
MB
5041 :type 'string
5042 :group 'gnus-thread)
01c52d31 5043
23f87bed
MB
5044(defcustom gnus-sum-thread-tree-single-leaf "\\-> "
5045 "With %B spec, used for a leaf without brothers."
bf247b6e 5046 :version "22.1"
23f87bed
MB
5047 :type 'string
5048 :group 'gnus-thread)
5049
1fc34624
GM
5050(defcustom gnus-summary-display-while-building nil
5051 "If non-nil, show and update the summary buffer as it's being built.
5052If the value is t, update the buffer after every line is inserted. If
5053the value is an integer (N), update the display every N lines."
5054 :version "22.1"
5055 :group 'gnus-thread
5056 :type '(choice (const :tag "off" nil)
5057 number
5058 (const :tag "frequently" t)))
5059
eec82323
LMI
5060(defun gnus-summary-prepare-threads (threads)
5061 "Prepare summary buffer from THREADS and indentation LEVEL.
5062THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])'
5063or a straight list of headers."
5064 (gnus-message 7 "Generating summary...")
5065
5066 (setq gnus-newsgroup-threads threads)
5067 (beginning-of-line)
5068
5069 (let ((gnus-tmp-level 0)
5070 (default-score (or gnus-summary-default-score 0))
5071 (gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight))
23f87bed
MB
5072 (building-line-count gnus-summary-display-while-building)
5073 (building-count (integerp gnus-summary-display-while-building))
eec82323 5074 thread number subject stack state gnus-tmp-gathered beg-match
23f87bed
MB
5075 new-roots gnus-tmp-new-adopts thread-end simp-subject
5076 gnus-tmp-header gnus-tmp-unread gnus-tmp-downloaded
eec82323
LMI
5077 gnus-tmp-replied gnus-tmp-subject-or-nil
5078 gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score
5079 gnus-tmp-score-char gnus-tmp-from gnus-tmp-name
23f87bed
MB
5080 gnus-tmp-number gnus-tmp-opening-bracket gnus-tmp-closing-bracket
5081 tree-stack)
eec82323 5082
23f87bed
MB
5083 (setq gnus-tmp-prev-subject nil
5084 gnus-tmp-thread-tree-header-string "")
eec82323
LMI
5085
5086 (if (vectorp (car threads))
5087 ;; If this is a straight (sic) list of headers, then a
5088 ;; threaded summary display isn't required, so we just create
5089 ;; an unthreaded one.
5090 (gnus-summary-prepare-unthreaded threads)
5091
5092 ;; Do the threaded display.
5093
23f87bed
MB
5094 (if gnus-summary-display-while-building
5095 (switch-to-buffer (buffer-name)))
eec82323
LMI
5096 (while (or threads stack gnus-tmp-new-adopts new-roots)
5097
5098 (if (and (= gnus-tmp-level 0)
eec82323
LMI
5099 (or (not stack)
5100 (= (caar stack) 0))
5101 (not gnus-tmp-false-parent)
5102 (or gnus-tmp-new-adopts new-roots))
5103 (if gnus-tmp-new-adopts
5104 (setq gnus-tmp-level (if gnus-tmp-root-expunged 0 1)
5105 thread (list (car gnus-tmp-new-adopts))
5106 gnus-tmp-header (caar thread)
5107 gnus-tmp-new-adopts (cdr gnus-tmp-new-adopts))
5108 (when new-roots
5109 (setq thread (list (car new-roots))
5110 gnus-tmp-header (caar thread)
5111 new-roots (cdr new-roots))))
5112
5113 (if threads
5114 ;; If there are some threads, we do them before the
5115 ;; threads on the stack.
5116 (setq thread threads
5117 gnus-tmp-header (caar thread))
5118 ;; There were no current threads, so we pop something off
5119 ;; the stack.
5120 (setq state (car stack)
5121 gnus-tmp-level (car state)
23f87bed
MB
5122 tree-stack (cadr state)
5123 thread (caddr state)
eec82323
LMI
5124 stack (cdr stack)
5125 gnus-tmp-header (caar thread))))
5126
5127 (setq gnus-tmp-false-parent nil)
5128 (setq gnus-tmp-root-expunged nil)
5129 (setq thread-end nil)
5130
5131 (if (stringp gnus-tmp-header)
5132 ;; The header is a dummy root.
5133 (cond
5134 ((eq gnus-summary-make-false-root 'adopt)
5135 ;; We let the first article adopt the rest.
5136 (setq gnus-tmp-new-adopts (nconc gnus-tmp-new-adopts
5137 (cddar thread)))
5138 (setq gnus-tmp-gathered
5139 (nconc (mapcar
5140 (lambda (h) (mail-header-number (car h)))
5141 (cddar thread))
5142 gnus-tmp-gathered))
5143 (setq thread (cons (list (caar thread)
5144 (cadar thread))
5145 (cdr thread)))
5146 (setq gnus-tmp-level -1
5147 gnus-tmp-false-parent t))
5148 ((eq gnus-summary-make-false-root 'empty)
5149 ;; We print adopted articles with empty subject fields.
5150 (setq gnus-tmp-gathered
5151 (nconc (mapcar
5152 (lambda (h) (mail-header-number (car h)))
5153 (cddar thread))
5154 gnus-tmp-gathered))
5155 (setq gnus-tmp-level -1))
5156 ((eq gnus-summary-make-false-root 'dummy)
5157 ;; We remember that we probably want to output a dummy
5158 ;; root.
5159 (setq gnus-tmp-dummy-line gnus-tmp-header)
5160 (setq gnus-tmp-prev-subject gnus-tmp-header))
5161 (t
5162 ;; We do not make a root for the gathered
5163 ;; sub-threads at all.
5164 (setq gnus-tmp-level -1)))
5165
5166 (setq number (mail-header-number gnus-tmp-header)
23f87bed
MB
5167 subject (mail-header-subject gnus-tmp-header)
5168 simp-subject (gnus-simplify-subject-fully subject))
eec82323
LMI
5169
5170 (cond
5171 ;; If the thread has changed subject, we might want to make
5172 ;; this subthread into a root.
5173 ((and (null gnus-thread-ignore-subject)
5174 (not (zerop gnus-tmp-level))
5175 gnus-tmp-prev-subject
23f87bed 5176 (not (string= gnus-tmp-prev-subject simp-subject)))
eec82323
LMI
5177 (setq new-roots (nconc new-roots (list (car thread)))
5178 thread-end t
5179 gnus-tmp-header nil))
5180 ;; If the article lies outside the current limit,
5181 ;; then we do not display it.
5182 ((not (memq number gnus-newsgroup-limit))
5183 (setq gnus-tmp-gathered
5184 (nconc (mapcar
5185 (lambda (h) (mail-header-number (car h)))
5186 (cdar thread))
5187 gnus-tmp-gathered))
5188 (setq gnus-tmp-new-adopts (if (cdar thread)
5189 (append gnus-tmp-new-adopts
5190 (cdar thread))
5191 gnus-tmp-new-adopts)
5192 thread-end t
5193 gnus-tmp-header nil)
5194 (when (zerop gnus-tmp-level)
5195 (setq gnus-tmp-root-expunged t)))
5196 ;; Perhaps this article is to be marked as read?
5197 ((and gnus-summary-mark-below
5198 (< (or (cdr (assq number gnus-newsgroup-scored))
5199 default-score)
5200 gnus-summary-mark-below)
5201 ;; Don't touch sparse articles.
5202 (not (gnus-summary-article-sparse-p number))
5203 (not (gnus-summary-article-ancient-p number)))
5204 (setq gnus-newsgroup-unreads
5205 (delq number gnus-newsgroup-unreads))
5206 (if gnus-newsgroup-auto-expire
23f87bed
MB
5207 (setq gnus-newsgroup-expirable
5208 (gnus-add-to-sorted-list
5209 gnus-newsgroup-expirable number))
eec82323
LMI
5210 (push (cons number gnus-low-score-mark)
5211 gnus-newsgroup-reads))))
5212
5213 (when gnus-tmp-header
5214 ;; We may have an old dummy line to output before this
5215 ;; article.
6748645f
LMI
5216 (when (and gnus-tmp-dummy-line
5217 (gnus-subject-equal
5218 gnus-tmp-dummy-line
5219 (mail-header-subject gnus-tmp-header)))
eec82323
LMI
5220 (gnus-summary-insert-dummy-line
5221 gnus-tmp-dummy-line (mail-header-number gnus-tmp-header))
5222 (setq gnus-tmp-dummy-line nil))
5223
5224 ;; Compute the mark.
5225 (setq gnus-tmp-unread (gnus-article-mark number))
5226
5227 (push (gnus-data-make number gnus-tmp-unread (1+ (point))
5228 gnus-tmp-header gnus-tmp-level)
5229 gnus-newsgroup-data)
5230
5231 ;; Actually insert the line.
5232 (setq
5233 gnus-tmp-subject-or-nil
5234 (cond
5235 ((and gnus-thread-ignore-subject
5236 gnus-tmp-prev-subject
23f87bed 5237 (not (string= gnus-tmp-prev-subject simp-subject)))
eec82323
LMI
5238 subject)
5239 ((zerop gnus-tmp-level)
5240 (if (and (eq gnus-summary-make-false-root 'empty)
5241 (memq number gnus-tmp-gathered)
5242 gnus-tmp-prev-subject
23f87bed 5243 (string= gnus-tmp-prev-subject simp-subject))
eec82323
LMI
5244 gnus-summary-same-subject
5245 subject))
5246 (t gnus-summary-same-subject)))
5247 (if (and (eq gnus-summary-make-false-root 'adopt)
5248 (= gnus-tmp-level 1)
5249 (memq number gnus-tmp-gathered))
5250 (setq gnus-tmp-opening-bracket ?\<
5251 gnus-tmp-closing-bracket ?\>)
5252 (setq gnus-tmp-opening-bracket ?\[
5253 gnus-tmp-closing-bracket ?\]))
4921bbdd
CY
5254 (if (>= gnus-tmp-level (length gnus-thread-indent-array))
5255 (gnus-make-thread-indent-array
5256 (max (* 2 (length gnus-thread-indent-array))
5257 gnus-tmp-level)))
eec82323
LMI
5258 (setq
5259 gnus-tmp-indentation
5260 (aref gnus-thread-indent-array gnus-tmp-level)
5261 gnus-tmp-lines (mail-header-lines gnus-tmp-header)
5262 gnus-tmp-score (or (cdr (assq number gnus-newsgroup-scored))
5263 gnus-summary-default-score 0)
5264 gnus-tmp-score-char
5265 (if (or (null gnus-summary-default-score)
5266 (<= (abs (- gnus-tmp-score gnus-summary-default-score))
5267 gnus-summary-zcore-fuzz))
23f87bed 5268 ? ;Whitespace
eec82323
LMI
5269 (if (< gnus-tmp-score gnus-summary-default-score)
5270 gnus-score-below-mark gnus-score-over-mark))
5271 gnus-tmp-replied
5272 (cond ((memq number gnus-newsgroup-processable)
5273 gnus-process-mark)
5274 ((memq number gnus-newsgroup-cached)
5275 gnus-cached-mark)
5276 ((memq number gnus-newsgroup-replied)
5277 gnus-replied-mark)
23f87bed
MB
5278 ((memq number gnus-newsgroup-forwarded)
5279 gnus-forwarded-mark)
eec82323
LMI
5280 ((memq number gnus-newsgroup-saved)
5281 gnus-saved-mark)
23f87bed
MB
5282 ((memq number gnus-newsgroup-recent)
5283 gnus-recent-mark)
5284 ((memq number gnus-newsgroup-unseen)
5285 gnus-unseen-mark)
5286 (t gnus-no-mark))
5287 gnus-tmp-downloaded
5288 (cond ((memq number gnus-newsgroup-undownloaded)
5289 gnus-undownloaded-mark)
5290 (gnus-newsgroup-agentized
5291 gnus-downloaded-mark)
5292 (t
5293 gnus-no-mark))
eec82323
LMI
5294 gnus-tmp-from (mail-header-from gnus-tmp-header)
5295 gnus-tmp-name
5296 (cond
5297 ((string-match "<[^>]+> *$" gnus-tmp-from)
5298 (setq beg-match (match-beginning 0))
23f87bed
MB
5299 (or (and (string-match "^\".+\"" gnus-tmp-from)
5300 (substring gnus-tmp-from 1 (1- (match-end 0))))
eec82323
LMI
5301 (substring gnus-tmp-from 0 beg-match)))
5302 ((string-match "(.+)" gnus-tmp-from)
5303 (substring gnus-tmp-from
5304 (1+ (match-beginning 0)) (1- (match-end 0))))
23f87bed
MB
5305 (t gnus-tmp-from))
5306
5307 ;; Do the %B string
5308 gnus-tmp-thread-tree-header-string
5309 (cond
5310 ((not gnus-show-threads) "")
5311 ((zerop gnus-tmp-level)
5312 (cond ((cdar thread)
5313 (or gnus-sum-thread-tree-root subject))
5314 (gnus-tmp-new-adopts
5315 (or gnus-sum-thread-tree-false-root subject))
5316 (t
5317 (or gnus-sum-thread-tree-single-indent subject))))
5318 (t
5319 (concat (apply 'concat
5320 (mapcar (lambda (item)
5321 (if (= item 1)
5322 gnus-sum-thread-tree-vertical
5323 gnus-sum-thread-tree-indent))
5324 (cdr (reverse tree-stack))))
5325 (if (nth 1 thread)
5326 gnus-sum-thread-tree-leaf-with-other
5327 gnus-sum-thread-tree-single-leaf)))))
eec82323
LMI
5328 (when (string= gnus-tmp-name "")
5329 (setq gnus-tmp-name gnus-tmp-from))
5330 (unless (numberp gnus-tmp-lines)
23f87bed
MB
5331 (setq gnus-tmp-lines -1))
5332 (if (= gnus-tmp-lines -1)
5333 (setq gnus-tmp-lines "?")
5334 (setq gnus-tmp-lines (number-to-string gnus-tmp-lines)))
5335 (gnus-put-text-property
eec82323
LMI
5336 (point)
5337 (progn (eval gnus-summary-line-format-spec) (point))
23f87bed 5338 'gnus-number number)
eec82323
LMI
5339 (when gnus-visual-p
5340 (forward-line -1)
6748645f 5341 (gnus-run-hooks 'gnus-summary-update-hook)
eec82323
LMI
5342 (forward-line 1))
5343
23f87bed 5344 (setq gnus-tmp-prev-subject simp-subject)))
eec82323
LMI
5345
5346 (when (nth 1 thread)
23f87bed
MB
5347 (push (list (max 0 gnus-tmp-level)
5348 (copy-sequence tree-stack)
5349 (nthcdr 1 thread))
5350 stack))
5351 (push (if (nth 1 thread) 1 0) tree-stack)
eec82323
LMI
5352 (incf gnus-tmp-level)
5353 (setq threads (if thread-end nil (cdar thread)))
23f87bed
MB
5354 (if gnus-summary-display-while-building
5355 (if building-count
5356 (progn
5357 ;; use a set frequency
5358 (setq building-line-count (1- building-line-count))
5359 (when (= building-line-count 0)
5360 (sit-for 0)
5361 (setq building-line-count
5362 gnus-summary-display-while-building)))
5363 ;; always
5364 (sit-for 0)))
eec82323
LMI
5365 (unless threads
5366 (setq gnus-tmp-level 0)))))
5367 (gnus-message 7 "Generating summary...done"))
5368
5369(defun gnus-summary-prepare-unthreaded (headers)
5370 "Generate an unthreaded summary buffer based on HEADERS."
5371 (let (header number mark)
5372
5373 (beginning-of-line)
5374
5375 (while headers
5376 ;; We may have to root out some bad articles...
5377 (when (memq (setq number (mail-header-number
5378 (setq header (pop headers))))
5379 gnus-newsgroup-limit)
5380 ;; Mark article as read when it has a low score.
5381 (when (and gnus-summary-mark-below
5382 (< (or (cdr (assq number gnus-newsgroup-scored))
5383 gnus-summary-default-score 0)
5384 gnus-summary-mark-below)
5385 (not (gnus-summary-article-ancient-p number)))
5386 (setq gnus-newsgroup-unreads
5387 (delq number gnus-newsgroup-unreads))
5388 (if gnus-newsgroup-auto-expire
5389 (push number gnus-newsgroup-expirable)
5390 (push (cons number gnus-low-score-mark)
5391 gnus-newsgroup-reads)))
5392
5393 (setq mark (gnus-article-mark number))
5394 (push (gnus-data-make number mark (1+ (point)) header 0)
5395 gnus-newsgroup-data)
5396 (gnus-summary-insert-line
5397 header 0 number
23f87bed 5398 (memq number gnus-newsgroup-undownloaded)
eec82323
LMI
5399 mark (memq number gnus-newsgroup-replied)
5400 (memq number gnus-newsgroup-expirable)
5401 (mail-header-subject header) nil
5402 (cdr (assq number gnus-newsgroup-scored))
5403 (memq number gnus-newsgroup-processable))))))
5404
16409b0b
GM
5405(defun gnus-summary-remove-list-identifiers ()
5406 "Remove list identifiers in `gnus-list-identifiers' from articles in the current group."
23f87bed
MB
5407 (let ((regexp (if (consp gnus-list-identifiers)
5408 (mapconcat 'identity gnus-list-identifiers " *\\|")
5409 gnus-list-identifiers))
5410 changed subject)
5411 (when regexp
01c52d31 5412 (setq regexp (concat "^\\(?:R[Ee]: +\\)*\\(" regexp " *\\)"))
23f87bed
MB
5413 (dolist (header gnus-newsgroup-headers)
5414 (setq subject (mail-header-subject header)
5415 changed nil)
01c52d31 5416 (while (string-match regexp subject)
23f87bed 5417 (setq subject
01c52d31 5418 (concat (substring subject 0 (match-beginning 1))
23f87bed
MB
5419 (substring subject (match-end 0)))
5420 changed t))
23f87bed 5421 (when changed
01c52d31
MB
5422 (when (string-match "^\\(\\(?:R[Ee]: +\\)+\\)R[Ee]: +" subject)
5423 (setq subject
5424 (concat (substring subject 0 (match-beginning 1))
5425 (substring subject (match-end 1)))))
23f87bed
MB
5426 (mail-header-set-subject header subject))))))
5427
5428(defun gnus-fetch-headers (articles)
5429 "Fetch headers of ARTICLES."
5430 (let ((name (gnus-group-decoded-name gnus-newsgroup-name)))
5431 (gnus-message 5 "Fetching headers for %s..." name)
5432 (prog1
5433 (if (eq 'nov
5434 (setq gnus-headers-retrieved-by
5435 (gnus-retrieve-headers
5436 articles gnus-newsgroup-name
5437 ;; We might want to fetch old headers, but
5438 ;; not if there is only 1 article.
5439 (and (or (and
5440 (not (eq gnus-fetch-old-headers 'some))
5441 (not (numberp gnus-fetch-old-headers)))
5442 (> (length articles) 1))
5443 gnus-fetch-old-headers))))
5444 (gnus-get-newsgroup-headers-xover
5445 articles nil nil gnus-newsgroup-name t)
5446 (gnus-get-newsgroup-headers))
5447 (gnus-message 5 "Fetching headers for %s...done" name))))
16409b0b 5448
6748645f 5449(defun gnus-select-newsgroup (group &optional read-all select-articles)
eec82323 5450 "Select newsgroup GROUP.
6748645f
LMI
5451If READ-ALL is non-nil, all articles in the group are selected.
5452If SELECT-ARTICLES, only select those articles from GROUP."
01c52d31 5453 (let* ((entry (gnus-group-entry group))
eec82323
LMI
5454 ;;!!! Dirty hack; should be removed.
5455 (gnus-summary-ignore-duplicates
23f87bed 5456 (if (eq (car (gnus-find-method-for-group group)) 'nnvirtual)
eec82323
LMI
5457 t
5458 gnus-summary-ignore-duplicates))
5459 (info (nth 2 entry))
01c52d31 5460 charset articles fetched-articles cached)
eec82323
LMI
5461
5462 (unless (gnus-check-server
475e0e0c
GM
5463 (set (make-local-variable 'gnus-current-select-method)
5464 (gnus-find-method-for-group group)))
eec82323 5465 (error "Couldn't open server"))
01c52d31 5466 (setq charset (gnus-group-name-charset gnus-current-select-method group))
eec82323
LMI
5467
5468 (or (and entry (not (eq (car entry) t))) ; Either it's active...
5469 (gnus-activate-group group) ; Or we can activate it...
5470 (progn ; Or we bug out.
5471 (when (equal major-mode 'gnus-summary-mode)
23f87bed 5472 (gnus-kill-buffer (current-buffer)))
01c52d31
MB
5473 (error
5474 "Couldn't activate group %s: %s"
5475 (mm-decode-coding-string group charset)
5476 (mm-decode-coding-string (gnus-status-message group) charset))))
eec82323
LMI
5477
5478 (unless (gnus-request-group group t)
01c52d31
MB
5479 (when (equal major-mode 'gnus-summary-mode)
5480 (gnus-kill-buffer (current-buffer)))
5481 (error "Couldn't request group %s: %s"
5482 (mm-decode-coding-string group charset)
5483 (mm-decode-coding-string (gnus-status-message group) charset)))
eec82323 5484
23f87bed 5485 (when gnus-agent
54506618 5486 (gnus-agent-possibly-alter-active group (gnus-active group) info)
132cf96d 5487
23f87bed
MB
5488 (setq gnus-summary-use-undownloaded-faces
5489 (gnus-agent-find-parameter
5490 group
5491 'agent-enable-undownloaded-faces)))
5492
5493 (setq gnus-newsgroup-name group
5494 gnus-newsgroup-unselected nil
5495 gnus-newsgroup-unreads (gnus-list-of-unread-articles group))
5496
5497 (let ((display (gnus-group-find-parameter group 'display)))
5498 (setq gnus-newsgroup-display
5499 (cond
5500 ((not (zerop (or (car-safe read-all) 0)))
5501 ;; The user entered the group with C-u SPC/RET, let's show
5502 ;; all articles.
5503 'gnus-not-ignore)
5504 ((eq display 'all)
5505 'gnus-not-ignore)
5506 ((arrayp display)
5507 (gnus-summary-display-make-predicate (mapcar 'identity display)))
5508 ((numberp display)
5509 ;; The following is probably the "correct" solution, but
5510 ;; it makes Gnus fetch all headers and then limit the
5511 ;; articles (which is slow), so instead we hack the
5512 ;; select-articles parameter instead. -- Simon Josefsson
5513 ;; <jas@kth.se>
5514 ;;
5515 ;; (gnus-byte-compile
5516 ;; `(lambda () (> number ,(- (cdr (gnus-active group))
5517 ;; display)))))
5518 (setq select-articles
5519 (gnus-uncompress-range
5520 (cons (let ((tmp (- (cdr (gnus-active group)) display)))
5521 (if (> tmp 0)
5522 tmp
5523 1))
5524 (cdr (gnus-active group)))))
5525 nil)
5526 (t
5527 nil))))
eec82323 5528
23f87bed 5529 (gnus-summary-setup-default-charset)
eec82323
LMI
5530
5531 ;; Kludge to avoid having cached articles nixed out in virtual groups.
5532 (when (gnus-virtual-group-p group)
5533 (setq cached gnus-newsgroup-cached))
5534
5535 (setq gnus-newsgroup-unreads
23f87bed
MB
5536 (gnus-sorted-ndifference
5537 (gnus-sorted-ndifference gnus-newsgroup-unreads
5538 gnus-newsgroup-marked)
eec82323
LMI
5539 gnus-newsgroup-dormant))
5540
5541 (setq gnus-newsgroup-processable nil)
5542
5543 (gnus-update-read-articles group gnus-newsgroup-unreads)
eec82323 5544
23f87bed
MB
5545 ;; Adjust and set lists of article marks.
5546 (when info
5547 (gnus-adjust-marked-articles info))
6748645f
LMI
5548 (if (setq articles select-articles)
5549 (setq gnus-newsgroup-unselected
23f87bed 5550 (gnus-sorted-difference gnus-newsgroup-unreads articles))
6748645f 5551 (setq articles (gnus-articles-to-read group read-all)))
eec82323
LMI
5552
5553 (cond
5554 ((null articles)
5555 ;;(gnus-message 3 "Couldn't select newsgroup -- no articles to display")
5556 'quit)
5557 ((eq articles 0) nil)
5558 (t
5559 ;; Init the dependencies hash table.
5560 (setq gnus-newsgroup-dependencies
5561 (gnus-make-hashtable (length articles)))
16409b0b 5562 (gnus-set-global-variables)
eec82323 5563 ;; Retrieve the headers and read them in.
23f87bed
MB
5564
5565 (setq gnus-newsgroup-headers (gnus-fetch-headers articles))
eec82323
LMI
5566
5567 ;; Kludge to avoid having cached articles nixed out in virtual groups.
5568 (when cached
5569 (setq gnus-newsgroup-cached cached))
5570
5571 ;; Suppress duplicates?
5572 (when gnus-suppress-duplicates
5573 (gnus-dup-suppress-articles))
5574
5575 ;; Set the initial limit.
5576 (setq gnus-newsgroup-limit (copy-sequence articles))
5577 ;; Remove canceled articles from the list of unread articles.
23f87bed
MB
5578 (setq fetched-articles
5579 (mapcar (lambda (headers) (mail-header-number headers))
5580 gnus-newsgroup-headers))
5581 (setq gnus-newsgroup-articles fetched-articles)
eec82323 5582 (setq gnus-newsgroup-unreads
23f87bed
MB
5583 (gnus-sorted-nintersection
5584 gnus-newsgroup-unreads fetched-articles))
5585 (gnus-compute-unseen-list)
5586
eec82323
LMI
5587 ;; Removed marked articles that do not exist.
5588 (gnus-update-missing-marks
23f87bed 5589 (gnus-sorted-difference articles fetched-articles))
eec82323 5590 ;; We might want to build some more threads first.
6748645f
LMI
5591 (when (and gnus-fetch-old-headers
5592 (eq gnus-headers-retrieved-by 'nov))
5593 (if (eq gnus-fetch-old-headers 'invisible)
5594 (gnus-build-all-threads)
5595 (gnus-build-old-threads)))
5596 ;; Let the Gnus agent mark articles as read.
5597 (when gnus-agent
5598 (gnus-agent-get-undownloaded-list))
16409b0b
GM
5599 ;; Remove list identifiers from subject
5600 (when gnus-list-identifiers
5601 (gnus-summary-remove-list-identifiers))
eec82323
LMI
5602 ;; Check whether auto-expire is to be done in this group.
5603 (setq gnus-newsgroup-auto-expire
5604 (gnus-group-auto-expirable-p group))
5605 ;; Set up the article buffer now, if necessary.
01c52d31
MB
5606 (unless (and gnus-single-article-buffer
5607 (equal gnus-article-buffer "*Article*"))
eec82323
LMI
5608 (gnus-article-setup-buffer))
5609 ;; First and last article in this newsgroup.
5610 (when gnus-newsgroup-headers
5611 (setq gnus-newsgroup-begin
5612 (mail-header-number (car gnus-newsgroup-headers))
5613 gnus-newsgroup-end
5614 (mail-header-number
5615 (gnus-last-element gnus-newsgroup-headers))))
5616 ;; GROUP is successfully selected.
5617 (or gnus-newsgroup-headers t)))))
5618
23f87bed
MB
5619(defun gnus-compute-unseen-list ()
5620 ;; The `seen' marks are treated specially.
5621 (if (not gnus-newsgroup-seen)
5622 (setq gnus-newsgroup-unseen gnus-newsgroup-articles)
5623 (setq gnus-newsgroup-unseen
5624 (gnus-inverse-list-range-intersection
5625 gnus-newsgroup-articles gnus-newsgroup-seen))))
5626
d09ae6ca
GM
5627(declare-function gnus-get-predicate "gnus-agent" (predicate))
5628
23f87bed
MB
5629(defun gnus-summary-display-make-predicate (display)
5630 (require 'gnus-agent)
5631 (when (= (length display) 1)
5632 (setq display (car display)))
5633 (unless gnus-summary-display-cache
5634 (dolist (elem (append '((unread . unread)
5635 (read . read)
5636 (unseen . unseen))
5637 gnus-article-mark-lists))
5638 (push (cons (cdr elem)
5639 (gnus-byte-compile
5640 `(lambda () (gnus-article-marked-p ',(cdr elem)))))
5641 gnus-summary-display-cache)))
5642 (let ((gnus-category-predicate-alist gnus-summary-display-cache)
5643 (gnus-category-predicate-cache gnus-summary-display-cache))
5644 (gnus-get-predicate display)))
5645
5646;; Uses the dynamically bound `number' variable.
9efa445f 5647(defvar number)
23f87bed
MB
5648(defun gnus-article-marked-p (type &optional article)
5649 (let ((article (or article number)))
5650 (cond
5651 ((eq type 'tick)
5652 (memq article gnus-newsgroup-marked))
5653 ((eq type 'spam)
5654 (memq article gnus-newsgroup-spam-marked))
5655 ((eq type 'unsend)
5656 (memq article gnus-newsgroup-unsendable))
5657 ((eq type 'undownload)
5658 (memq article gnus-newsgroup-undownloaded))
5659 ((eq type 'download)
5660 (memq article gnus-newsgroup-downloadable))
5661 ((eq type 'unread)
5662 (memq article gnus-newsgroup-unreads))
5663 ((eq type 'read)
5664 (memq article gnus-newsgroup-reads))
5665 ((eq type 'dormant)
5666 (memq article gnus-newsgroup-dormant) )
5667 ((eq type 'expire)
5668 (memq article gnus-newsgroup-expirable))
5669 ((eq type 'reply)
5670 (memq article gnus-newsgroup-replied))
5671 ((eq type 'killed)
5672 (memq article gnus-newsgroup-killed))
5673 ((eq type 'bookmark)
5674 (assq article gnus-newsgroup-bookmarks))
5675 ((eq type 'score)
5676 (assq article gnus-newsgroup-scored))
5677 ((eq type 'save)
5678 (memq article gnus-newsgroup-saved))
5679 ((eq type 'cache)
5680 (memq article gnus-newsgroup-cached))
5681 ((eq type 'forward)
5682 (memq article gnus-newsgroup-forwarded))
5683 ((eq type 'seen)
5684 (not (memq article gnus-newsgroup-unseen)))
5685 ((eq type 'recent)
5686 (memq article gnus-newsgroup-recent))
5687 (t t))))
5688
eec82323 5689(defun gnus-articles-to-read (group &optional read-all)
16409b0b 5690 "Find out what articles the user wants to read."
26c9afc3 5691 (let* ((articles
eec82323
LMI
5692 ;; Select all articles if `read-all' is non-nil, or if there
5693 ;; are no unread articles.
5694 (if (or read-all
5695 (and (zerop (length gnus-newsgroup-marked))
5696 (zerop (length gnus-newsgroup-unreads)))
23f87bed
MB
5697 ;; Fetch all if the predicate is non-nil.
5698 gnus-newsgroup-display)
5699 ;; We want to select the headers for all the articles in
5700 ;; the group, so we select either all the active
5701 ;; articles in the group, or (if that's nil), the
5702 ;; articles in the cache.
16409b0b 5703 (or
4b70e299 5704 (if gnus-newsgroup-maximum-articles
11abff8e
MB
5705 (let ((active (gnus-active group)))
5706 (gnus-uncompress-range
5707 (cons (max (car active)
4b70e299
MB
5708 (- (cdr active)
5709 gnus-newsgroup-maximum-articles
5710 -1))
11abff8e
MB
5711 (cdr active))))
5712 (gnus-uncompress-range (gnus-active group)))
16409b0b 5713 (gnus-cache-articles-in-group group))
23f87bed
MB
5714 ;; Select only the "normal" subset of articles.
5715 (gnus-sorted-nunion
5716 (gnus-sorted-union gnus-newsgroup-dormant gnus-newsgroup-marked)
5717 gnus-newsgroup-unreads)))
eec82323
LMI
5718 (scored-list (gnus-killed-articles gnus-newsgroup-killed articles))
5719 (scored (length scored-list))
5720 (number (length articles))
5721 (marked (+ (length gnus-newsgroup-marked)
5722 (length gnus-newsgroup-dormant)))
5723 (select
5724 (cond
5725 ((numberp read-all)
5726 read-all)
23f87bed
MB
5727 ((numberp gnus-newsgroup-display)
5728 gnus-newsgroup-display)
eec82323
LMI
5729 (t
5730 (condition-case ()
5731 (cond
5732 ((and (or (<= scored marked) (= scored number))
5733 (numberp gnus-large-newsgroup)
5734 (> number gnus-large-newsgroup))
23f87bed
MB
5735 (let* ((cursor-in-echo-area nil)
5736 (initial (gnus-parameter-large-newsgroup-initial
5737 gnus-newsgroup-name))
5738 (input
5739 (read-string
5740 (format
5741 "How many articles from %s (%s %d): "
01c52d31 5742 (gnus-group-decoded-name gnus-newsgroup-name)
23f87bed
MB
5743 (if initial "max" "default")
5744 number)
5745 (if initial
5746 (cons (number-to-string initial)
5747 0)))))
eec82323
LMI
5748 (if (string-match "^[ \t]*$" input) number input)))
5749 ((and (> scored marked) (< scored number)
5750 (> (- scored number) 20))
5751 (let ((input
5752 (read-string
5753 (format "%s %s (%d scored, %d total): "
5754 "How many articles from"
23f87bed
MB
5755 (gnus-group-decoded-name group)
5756 scored number))))
eec82323
LMI
5757 (if (string-match "^[ \t]*$" input)
5758 number input)))
5759 (t number))
d4dfaa19
DL
5760 (quit
5761 (message "Quit getting the articles to read")
5762 nil))))))
eec82323
LMI
5763 (setq select (if (stringp select) (string-to-number select) select))
5764 (if (or (null select) (zerop select))
5765 select
5766 (if (and (not (zerop scored)) (<= (abs select) scored))
5767 (progn
5768 (setq articles (sort scored-list '<))
5769 (setq number (length articles)))
5770 (setq articles (copy-sequence articles)))
5771
5772 (when (< (abs select) number)
5773 (if (< select 0)
5774 ;; Select the N oldest articles.
5775 (setcdr (nthcdr (1- (abs select)) articles) nil)
5776 ;; Select the N most recent articles.
5777 (setq articles (nthcdr (- number select) articles))))
5778 (setq gnus-newsgroup-unselected
23f87bed 5779 (gnus-sorted-difference gnus-newsgroup-unreads articles))
16409b0b 5780 (when gnus-alter-articles-to-read-function
23f87bed 5781 (setq articles
a1506d29 5782 (sort
16409b0b 5783 (funcall gnus-alter-articles-to-read-function
23f87bed 5784 gnus-newsgroup-name articles)
16409b0b 5785 '<)))
eec82323
LMI
5786 articles)))
5787
5788(defun gnus-killed-articles (killed articles)
5789 (let (out)
5790 (while articles
5791 (when (inline (gnus-member-of-range (car articles) killed))
5792 (push (car articles) out))
5793 (setq articles (cdr articles)))
5794 out))
5795
5796(defun gnus-uncompress-marks (marks)
5797 "Uncompress the mark ranges in MARKS."
5798 (let ((uncompressed '(score bookmark))
5799 out)
5800 (while marks
5801 (if (memq (caar marks) uncompressed)
5802 (push (car marks) out)
5803 (push (cons (caar marks) (gnus-uncompress-range (cdar marks))) out))
5804 (setq marks (cdr marks)))
5805 out))
5806
23f87bed
MB
5807(defun gnus-article-mark-to-type (mark)
5808 "Return the type of MARK."
5809 (or (cadr (assq mark gnus-article-special-mark-lists))
5810 'list))
5811
5812(defun gnus-article-unpropagatable-p (mark)
5813 "Return whether MARK should be propagated to back end."
5814 (memq mark gnus-article-unpropagated-mark-lists))
5815
eec82323 5816(defun gnus-adjust-marked-articles (info)
16409b0b 5817 "Set all article lists and remove all marks that are no longer valid."
eec82323
LMI
5818 (let* ((marked-lists (gnus-info-marks info))
5819 (active (gnus-active (gnus-info-group info)))
5820 (min (car active))
5821 (max (cdr active))
5822 (types gnus-article-mark-lists)
54506618
MB
5823 marks var articles article mark mark-type
5824 bgn end)
eec82323 5825
23f87bed
MB
5826 (dolist (marks marked-lists)
5827 (setq mark (car marks)
5828 mark-type (gnus-article-mark-to-type mark)
5829 var (intern (format "gnus-newsgroup-%s" (car (rassq mark types)))))
eec82323 5830
23f87bed
MB
5831 ;; We set the variable according to the type of the marks list,
5832 ;; and then adjust the marks to a subset of the active articles.
eec82323 5833 (cond
54506618 5834 ;; Adjust "simple" lists - compressed yet unsorted
23f87bed 5835 ((eq mark-type 'list)
54506618
MB
5836 ;; Simultaneously uncompress and clip to active range
5837 ;; See gnus-uncompress-range for a description of possible marks
5838 (let (l lh)
5839 (if (not (cadr marks))
5840 (set var nil)
5841 (setq articles (if (numberp (cddr marks))
5842 (list (cdr marks))
5843 (cdr marks))
5844 lh (cons nil nil)
5845 l lh)
5846
5847 (while (setq article (pop articles))
5848 (cond ((consp article)
5849 (setq bgn (max (car article) min)
5850 end (min (cdr article) max))
5851 (while (<= bgn end)
5852 (setq l (setcdr l (cons bgn nil))
5853 bgn (1+ bgn))))
5854 ((and (<= min article)
5855 (>= max article))
5856 (setq l (setcdr l (cons article nil))))))
5857 (set var (cdr lh)))))
eec82323 5858 ;; Adjust assocs.
23f87bed
MB
5859 ((eq mark-type 'tuple)
5860 (set var (setq articles (cdr marks)))
a8151ef7
LMI
5861 (when (not (listp (cdr (symbol-value var))))
5862 (set var (list (symbol-value var))))
5863 (when (not (listp (cdr articles)))
5864 (setq articles (list articles)))
eec82323
LMI
5865 (while articles
5866 (when (or (not (consp (setq article (pop articles))))
5867 (< (car article) min)
5868 (> (car article) max))
23f87bed
MB
5869 (set var (delq article (symbol-value var))))))
5870 ;; Adjust ranges (sloppily).
5871 ((eq mark-type 'range)
5872 (cond
5873 ((eq mark 'seen)
5874 ;; Fix the record for `seen' if it looks like (seen NUM1 . NUM2).
5875 ;; It should be (seen (NUM1 . NUM2)).
5876 (when (numberp (cddr marks))
5877 (setcdr marks (list (cdr marks))))
5878 (setq articles (cdr marks))
5879 (while (and articles
5880 (or (and (consp (car articles))
5881 (> min (cdar articles)))
5882 (and (numberp (car articles))
5883 (> min (car articles)))))
5884 (pop articles))
5885 (set var articles))))))))
eec82323
LMI
5886
5887(defun gnus-update-missing-marks (missing)
6748645f 5888 "Go through the list of MISSING articles and remove them from the mark lists."
eec82323 5889 (when missing
23f87bed 5890 (let (var m)
eec82323 5891 ;; Go through all types.
23f87bed
MB
5892 (dolist (elem gnus-article-mark-lists)
5893 (when (eq (gnus-article-mark-to-type (cdr elem)) 'list)
5894 (setq var (intern (format "gnus-newsgroup-%s" (car elem))))
5895 (when (symbol-value var)
5896 ;; This list has articles. So we delete all missing
5897 ;; articles from it.
5898 (setq m missing)
5899 (while m
5900 (set var (delq (pop m) (symbol-value var))))))))))
eec82323
LMI
5901
5902(defun gnus-update-marks ()
5903 "Enter the various lists of marked articles into the newsgroup info list."
5904 (let ((types gnus-article-mark-lists)
5905 (info (gnus-get-info gnus-newsgroup-name))
16409b0b 5906 type list newmarked symbol delta-marks)
eec82323 5907 (when info
16409b0b 5908 ;; Add all marks lists to the list of marks lists.
eec82323 5909 (while (setq type (pop types))
16409b0b
GM
5910 (setq list (symbol-value
5911 (setq symbol
23f87bed 5912 (intern (format "gnus-newsgroup-%s" (car type))))))
eec82323 5913
16409b0b 5914 (when list
eec82323
LMI
5915 ;; Get rid of the entries of the articles that have the
5916 ;; default score.
5917 (when (and (eq (cdr type) 'score)
5918 gnus-save-score
5919 list)
5920 (let* ((arts list)
5921 (prev (cons nil list))
5922 (all prev))
5923 (while arts
5924 (if (or (not (consp (car arts)))
5925 (= (cdar arts) gnus-summary-default-score))
5926 (setcdr prev (cdr arts))
5927 (setq prev arts))
5928 (setq arts (cdr arts)))
16409b0b
GM
5929 (setq list (cdr all)))))
5930
23f87bed
MB
5931 (when (eq (cdr type) 'seen)
5932 (setq list (gnus-range-add list gnus-newsgroup-unseen)))
5933
5934 (when (eq (gnus-article-mark-to-type (cdr type)) 'list)
16409b0b 5935 (setq list (gnus-compress-sequence (set symbol (sort list '<)) t)))
a1506d29 5936
23f87bed
MB
5937 (when (and (gnus-check-backend-function
5938 'request-set-mark gnus-newsgroup-name)
5939 (not (gnus-article-unpropagatable-p (cdr type))))
5940 (let* ((old (cdr (assq (cdr type) (gnus-info-marks info))))
5941 (del (gnus-remove-from-range (gnus-copy-sequence old) list))
5942 (add (gnus-remove-from-range
5943 (gnus-copy-sequence list) old)))
5944 (when add
5945 (push (list add 'add (list (cdr type))) delta-marks))
5946 (when del
5947 (push (list del 'del (list (cdr type))) delta-marks))))
a1506d29 5948
16409b0b
GM
5949 (when list
5950 (push (cons (cdr type) list) newmarked)))
5951
5952 (when delta-marks
5953 (unless (gnus-check-group gnus-newsgroup-name)
5954 (error "Can't open server for %s" gnus-newsgroup-name))
5955 (gnus-request-set-mark gnus-newsgroup-name delta-marks))
a1506d29 5956
eec82323
LMI
5957 ;; Enter these new marks into the info of the group.
5958 (if (nthcdr 3 info)
5959 (setcar (nthcdr 3 info) newmarked)
5960 ;; Add the marks lists to the end of the info.
5961 (when newmarked
5962 (setcdr (nthcdr 2 info) (list newmarked))))
5963
5964 ;; Cut off the end of the info if there's nothing else there.
5965 (let ((i 5))
5966 (while (and (> i 2)
5967 (not (nth i info)))
5968 (when (nthcdr (decf i) info)
5969 (setcdr (nthcdr i info) nil)))))))
5970
5971(defun gnus-set-mode-line (where)
16409b0b 5972 "Set the mode line of the article or summary buffers.
eec82323
LMI
5973If WHERE is `summary', the summary mode line format will be used."
5974 ;; Is this mode line one we keep updated?
16409b0b
GM
5975 (when (and (memq where gnus-updated-mode-lines)
5976 (symbol-value
5977 (intern (format "gnus-%s-mode-line-format-spec" where))))
eec82323 5978 (let (mode-string)
c7a91ce1
SM
5979 ;; We evaluate this in the summary buffer since these
5980 ;; variables are buffer-local to that buffer.
5981 (with-current-buffer gnus-summary-buffer
5982 ;; We bind all these variables that are used in the `eval' form
eec82323
LMI
5983 ;; below.
5984 (let* ((mformat (symbol-value
5985 (intern
5986 (format "gnus-%s-mode-line-format-spec" where))))
b90a6149
MB
5987 (gnus-tmp-group-name (gnus-mode-string-quote
5988 (gnus-group-decoded-name
5989 gnus-newsgroup-name)))
eec82323
LMI
5990 (gnus-tmp-article-number (or gnus-current-article 0))
5991 (gnus-tmp-unread gnus-newsgroup-unreads)
5992 (gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads))
5993 (gnus-tmp-unselected (length gnus-newsgroup-unselected))
5994 (gnus-tmp-unread-and-unselected
5995 (cond ((and (zerop gnus-tmp-unread-and-unticked)
5996 (zerop gnus-tmp-unselected))
5997 "")
5998 ((zerop gnus-tmp-unselected)
5999 (format "{%d more}" gnus-tmp-unread-and-unticked))
6000 (t (format "{%d(+%d) more}"
6001 gnus-tmp-unread-and-unticked
6002 gnus-tmp-unselected))))
6003 (gnus-tmp-subject
6004 (if (and gnus-current-headers
6005 (vectorp gnus-current-headers))
6006 (gnus-mode-string-quote
6007 (mail-header-subject gnus-current-headers))
6008 ""))
6009 bufname-length max-len
23f87bed 6010 gnus-tmp-header) ;; passed as argument to any user-format-funcs
eec82323
LMI
6011 (setq mode-string (eval mformat))
6012 (setq bufname-length (if (string-match "%b" mode-string)
6013 (- (length
6014 (buffer-name
6015 (if (eq where 'summary)
6016 nil
6017 (get-buffer gnus-article-buffer))))
6018 2)
6019 0))
6020 (setq max-len (max 4 (if gnus-mode-non-string-length
6021 (- (window-width)
6022 gnus-mode-non-string-length
6023 bufname-length)
6024 (length mode-string))))
6025 ;; We might have to chop a bit of the string off...
6026 (when (> (length mode-string) max-len)
6027 (setq mode-string
16409b0b 6028 (concat (truncate-string-to-width mode-string (- max-len 3))
eec82323
LMI
6029 "...")))
6030 ;; Pad the mode string a bit.
6031 (setq mode-string (format (format "%%-%ds" max-len) mode-string))))
6032 ;; Update the mode line.
6033 (setq mode-line-buffer-identification
6034 (gnus-mode-line-buffer-identification (list mode-string)))
6035 (set-buffer-modified-p t))))
6036
6037(defun gnus-create-xref-hashtb (from-newsgroup headers unreads)
6038 "Go through the HEADERS list and add all Xrefs to a hash table.
6039The resulting hash table is returned, or nil if no Xrefs were found."
6040 (let* ((virtual (gnus-virtual-group-p from-newsgroup))
6041 (prefix (if virtual "" (gnus-group-real-prefix from-newsgroup)))
6042 (xref-hashtb (gnus-make-hashtable))
6043 start group entry number xrefs header)
6044 (while headers
6045 (setq header (pop headers))
6046 (when (and (setq xrefs (mail-header-xref header))
6047 (not (memq (setq number (mail-header-number header))
6048 unreads)))
6049 (setq start 0)
6050 (while (string-match "\\([^ ]+\\)[:/]\\([0-9]+\\)" xrefs start)
6051 (setq start (match-end 0))
6052 (setq group (if prefix
6053 (concat prefix (substring xrefs (match-beginning 1)
6054 (match-end 1)))
6055 (substring xrefs (match-beginning 1) (match-end 1))))
6056 (setq number
e9bd5782 6057 (string-to-number (substring xrefs (match-beginning 2)
eec82323
LMI
6058 (match-end 2))))
6059 (if (setq entry (gnus-gethash group xref-hashtb))
6060 (setcdr entry (cons number (cdr entry)))
6061 (gnus-sethash group (cons number nil) xref-hashtb)))))
6062 (and start xref-hashtb)))
6063
6064(defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads)
6065 "Look through all the headers and mark the Xrefs as read."
6066 (let ((virtual (gnus-virtual-group-p from-newsgroup))
01c52d31 6067 name info xref-hashtb idlist method nth4)
eec82323
LMI
6068 (save-excursion
6069 (set-buffer gnus-group-buffer)
6070 (when (setq xref-hashtb
6071 (gnus-create-xref-hashtb from-newsgroup headers unreads))
6072 (mapatoms
6073 (lambda (group)
6074 (unless (string= from-newsgroup (setq name (symbol-name group)))
6075 (setq idlist (symbol-value group))
6076 ;; Dead groups are not updated.
6077 (and (prog1
01c52d31 6078 (setq info (gnus-get-info name))
eec82323
LMI
6079 (when (stringp (setq nth4 (gnus-info-method info)))
6080 (setq nth4 (gnus-server-to-method nth4))))
6081 ;; Only do the xrefs if the group has the same
6082 ;; select method as the group we have just read.
6083 (or (gnus-methods-equal-p
6084 nth4 (gnus-find-method-for-group from-newsgroup))
6085 virtual
6086 (equal nth4 (setq method (gnus-find-method-for-group
6087 from-newsgroup)))
6088 (and (equal (car nth4) (car method))
6089 (equal (nth 1 nth4) (nth 1 method))))
6090 gnus-use-cross-reference
6091 (or (not (eq gnus-use-cross-reference t))
6092 virtual
6093 ;; Only do cross-references on subscribed
6094 ;; groups, if that is what is wanted.
6095 (<= (gnus-info-level info) gnus-level-subscribed))
6096 (gnus-group-make-articles-read name idlist))))
6097 xref-hashtb)))))
6098
6748645f 6099(defun gnus-compute-read-articles (group articles)
01c52d31 6100 (let* ((entry (gnus-group-entry group))
6748645f
LMI
6101 (info (nth 2 entry))
6102 (active (gnus-active group))
6103 ninfo)
6104 (when entry
16409b0b 6105 ;; First peel off all invalid article numbers.
6748645f
LMI
6106 (when active
6107 (let ((ids articles)
6108 id first)
6109 (while (setq id (pop ids))
6110 (when (and first (> id (cdr active)))
6111 ;; We'll end up in this situation in one particular
6112 ;; obscure situation. If you re-scan a group and get
6113 ;; a new article that is cross-posted to a different
6114 ;; group that has not been re-scanned, you might get
6115 ;; crossposted article that has a higher number than
6116 ;; Gnus believes possible. So we re-activate this
6117 ;; group as well. This might mean doing the
6118 ;; crossposting thingy will *increase* the number
6119 ;; of articles in some groups. Tsk, tsk.
6120 (setq active (or (gnus-activate-group group) active)))
6121 (when (or (> id (cdr active))
6122 (< id (car active)))
6123 (setq articles (delq id articles))))))
6124 ;; If the read list is nil, we init it.
6125 (if (and active
6126 (null (gnus-info-read info))
6127 (> (car active) 1))
6128 (setq ninfo (cons 1 (1- (car active))))
6129 (setq ninfo (gnus-info-read info)))
6130 ;; Then we add the read articles to the range.
6131 (gnus-add-to-range
6132 ninfo (setq articles (sort articles '<))))))
6133
eec82323
LMI
6134(defun gnus-group-make-articles-read (group articles)
6135 "Update the info of GROUP to say that ARTICLES are read."
6136 (let* ((num 0)
01c52d31 6137 (entry (gnus-group-entry group))
eec82323
LMI
6138 (info (nth 2 entry))
6139 (active (gnus-active group))
6140 range)
6748645f
LMI
6141 (when entry
6142 (setq range (gnus-compute-read-articles group articles))
01c52d31 6143 (with-current-buffer gnus-group-buffer
6748645f
LMI
6144 (gnus-undo-register
6145 `(progn
6146 (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
6147 (gnus-info-set-read ',info ',(gnus-info-read info))
6148 (gnus-get-unread-articles-in-group ',info (gnus-active ,group))
23f87bed 6149 (gnus-request-set-mark ,group (list (list ',range 'del '(read))))
6748645f
LMI
6150 (gnus-group-update-group ,group t))))
6151 ;; Add the read articles to the range.
6152 (gnus-info-set-read info range)
23f87bed 6153 (gnus-request-set-mark group (list (list range 'add '(read))))
6748645f
LMI
6154 ;; Then we have to re-compute how many unread
6155 ;; articles there are in this group.
6156 (when active
6157 (cond
6158 ((not range)
6159 (setq num (- (1+ (cdr active)) (car active))))
6160 ((not (listp (cdr range)))
6161 (setq num (- (cdr active) (- (1+ (cdr range))
6162 (car range)))))
6163 (t
6164 (while range
6165 (if (numberp (car range))
6166 (setq num (1+ num))
6167 (setq num (+ num (- (1+ (cdar range)) (caar range)))))
6168 (setq range (cdr range)))
6169 (setq num (- (cdr active) num))))
6170 ;; Update the number of unread articles.
6171 (setcar entry num)
6172 ;; Update the group buffer.
23f87bed
MB
6173 (unless (gnus-ephemeral-group-p group)
6174 (gnus-group-update-group group t))))))
eec82323 6175
eec82323
LMI
6176(defvar gnus-newsgroup-none-id 0)
6177
6178(defun gnus-get-newsgroup-headers (&optional dependencies force-new)
6179 (let ((cur nntp-server-buffer)
6180 (dependencies
6181 (or dependencies
01c52d31
MB
6182 (with-current-buffer gnus-summary-buffer
6183 gnus-newsgroup-dependencies)))
6184 headers id end ref number
16409b0b
GM
6185 (mail-parse-charset gnus-newsgroup-charset)
6186 (mail-parse-ignored-charsets
c7a91ce1
SM
6187 (save-current-buffer (condition-case nil
6188 (set-buffer gnus-summary-buffer)
6189 (error))
6190 gnus-newsgroup-ignored-charsets)))
6191 (with-current-buffer nntp-server-buffer
eec82323
LMI
6192 ;; Translate all TAB characters into SPACE characters.
6193 (subst-char-in-region (point-min) (point-max) ?\t ? t)
16409b0b 6194 (subst-char-in-region (point-min) (point-max) ?\r ? t)
23f87bed 6195 (ietf-drums-unfold-fws)
6748645f 6196 (gnus-run-hooks 'gnus-parse-headers-hook)
eec82323 6197 (let ((case-fold-search t)
6748645f 6198 in-reply-to header p lines chars)
eec82323 6199 (goto-char (point-min))
01ccbb85 6200 ;; Search to the beginning of the next header. Error messages
eec82323
LMI
6201 ;; do not begin with 2 or 3.
6202 (while (re-search-forward "^[23][0-9]+ " nil t)
6203 (setq id nil
6204 ref nil)
6205 ;; This implementation of this function, with nine
6206 ;; search-forwards instead of the one re-search-forward and
6207 ;; a case (which basically was the old function) is actually
01ccbb85 6208 ;; about twice as fast, even though it looks messier. You
eec82323
LMI
6209 ;; can't have everything, I guess. Speed and elegance
6210 ;; doesn't always go hand in hand.
6211 (setq
6212 header
6213 (vector
6214 ;; Number.
6215 (prog1
01c52d31 6216 (setq number (read cur))
eec82323
LMI
6217 (end-of-line)
6218 (setq p (point))
6219 (narrow-to-region (point)
6220 (or (and (search-forward "\n.\n" nil t)
6221 (- (point) 2))
6222 (point))))
6223 ;; Subject.
6224 (progn
6225 (goto-char p)
23f87bed 6226 (if (search-forward "\nsubject:" nil t)
16409b0b
GM
6227 (funcall gnus-decode-encoded-word-function
6228 (nnheader-header-value))
2bd3dcae 6229 "(none)"))
eec82323
LMI
6230 ;; From.
6231 (progn
6232 (goto-char p)
23f87bed 6233 (if (search-forward "\nfrom:" nil t)
343d6628 6234 (funcall gnus-decode-encoded-address-function
16409b0b 6235 (nnheader-header-value))
2bd3dcae 6236 "(nobody)"))
eec82323
LMI
6237 ;; Date.
6238 (progn
6239 (goto-char p)
23f87bed 6240 (if (search-forward "\ndate:" nil t)
eec82323
LMI
6241 (nnheader-header-value) ""))
6242 ;; Message-ID.
6243 (progn
6244 (goto-char p)
6748645f
LMI
6245 (setq id (if (re-search-forward
6246 "^message-id: *\\(<[^\n\t> ]+>\\)" nil t)
6247 ;; We do it this way to make sure the Message-ID
6248 ;; is (somewhat) syntactically valid.
6249 (buffer-substring (match-beginning 1)
6250 (match-end 1))
eec82323
LMI
6251 ;; If there was no message-id, we just fake one
6252 ;; to make subsequent routines simpler.
01c52d31 6253 (nnheader-generate-fake-message-id number))))
eec82323
LMI
6254 ;; References.
6255 (progn
6256 (goto-char p)
23f87bed 6257 (if (search-forward "\nreferences:" nil t)
eec82323
LMI
6258 (progn
6259 (setq end (point))
6260 (prog1
6261 (nnheader-header-value)
6262 (setq ref
6263 (buffer-substring
6264 (progn
6265 (end-of-line)
6266 (search-backward ">" end t)
6267 (1+ (point)))
6268 (progn
6269 (search-backward "<" end t)
6270 (point))))))
6271 ;; Get the references from the in-reply-to header if there
6272 ;; were no references and the in-reply-to header looks
6273 ;; promising.
23f87bed 6274 (if (and (search-forward "\nin-reply-to:" nil t)
eec82323
LMI
6275 (setq in-reply-to (nnheader-header-value))
6276 (string-match "<[^>]+>" in-reply-to))
6748645f
LMI
6277 (let (ref2)
6278 (setq ref (substring in-reply-to (match-beginning 0)
6279 (match-end 0)))
6280 (while (string-match "<[^>]+>" in-reply-to (match-end 0))
6281 (setq ref2 (substring in-reply-to (match-beginning 0)
6282 (match-end 0)))
6283 (when (> (length ref2) (length ref))
6284 (setq ref ref2)))
6285 ref)
eec82323
LMI
6286 (setq ref nil))))
6287 ;; Chars.
6748645f
LMI
6288 (progn
6289 (goto-char p)
6290 (if (search-forward "\nchars: " nil t)
6291 (if (numberp (setq chars (ignore-errors (read cur))))
23f87bed
MB
6292 chars -1)
6293 -1))
eec82323
LMI
6294 ;; Lines.
6295 (progn
6296 (goto-char p)
6297 (if (search-forward "\nlines: " nil t)
a8151ef7 6298 (if (numberp (setq lines (ignore-errors (read cur))))
23f87bed
MB
6299 lines -1)
6300 -1))
eec82323
LMI
6301 ;; Xref.
6302 (progn
6303 (goto-char p)
23f87bed 6304 (and (search-forward "\nxref:" nil t)
16409b0b
GM
6305 (nnheader-header-value)))
6306 ;; Extra.
6307 (when gnus-extra-headers
6308 (let ((extra gnus-extra-headers)
6309 out)
6310 (while extra
6311 (goto-char p)
6312 (when (search-forward
23f87bed 6313 (concat "\n" (symbol-name (car extra)) ":") nil t)
16409b0b
GM
6314 (push (cons (car extra) (nnheader-header-value))
6315 out))
6316 (pop extra))
6317 out))))
eec82323
LMI
6318 (when (equal id ref)
6319 (setq ref nil))
6748645f
LMI
6320
6321 (when gnus-alter-header-function
6322 (funcall gnus-alter-header-function header)
6323 (setq id (mail-header-id header)
6324 ref (gnus-parent-id (mail-header-references header))))
6325
6326 (when (setq header
6327 (gnus-dependencies-add-header
6328 header dependencies force-new))
eec82323
LMI
6329 (push header headers))
6330 (goto-char (point-max))
6331 (widen))
6332 (nreverse headers)))))
6333
eec82323
LMI
6334;; Goes through the xover lines and returns a list of vectors
6335(defun gnus-get-newsgroup-headers-xover (sequence &optional
6336 force-new dependencies
6337 group also-fetch-heads)
16409b0b
GM
6338 "Parse the news overview data in the server buffer.
6339Return a list of headers that match SEQUENCE (see
6340`nntp-retrieve-headers')."
eec82323
LMI
6341 ;; Get the Xref when the users reads the articles since most/some
6342 ;; NNTP servers do not include Xrefs when using XOVER.
6343 (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
16409b0b
GM
6344 (let ((mail-parse-charset gnus-newsgroup-charset)
6345 (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)
6346 (cur nntp-server-buffer)
eec82323 6347 (dependencies (or dependencies gnus-newsgroup-dependencies))
23f87bed
MB
6348 (allp (cond
6349 ((eq gnus-read-all-available-headers t)
6350 t)
14e6dc54
MB
6351 ((and (stringp gnus-read-all-available-headers)
6352 group)
23f87bed
MB
6353 (string-match gnus-read-all-available-headers group))
6354 (t
6355 nil)))
eec82323 6356 number headers header)
c7a91ce1 6357 (with-current-buffer nntp-server-buffer
16409b0b 6358 (subst-char-in-region (point-min) (point-max) ?\r ? t)
eec82323 6359 ;; Allow the user to mangle the headers before parsing them.
6748645f 6360 (gnus-run-hooks 'gnus-parse-headers-hook)
eec82323 6361 (goto-char (point-min))
23f87bed
MB
6362 (gnus-parse-without-error
6363 (while (and (or sequence allp)
6364 (not (eobp)))
6365 (setq number (read cur))
6366 (when (not allp)
6367 (while (and sequence
6368 (< (car sequence) number))
6369 (setq sequence (cdr sequence))))
6370 (when (and (or allp
6371 (and sequence
6372 (eq number (car sequence))))
6373 (progn
6374 (setq sequence (cdr sequence))
6375 (setq header (inline
6376 (gnus-nov-parse-line
6377 number dependencies force-new)))))
6378 (push header headers))
6379 (forward-line 1)))
eec82323
LMI
6380 ;; A common bug in inn is that if you have posted an article and
6381 ;; then retrieves the active file, it will answer correctly --
6382 ;; the new article is included. However, a NOV entry for the
6383 ;; article may not have been generated yet, so this may fail.
6384 ;; We work around this problem by retrieving the last few
6385 ;; headers using HEAD.
6386 (if (or (not also-fetch-heads)
6387 (not sequence))
6388 ;; We (probably) got all the headers.
6389 (nreverse headers)
6390 (let ((gnus-nov-is-evil t))
6391 (nconc
6392 (nreverse headers)
23f87bed 6393 (when (eq (gnus-retrieve-headers sequence group) 'headers)
eec82323
LMI
6394 (gnus-get-newsgroup-headers))))))))
6395
6396(defun gnus-article-get-xrefs ()
6397 "Fill in the Xref value in `gnus-current-headers', if necessary.
6398This is meant to be called in `gnus-article-internal-prepare-hook'."
01c52d31
MB
6399 (let ((headers (with-current-buffer gnus-summary-buffer
6400 gnus-current-headers)))
eec82323
LMI
6401 (or (not gnus-use-cross-reference)
6402 (not headers)
6403 (and (mail-header-xref headers)
6404 (not (string= (mail-header-xref headers) "")))
6405 (let ((case-fold-search t)
6406 xref)
6407 (save-restriction
6408 (nnheader-narrow-to-headers)
6409 (goto-char (point-min))
16409b0b
GM
6410 (when (or (and (not (eobp))
6411 (eq (downcase (char-after)) ?x)
eec82323
LMI
6412 (looking-at "Xref:"))
6413 (search-forward "\nXref:" nil t))
6414 (goto-char (1+ (match-end 0)))
01c52d31 6415 (setq xref (buffer-substring (point) (point-at-eol)))
eec82323
LMI
6416 (mail-header-set-xref headers xref)))))))
6417
6418(defun gnus-summary-insert-subject (id &optional old-header use-old-header)
6748645f
LMI
6419 "Find article ID and insert the summary line for that article.
6420OLD-HEADER can either be a header or a line number to insert
6421the subject line on."
6422 (let* ((line (and (numberp old-header) old-header))
6423 (old-header (and (vectorp old-header) old-header))
6424 (header (cond ((and old-header use-old-header)
16409b0b
GM
6425 old-header)
6426 ((and (numberp id)
6427 (gnus-number-to-header id))
6428 (gnus-number-to-header id))
6429 (t
6430 (gnus-read-header id))))
6431 (number (and (numberp id) id))
6432 d)
eec82323
LMI
6433 (when header
6434 ;; Rebuild the thread that this article is part of and go to the
6435 ;; article we have fetched.
6436 (when (and (not gnus-show-threads)
6437 old-header)
6748645f
LMI
6438 (when (and number
6439 (setq d (gnus-data-find (mail-header-number old-header))))
eec82323
LMI
6440 (goto-char (gnus-data-pos d))
6441 (gnus-data-remove
6442 number
01c52d31 6443 (- (point-at-bol)
eec82323 6444 (prog1
01c52d31 6445 (1+ (point-at-eol))
eec82323 6446 (gnus-delete-line))))))
23f87bed
MB
6447 ;; Remove list identifiers from subject.
6448 (when gnus-list-identifiers
6449 (let ((gnus-newsgroup-headers (list header)))
c3bc41c2 6450 (gnus-summary-remove-list-identifiers)))
eec82323
LMI
6451 (when old-header
6452 (mail-header-set-number header (mail-header-number old-header)))
6453 (setq gnus-newsgroup-sparse
6454 (delq (setq number (mail-header-number header))
6455 gnus-newsgroup-sparse))
6456 (setq gnus-newsgroup-ancient (delq number gnus-newsgroup-ancient))
6748645f
LMI
6457 (push number gnus-newsgroup-limit)
6458 (gnus-rebuild-thread (mail-header-id header) line)
eec82323
LMI
6459 (gnus-summary-goto-subject number nil t))
6460 (when (and (numberp number)
6461 (> number 0))
6462 ;; We have to update the boundaries even if we can't fetch the
6463 ;; article if ID is a number -- so that the next `P' or `N'
6464 ;; command will fetch the previous (or next) article even
6465 ;; if the one we tried to fetch this time has been canceled.
6466 (when (> number gnus-newsgroup-end)
6467 (setq gnus-newsgroup-end number))
6468 (when (< number gnus-newsgroup-begin)
6469 (setq gnus-newsgroup-begin number))
6470 (setq gnus-newsgroup-unselected
6471 (delq number gnus-newsgroup-unselected)))
6472 ;; Report back a success?
6473 (and header (mail-header-number header))))
6474
6475;;; Process/prefix in the summary buffer
6476
6477(defun gnus-summary-work-articles (n)
6748645f
LMI
6478 "Return a list of articles to be worked upon.
6479The prefix argument, the list of process marked articles, and the
6480current article will be taken into consideration."
c7a91ce1 6481 (with-current-buffer gnus-summary-buffer
6748645f
LMI
6482 (cond
6483 (n
6484 ;; A numerical prefix has been given.
6485 (setq n (prefix-numeric-value n))
6486 (let ((backward (< n 0))
6487 (n (abs (prefix-numeric-value n)))
6488 articles article)
6489 (save-excursion
6490 (while
6491 (and (> n 0)
6492 (push (setq article (gnus-summary-article-number))
6493 articles)
6494 (if backward
6495 (gnus-summary-find-prev nil article)
6496 (gnus-summary-find-next nil article)))
6497 (decf n)))
6498 (nreverse articles)))
6499 ((and (gnus-region-active-p) (mark))
6500 (message "region active")
6501 ;; Work on the region between point and mark.
6502 (let ((max (max (point) (mark)))
6503 articles article)
6504 (save-excursion
7dafe00b 6505 (goto-char (min (point) (mark)))
6748645f
LMI
6506 (while
6507 (and
6508 (push (setq article (gnus-summary-article-number)) articles)
6509 (gnus-summary-find-next nil article)
6510 (< (point) max)))
6511 (nreverse articles))))
6512 (gnus-newsgroup-processable
6513 ;; There are process-marked articles present.
6514 ;; Save current state.
6515 (gnus-summary-save-process-mark)
6516 ;; Return the list.
6517 (reverse gnus-newsgroup-processable))
6518 (t
6519 ;; Just return the current article.
6520 (list (gnus-summary-article-number))))))
6521
6522(defmacro gnus-summary-iterate (arg &rest forms)
6523 "Iterate over the process/prefixed articles and do FORMS.
6524ARG is the interactive prefix given to the command. FORMS will be
6525executed with point over the summary line of the articles."
6526 (let ((articles (make-symbol "gnus-summary-iterate-articles")))
6527 `(let ((,articles (gnus-summary-work-articles ,arg)))
6528 (while ,articles
6529 (gnus-summary-goto-subject (car ,articles))
16409b0b
GM
6530 ,@forms
6531 (pop ,articles)))))
6748645f
LMI
6532
6533(put 'gnus-summary-iterate 'lisp-indent-function 1)
6534(put 'gnus-summary-iterate 'edebug-form-spec '(form body))
eec82323
LMI
6535
6536(defun gnus-summary-save-process-mark ()
6537 "Push the current set of process marked articles on the stack."
6538 (interactive)
6539 (push (copy-sequence gnus-newsgroup-processable)
6540 gnus-newsgroup-process-stack))
6541
6542(defun gnus-summary-kill-process-mark ()
6543 "Push the current set of process marked articles on the stack and unmark."
6544 (interactive)
6545 (gnus-summary-save-process-mark)
6546 (gnus-summary-unmark-all-processable))
6547
6548(defun gnus-summary-yank-process-mark ()
6549 "Pop the last process mark state off the stack and restore it."
6550 (interactive)
6551 (unless gnus-newsgroup-process-stack
6552 (error "Empty mark stack"))
6553 (gnus-summary-process-mark-set (pop gnus-newsgroup-process-stack)))
6554
6555(defun gnus-summary-process-mark-set (set)
6556 "Make SET into the current process marked articles."
6557 (gnus-summary-unmark-all-processable)
01c52d31 6558 (mapc 'gnus-summary-set-process-mark set))
eec82323
LMI
6559
6560;;; Searching and stuff
6561
6562(defun gnus-summary-search-group (&optional backward use-level)
6563 "Search for next unread newsgroup.
6564If optional argument BACKWARD is non-nil, search backward instead."
c7a91ce1 6565 (with-current-buffer gnus-group-buffer
eec82323
LMI
6566 (when (gnus-group-search-forward
6567 backward nil (if use-level (gnus-group-group-level) nil))
6568 (gnus-group-group-name))))
6569
6570(defun gnus-summary-best-group (&optional exclude-group)
6571 "Find the name of the best unread group.
6572If EXCLUDE-GROUP, do not go to this group."
01c52d31 6573 (with-current-buffer gnus-group-buffer
eec82323
LMI
6574 (save-excursion
6575 (gnus-group-best-unread-group exclude-group))))
6576
23f87bed
MB
6577(defun gnus-summary-find-next (&optional unread article backward)
6578 (if backward
6579 (gnus-summary-find-prev unread article)
eec82323
LMI
6580 (let* ((dummy (gnus-summary-article-intangible-p))
6581 (article (or article (gnus-summary-article-number)))
23f87bed 6582 (data (gnus-data-find-list article))
eec82323
LMI
6583 result)
6584 (when (and (not dummy)
6585 (or (not gnus-summary-check-current)
6586 (not unread)
23f87bed
MB
6587 (not (gnus-data-unread-p (car data)))))
6588 (setq data (cdr data)))
eec82323
LMI
6589 (when (setq result
6590 (if unread
6591 (progn
23f87bed
MB
6592 (while data
6593 (unless (memq (gnus-data-number (car data))
6594 (cond
6595 ((eq gnus-auto-goto-ignores
6596 'always-undownloaded)
6597 gnus-newsgroup-undownloaded)
6598 (gnus-plugged
6599 nil)
6600 ((eq gnus-auto-goto-ignores
6601 'unfetched)
6602 gnus-newsgroup-unfetched)
6603 ((eq gnus-auto-goto-ignores
6604 'undownloaded)
6605 gnus-newsgroup-undownloaded)))
6606 (when (gnus-data-unread-p (car data))
6607 (setq result (car data)
6608 data nil)))
6609 (setq data (cdr data)))
eec82323 6610 result)
23f87bed 6611 (car data)))
eec82323
LMI
6612 (goto-char (gnus-data-pos result))
6613 (gnus-data-number result)))))
6614
6615(defun gnus-summary-find-prev (&optional unread article)
6616 (let* ((eobp (eobp))
6617 (article (or article (gnus-summary-article-number)))
23f87bed 6618 (data (gnus-data-find-list article (gnus-data-list 'rev)))
eec82323
LMI
6619 result)
6620 (when (and (not eobp)
6621 (or (not gnus-summary-check-current)
6622 (not unread)
23f87bed
MB
6623 (not (gnus-data-unread-p (car data)))))
6624 (setq data (cdr data)))
eec82323
LMI
6625 (when (setq result
6626 (if unread
6627 (progn
23f87bed
MB
6628 (while data
6629 (unless (memq (gnus-data-number (car data))
6630 (cond
6631 ((eq gnus-auto-goto-ignores
6632 'always-undownloaded)
6633 gnus-newsgroup-undownloaded)
6634 (gnus-plugged
6635 nil)
6636 ((eq gnus-auto-goto-ignores
6637 'unfetched)
6638 gnus-newsgroup-unfetched)
6639 ((eq gnus-auto-goto-ignores
6640 'undownloaded)
6641 gnus-newsgroup-undownloaded)))
6642 (when (gnus-data-unread-p (car data))
6643 (setq result (car data)
6644 data nil)))
6645 (setq data (cdr data)))
eec82323 6646 result)
23f87bed 6647 (car data)))
eec82323
LMI
6648 (goto-char (gnus-data-pos result))
6649 (gnus-data-number result))))
6650
6651(defun gnus-summary-find-subject (subject &optional unread backward article)
6652 (let* ((simp-subject (gnus-simplify-subject-fully subject))
6653 (article (or article (gnus-summary-article-number)))
6654 (articles (gnus-data-list backward))
6655 (arts (gnus-data-find-list article articles))
6656 result)
6657 (when (or (not gnus-summary-check-current)
6658 (not unread)
6659 (not (gnus-data-unread-p (car arts))))
6660 (setq arts (cdr arts)))
6661 (while arts
6662 (and (or (not unread)
6663 (gnus-data-unread-p (car arts)))
6664 (vectorp (gnus-data-header (car arts)))
6665 (gnus-subject-equal
6666 simp-subject (mail-header-subject (gnus-data-header (car arts))) t)
6667 (setq result (car arts)
6668 arts nil))
6669 (setq arts (cdr arts)))
6670 (and result
6671 (goto-char (gnus-data-pos result))
6672 (gnus-data-number result))))
6673
6674(defun gnus-summary-search-forward (&optional unread subject backward)
6675 "Search forward for an article.
6676If UNREAD, look for unread articles. If SUBJECT, look for
6677articles with that subject. If BACKWARD, search backward instead."
6678 (cond (subject (gnus-summary-find-subject subject unread backward))
6679 (backward (gnus-summary-find-prev unread))
6680 (t (gnus-summary-find-next unread))))
6681
6682(defun gnus-recenter (&optional n)
6683 "Center point in window and redisplay frame.
6684Also do horizontal recentering."
6685 (interactive "P")
6686 (when (and gnus-auto-center-summary
6687 (not (eq gnus-auto-center-summary 'vertical)))
6688 (gnus-horizontal-recenter))
6689 (recenter n))
6690
6691(defun gnus-summary-recenter ()
6692 "Center point in the summary window.
6693If `gnus-auto-center-summary' is nil, or the article buffer isn't
6694displayed, no centering will be performed."
6695 ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
6696 ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu.
16409b0b 6697 (interactive)
23f87bed
MB
6698 ;; The user has to want it.
6699 (when gnus-auto-center-summary
6700 (let* ((top (cond ((< (window-height) 4) 0)
6701 ((< (window-height) 7) 1)
6702 (t (if (numberp gnus-auto-center-summary)
6703 gnus-auto-center-summary
01c52d31 6704 (/ (1- (window-height)) 2)))))
23f87bed
MB
6705 (height (1- (window-height)))
6706 (bottom (save-excursion (goto-char (point-max))
6707 (forward-line (- height))
6708 (point)))
6709 (window (get-buffer-window (current-buffer))))
eec82323
LMI
6710 (when (get-buffer-window gnus-article-buffer)
6711 ;; Only do recentering when the article buffer is displayed,
6712 ;; Set the window start to either `bottom', which is the biggest
6713 ;; possible valid number, or the second line from the top,
6714 ;; whichever is the least.
db7ebd73
MB
6715 (let ((top-pos (save-excursion (forward-line (- top)) (point))))
6716 (if (> bottom top-pos)
6717 ;; Keep the second line from the top visible
01c52d31 6718 (set-window-start window top-pos)
db7ebd73
MB
6719 ;; Try to keep the bottom line visible; if it's partially
6720 ;; obscured, either scroll one more line to make it fully
6721 ;; visible, or revert to using TOP-POS.
6722 (save-excursion
6723 (goto-char (point-max))
6724 (forward-line -1)
6725 (let ((last-line-start (point)))
6726 (goto-char bottom)
6727 (set-window-start window (point) t)
6728 (when (not (pos-visible-in-window-p last-line-start window))
6729 (forward-line 1)
6730 (set-window-start window (min (point) top-pos) t)))))))
eec82323
LMI
6731 ;; Do horizontal recentering while we're at it.
6732 (when (and (get-buffer-window (current-buffer) t)
6733 (not (eq gnus-auto-center-summary 'vertical)))
6734 (let ((selected (selected-window)))
6735 (select-window (get-buffer-window (current-buffer) t))
6736 (gnus-summary-position-point)
6737 (gnus-horizontal-recenter)
6738 (select-window selected))))))
6739
6740(defun gnus-summary-jump-to-group (newsgroup)
6741 "Move point to NEWSGROUP in group mode buffer."
6742 ;; Keep update point of group mode buffer if visible.
6743 (if (eq (current-buffer) (get-buffer gnus-group-buffer))
6744 (save-window-excursion
6745 ;; Take care of tree window mode.
6746 (when (get-buffer-window gnus-group-buffer)
6747 (pop-to-buffer gnus-group-buffer))
6748 (gnus-group-jump-to-group newsgroup))
6749 (save-excursion
6750 ;; Take care of tree window mode.
c7a91ce1 6751 (if (get-buffer-window gnus-group-buffer 0)
eec82323
LMI
6752 (pop-to-buffer gnus-group-buffer)
6753 (set-buffer gnus-group-buffer))
6754 (gnus-group-jump-to-group newsgroup))))
6755
6756;; This function returns a list of article numbers based on the
6757;; difference between the ranges of read articles in this group and
6758;; the range of active articles.
6759(defun gnus-list-of-unread-articles (group)
6760 (let* ((read (gnus-info-read (gnus-get-info group)))
6761 (active (or (gnus-active group) (gnus-activate-group group)))
01c52d31
MB
6762 (last (or (cdr active)
6763 (error "Group %s couldn't be activated " group)))
4b70e299
MB
6764 (bottom (if gnus-newsgroup-maximum-articles
6765 (max (car active)
6766 (- last gnus-newsgroup-maximum-articles -1))
11abff8e 6767 (car active)))
eec82323
LMI
6768 first nlast unread)
6769 ;; If none are read, then all are unread.
6770 (if (not read)
11abff8e 6771 (setq first bottom)
eec82323
LMI
6772 ;; If the range of read articles is a single range, then the
6773 ;; first unread article is the article after the last read
6774 ;; article. Sounds logical, doesn't it?
16409b0b 6775 (if (and (not (listp (cdr read)))
11abff8e 6776 (or (< (car read) bottom)
16409b0b
GM
6777 (progn (setq read (list read))
6778 nil)))
11abff8e 6779 (setq first (max bottom (1+ (cdr read))))
eec82323
LMI
6780 ;; `read' is a list of ranges.
6781 (when (/= (setq nlast (or (and (numberp (car read)) (car read))
6782 (caar read)))
6783 1)
11abff8e 6784 (setq first bottom))
eec82323
LMI
6785 (while read
6786 (when first
6787 (while (< first nlast)
54506618
MB
6788 (setq unread (cons first unread)
6789 first (1+ first))))
eec82323
LMI
6790 (setq first (1+ (if (atom (car read)) (car read) (cdar read))))
6791 (setq nlast (if (atom (cadr read)) (cadr read) (caadr read)))
6792 (setq read (cdr read)))))
6793 ;; And add the last unread articles.
6794 (while (<= first last)
54506618
MB
6795 (setq unread (cons first unread)
6796 first (1+ first)))
eec82323 6797 ;; Return the list of unread articles.
6748645f 6798 (delq 0 (nreverse unread))))
eec82323
LMI
6799
6800(defun gnus-list-of-read-articles (group)
6801 "Return a list of unread, unticked and non-dormant articles."
6802 (let* ((info (gnus-get-info group))
6803 (marked (gnus-info-marks info))
6804 (active (gnus-active group)))
6805 (and info active
23f87bed
MB
6806 (gnus-list-range-difference
6807 (gnus-list-range-difference
6808 (gnus-sorted-complement
11abff8e 6809 (gnus-uncompress-range
4b70e299 6810 (if gnus-newsgroup-maximum-articles
11abff8e 6811 (cons (max (car active)
4b70e299
MB
6812 (- (cdr active)
6813 gnus-newsgroup-maximum-articles
6814 -1))
11abff8e
MB
6815 (cdr active))
6816 active))
23f87bed
MB
6817 (gnus-list-of-unread-articles group))
6818 (cdr (assq 'dormant marked)))
6819 (cdr (assq 'tick marked))))))
eec82323 6820
54506618
MB
6821;; This function returns a sequence of article numbers based on the
6822;; difference between the ranges of read articles in this group and
6823;; the range of active articles.
6824(defun gnus-sequence-of-unread-articles (group)
6825 (let* ((read (gnus-info-read (gnus-get-info group)))
6826 (active (or (gnus-active group) (gnus-activate-group group)))
6827 (last (cdr active))
4b70e299
MB
6828 (bottom (if gnus-newsgroup-maximum-articles
6829 (max (car active)
6830 (- last gnus-newsgroup-maximum-articles -1))
11abff8e 6831 (car active)))
54506618
MB
6832 first nlast unread)
6833 ;; If none are read, then all are unread.
6834 (if (not read)
11abff8e 6835 (setq first bottom)
54506618
MB
6836 ;; If the range of read articles is a single range, then the
6837 ;; first unread article is the article after the last read
6838 ;; article. Sounds logical, doesn't it?
6839 (if (and (not (listp (cdr read)))
11abff8e 6840 (or (< (car read) bottom)
54506618
MB
6841 (progn (setq read (list read))
6842 nil)))
11abff8e 6843 (setq first (max bottom (1+ (cdr read))))
54506618
MB
6844 ;; `read' is a list of ranges.
6845 (when (/= (setq nlast (or (and (numberp (car read)) (car read))
6846 (caar read)))
6847 1)
11abff8e 6848 (setq first bottom))
54506618
MB
6849 (while read
6850 (when first
6851 (push (cons first nlast) unread))
6852 (setq first (1+ (if (atom (car read)) (car read) (cdar read))))
6853 (setq nlast (if (atom (cadr read)) (cadr read) (caadr read)))
6854 (setq read (cdr read)))))
6855 ;; And add the last unread articles.
ba0226dd
MB
6856 (cond ((not (and first last))
6857 nil)
6858 ((< first last)
6859 (push (cons first last) unread))
6860 ((= first last)
6861 (push first unread)))
54506618
MB
6862 ;; Return the sequence of unread articles.
6863 (delq 0 (nreverse unread))))
6864
eec82323
LMI
6865;; Various summary commands
6866
6748645f
LMI
6867(defun gnus-summary-select-article-buffer ()
6868 "Reconfigure windows to show article buffer."
6869 (interactive)
6870 (if (not (gnus-buffer-live-p gnus-article-buffer))
6871 (error "There is no article buffer for this summary buffer")
6872 (gnus-configure-windows 'article)
6873 (select-window (get-buffer-window gnus-article-buffer))))
6874
eec82323
LMI
6875(defun gnus-summary-universal-argument (arg)
6876 "Perform any operation on all articles that are process/prefixed."
6877 (interactive "P")
eec82323
LMI
6878 (let ((articles (gnus-summary-work-articles arg))
6879 func article)
6880 (if (eq
6881 (setq
6882 func
6883 (key-binding
6884 (read-key-sequence
6885 (substitute-command-keys
16409b0b 6886 "\\<gnus-summary-mode-map>\\[gnus-summary-universal-argument]"))))
eec82323
LMI
6887 'undefined)
6888 (gnus-error 1 "Undefined key")
6889 (save-excursion
6890 (while articles
6891 (gnus-summary-goto-subject (setq article (pop articles)))
6892 (let (gnus-newsgroup-processable)
6893 (command-execute func))
6894 (gnus-summary-remove-process-mark article)))))
6895 (gnus-summary-position-point))
6896
6897(defun gnus-summary-toggle-truncation (&optional arg)
6898 "Toggle truncation of summary lines.
23f87bed 6899With ARG, turn line truncation on if ARG is positive."
eec82323
LMI
6900 (interactive "P")
6901 (setq truncate-lines
6902 (if (null arg) (not truncate-lines)
6903 (> (prefix-numeric-value arg) 0)))
6904 (redraw-display))
6905
23f87bed
MB
6906(defun gnus-summary-find-for-reselect ()
6907 "Return the number of an article to stay on across a reselect.
6908The current article is considered, then following articles, then previous
6909articles. An article is sought which is not cancelled and isn't a temporary
6910insertion from another group. If there's no such then return a dummy 0."
6911 (let (found)
6912 (dolist (rev '(nil t))
6913 (unless found ; don't demand the reverse list if we don't need it
6914 (let ((data (gnus-data-find-list
6915 (gnus-summary-article-number) (gnus-data-list rev))))
6916 (while (and data (not found))
6917 (if (and (< 0 (gnus-data-number (car data)))
6918 (not (eq gnus-canceled-mark (gnus-data-mark (car data)))))
6919 (setq found (gnus-data-number (car data))))
6920 (setq data (cdr data))))))
6921 (or found 0)))
6922
eec82323
LMI
6923(defun gnus-summary-reselect-current-group (&optional all rescan)
6924 "Exit and then reselect the current newsgroup.
6925The prefix argument ALL means to select all articles."
6926 (interactive "P")
eec82323
LMI
6927 (when (gnus-ephemeral-group-p gnus-newsgroup-name)
6928 (error "Ephemeral groups can't be reselected"))
23f87bed 6929 (let ((current-subject (gnus-summary-find-for-reselect))
eec82323
LMI
6930 (group gnus-newsgroup-name))
6931 (setq gnus-newsgroup-begin nil)
23f87bed 6932 (gnus-summary-exit nil 'leave-hidden)
eec82323
LMI
6933 ;; We have to adjust the point of group mode buffer because
6934 ;; point was moved to the next unread newsgroup by exiting.
6935 (gnus-summary-jump-to-group group)
6936 (when rescan
6937 (save-excursion
6938 (gnus-group-get-new-news-this-group 1)))
6939 (gnus-group-read-group all t)
6940 (gnus-summary-goto-subject current-subject nil t)))
6941
6942(defun gnus-summary-rescan-group (&optional all)
6943 "Exit the newsgroup, ask for new articles, and select the newsgroup."
6944 (interactive "P")
6945 (gnus-summary-reselect-current-group all t))
6946
6947(defun gnus-summary-update-info (&optional non-destructive)
6948 (save-excursion
6949 (let ((group gnus-newsgroup-name))
6748645f
LMI
6950 (when group
6951 (when gnus-newsgroup-kill-headers
6952 (setq gnus-newsgroup-killed
6953 (gnus-compress-sequence
23f87bed
MB
6954 (gnus-sorted-union
6955 (gnus-list-range-intersection
6956 gnus-newsgroup-unselected gnus-newsgroup-killed)
6957 gnus-newsgroup-unreads)
6748645f
LMI
6958 t)))
6959 (unless (listp (cdr gnus-newsgroup-killed))
6960 (setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
6961 (let ((headers gnus-newsgroup-headers))
6962 ;; Set the new ranges of read articles.
01c52d31 6963 (with-current-buffer gnus-group-buffer
6748645f
LMI
6964 (gnus-undo-force-boundary))
6965 (gnus-update-read-articles
23f87bed
MB
6966 group (gnus-sorted-union
6967 gnus-newsgroup-unreads gnus-newsgroup-unselected))
6748645f
LMI
6968 ;; Set the current article marks.
6969 (let ((gnus-newsgroup-scored
6970 (if (and (not gnus-save-score)
6971 (not non-destructive))
6972 nil
6973 gnus-newsgroup-scored)))
6974 (save-excursion
6975 (gnus-update-marks)))
6976 ;; Do the cross-ref thing.
6977 (when gnus-use-cross-reference
6978 (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads))
6979 ;; Do not switch windows but change the buffer to work.
a8151ef7 6980 (set-buffer gnus-group-buffer)
6748645f
LMI
6981 (unless (gnus-ephemeral-group-p group)
6982 (gnus-group-update-group group)))))))
eec82323
LMI
6983
6984(defun gnus-summary-save-newsrc (&optional force)
6985 "Save the current number of read/marked articles in the dribble buffer.
6986The dribble buffer will then be saved.
6987If FORCE (the prefix), also save the .newsrc file(s)."
6988 (interactive "P")
6989 (gnus-summary-update-info t)
6990 (if force
6991 (gnus-save-newsrc-file)
6992 (gnus-dribble-save)))
6993
704f1663
GM
6994(declare-function gnus-cache-write-active "gnus-cache" (&optional force))
6995
23f87bed 6996(defun gnus-summary-exit (&optional temporary leave-hidden)
eec82323 6997 "Exit reading current newsgroup, and then return to group selection mode.
16409b0b 6998`gnus-exit-group-hook' is called with no arguments if that value is non-nil."
eec82323
LMI
6999 (interactive)
7000 (gnus-set-global-variables)
16409b0b 7001 (when (gnus-buffer-live-p gnus-article-buffer)
c7a91ce1 7002 (with-current-buffer gnus-article-buffer
16409b0b
GM
7003 (mm-destroy-parts gnus-article-mime-handles)
7004 ;; Set it to nil for safety reason.
7005 (setq gnus-article-mime-handle-alist nil)
7006 (setq gnus-article-mime-handles nil)))
eec82323 7007 (gnus-kill-save-kill-buffer)
6748645f 7008 (gnus-async-halt-prefetch)
eec82323
LMI
7009 (let* ((group gnus-newsgroup-name)
7010 (quit-config (gnus-group-quit-config gnus-newsgroup-name))
23f87bed 7011 (gnus-group-is-exiting-p t)
eec82323 7012 (mode major-mode)
23f87bed 7013 (group-point nil)
eec82323 7014 (buf (current-buffer)))
16409b0b
GM
7015 (unless quit-config
7016 ;; Do adaptive scoring, and possibly save score files.
7017 (when gnus-newsgroup-adaptive
7018 (gnus-score-adaptive))
7019 (when gnus-use-scoring
7020 (gnus-score-save)))
6748645f 7021 (gnus-run-hooks 'gnus-summary-prepare-exit-hook)
eec82323
LMI
7022 ;; If we have several article buffers, we kill them at exit.
7023 (unless gnus-single-article-buffer
01c52d31
MB
7024 (when (gnus-buffer-live-p gnus-article-buffer)
7025 (with-current-buffer gnus-article-buffer
7026 ;; Don't kill sticky article buffers
7027 (unless (eq major-mode 'gnus-sticky-article-mode)
7028 (gnus-kill-buffer gnus-article-buffer)
7029 (setq gnus-article-current nil))))
7030 (gnus-kill-buffer gnus-original-article-buffer))
eec82323
LMI
7031 (when gnus-use-cache
7032 (gnus-cache-possibly-remove-articles)
7033 (gnus-cache-save-buffers))
7034 (gnus-async-prefetch-remove-group group)
7035 (when gnus-suppress-duplicates
7036 (gnus-dup-enter-articles))
7037 (when gnus-use-trees
7038 (gnus-tree-close group))
16409b0b
GM
7039 (when gnus-use-cache
7040 (gnus-cache-write-active))
6748645f
LMI
7041 ;; Remove entries for this group.
7042 (nnmail-purge-split-history (gnus-group-real-name group))
eec82323
LMI
7043 ;; Make all changes in this group permanent.
7044 (unless quit-config
6748645f 7045 (gnus-run-hooks 'gnus-exit-group-hook)
16409b0b 7046 (gnus-summary-update-info))
eec82323
LMI
7047 (gnus-close-group group)
7048 ;; Make sure where we were, and go to next newsgroup.
7049 (set-buffer gnus-group-buffer)
7050 (unless quit-config
7051 (gnus-group-jump-to-group group))
6748645f
LMI
7052 (gnus-run-hooks 'gnus-summary-exit-hook)
7053 (unless (or quit-config
01c52d31 7054 (not gnus-summary-next-group-on-exit)
6748645f
LMI
7055 ;; If this group has disappeared from the summary
7056 ;; buffer, don't skip forwards.
7057 (not (string= group (gnus-group-group-name))))
eec82323 7058 (gnus-group-next-unread-group 1))
a8151ef7 7059 (setq group-point (point))
eec82323
LMI
7060 (if temporary
7061 nil ;Nothing to do.
eec82323
LMI
7062 (set-buffer buf)
7063 (if (not gnus-kill-summary-on-exit)
23f87bed
MB
7064 (progn
7065 (gnus-deaden-summary)
7066 (setq mode nil))
eec82323
LMI
7067 ;; We set all buffer-local variables to nil. It is unclear why
7068 ;; this is needed, but if we don't, buffer-local variables are
7069 ;; not garbage-collected, it seems. This would the lead to en
7070 ;; ever-growing Emacs.
7071 (gnus-summary-clear-local-variables)
23f87bed
MB
7072 (let ((gnus-summary-local-variables gnus-newsgroup-variables))
7073 (gnus-summary-clear-local-variables))
eec82323
LMI
7074 (when (get-buffer gnus-article-buffer)
7075 (bury-buffer gnus-article-buffer))
eec82323
LMI
7076 ;; Return to group mode buffer.
7077 (when (eq mode 'gnus-summary-mode)
7078 (gnus-kill-buffer buf)))
7079 (setq gnus-current-select-method gnus-select-method)
d61c212b
SM
7080 (set-buffer gnus-group-buffer)
7081 (if quit-config
7082 (gnus-handle-ephemeral-exit quit-config)
4e90f2b9
SM
7083 (goto-char group-point)
7084 ;; If gnus-group-buffer is already displayed, make sure we also move
7085 ;; the cursor in the window that displays it.
7086 (let ((win (get-buffer-window (current-buffer) 0)))
7087 (if win (set-window-point win (point))))
d61c212b 7088 (unless leave-hidden
4e90f2b9 7089 (gnus-configure-windows 'group 'force)))
6748645f 7090 ;; Clear the current group name.
eec82323
LMI
7091 (unless quit-config
7092 (setq gnus-newsgroup-name nil)))))
7093
7094(defalias 'gnus-summary-quit 'gnus-summary-exit-no-update)
7095(defun gnus-summary-exit-no-update (&optional no-questions)
7096 "Quit reading current newsgroup without updating read article info."
7097 (interactive)
eec82323 7098 (let* ((group gnus-newsgroup-name)
23f87bed
MB
7099 (gnus-group-is-exiting-p t)
7100 (gnus-group-is-exiting-without-update-p t)
eec82323
LMI
7101 (quit-config (gnus-group-quit-config group)))
7102 (when (or no-questions
7103 gnus-expert-user
7104 (gnus-y-or-n-p "Discard changes to this group and exit? "))
6748645f 7105 (gnus-async-halt-prefetch)
23f87bed 7106 (run-hooks 'gnus-summary-prepare-exit-hook)
16409b0b 7107 (when (gnus-buffer-live-p gnus-article-buffer)
c7a91ce1 7108 (with-current-buffer gnus-article-buffer
16409b0b
GM
7109 (mm-destroy-parts gnus-article-mime-handles)
7110 ;; Set it to nil for safety reason.
7111 (setq gnus-article-mime-handle-alist nil)
7112 (setq gnus-article-mime-handles nil)))
eec82323
LMI
7113 ;; If we have several article buffers, we kill them at exit.
7114 (unless gnus-single-article-buffer
7115 (gnus-kill-buffer gnus-article-buffer)
7116 (gnus-kill-buffer gnus-original-article-buffer)
7117 (setq gnus-article-current nil))
7118 (if (not gnus-kill-summary-on-exit)
7119 (gnus-deaden-summary)
7120 (gnus-close-group group)
7121 (gnus-summary-clear-local-variables)
23f87bed
MB
7122 (let ((gnus-summary-local-variables gnus-newsgroup-variables))
7123 (gnus-summary-clear-local-variables))
7124 (gnus-kill-buffer gnus-summary-buffer))
eec82323
LMI
7125 (unless gnus-single-article-buffer
7126 (setq gnus-article-current nil))
7127 (when gnus-use-trees
7128 (gnus-tree-close group))
7129 (gnus-async-prefetch-remove-group group)
7130 (when (get-buffer gnus-article-buffer)
7131 (bury-buffer gnus-article-buffer))
7132 ;; Return to the group buffer.
7133 (gnus-configure-windows 'group 'force)
7134 ;; Clear the current group name.
7135 (setq gnus-newsgroup-name nil)
23f87bed
MB
7136 (unless (gnus-ephemeral-group-p group)
7137 (gnus-group-update-group group))
eec82323
LMI
7138 (when (equal (gnus-group-group-name) group)
7139 (gnus-group-next-unread-group 1))
7140 (when quit-config
23f87bed 7141 (gnus-handle-ephemeral-exit quit-config)))))
eec82323
LMI
7142
7143(defun gnus-handle-ephemeral-exit (quit-config)
6748645f
LMI
7144 "Handle movement when leaving an ephemeral group.
7145The state which existed when entering the ephemeral is reset."
eec82323
LMI
7146 (if (not (buffer-name (car quit-config)))
7147 (gnus-configure-windows 'group 'force)
7148 (set-buffer (car quit-config))
7149 (cond ((eq major-mode 'gnus-summary-mode)
23f87bed
MB
7150 (gnus-set-global-variables))
7151 ((eq major-mode 'gnus-article-mode)
c7a91ce1 7152 (save-current-buffer
23f87bed
MB
7153 ;; The `gnus-summary-buffer' variable may point
7154 ;; to the old summary buffer when using a single
7155 ;; article buffer.
7156 (unless (gnus-buffer-live-p gnus-summary-buffer)
7157 (set-buffer gnus-group-buffer))
7158 (set-buffer gnus-summary-buffer)
7159 (gnus-set-global-variables))))
eec82323 7160 (if (or (eq (cdr quit-config) 'article)
23f87bed 7161 (eq (cdr quit-config) 'pick))
01c52d31
MB
7162 (if (and (boundp 'gnus-pick-mode) (symbol-value 'gnus-pick-mode))
7163 (gnus-configure-windows 'pick 'force)
7164 (gnus-configure-windows (cdr quit-config) 'force))
eec82323
LMI
7165 (gnus-configure-windows (cdr quit-config) 'force))
7166 (when (eq major-mode 'gnus-summary-mode)
01c52d31
MB
7167 (if (memq gnus-auto-select-on-ephemeral-exit '(next-noselect
7168 next-unread-noselect))
7169 (when (zerop (cond ((eq gnus-auto-select-on-ephemeral-exit
7170 'next-noselect)
7171 (gnus-summary-next-subject 1 nil t))
7172 ((eq gnus-auto-select-on-ephemeral-exit
7173 'next-unread-noselect)
7174 (gnus-summary-next-subject 1 t t))))
7175 ;; Hide the article buffer which displays the article different
7176 ;; from the one that the cursor points to in the summary buffer.
7177 (gnus-configure-windows 'summary 'force))
7178 (cond ((eq gnus-auto-select-on-ephemeral-exit 'next)
7179 (gnus-summary-next-subject 1))
7180 ((eq gnus-auto-select-on-ephemeral-exit 'next-unread)
7181 (gnus-summary-next-subject 1 t))))
eec82323
LMI
7182 (gnus-summary-recenter)
7183 (gnus-summary-position-point))))
7184
7185;;; Dead summaries.
7186
7187(defvar gnus-dead-summary-mode-map nil)
7188
7189(unless gnus-dead-summary-mode-map
7190 (setq gnus-dead-summary-mode-map (make-keymap))
7191 (suppress-keymap gnus-dead-summary-mode-map)
7192 (substitute-key-definition
7193 'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-mode-map)
23f87bed
MB
7194 (dolist (key '("\C-d" "\r" "\177" [delete]))
7195 (define-key gnus-dead-summary-mode-map
7196 key 'gnus-summary-wake-up-the-dead))
7197 (dolist (key '("q" "Q"))
7198 (define-key gnus-dead-summary-mode-map key 'bury-buffer)))
eec82323
LMI
7199
7200(defvar gnus-dead-summary-mode nil
7201 "Minor mode for Gnus summary buffers.")
7202
7203(defun gnus-dead-summary-mode (&optional arg)
7204 "Minor mode for Gnus summary buffers."
7205 (interactive "P")
7206 (when (eq major-mode 'gnus-summary-mode)
7207 (make-local-variable 'gnus-dead-summary-mode)
7208 (setq gnus-dead-summary-mode
7209 (if (null arg) (not gnus-dead-summary-mode)
7210 (> (prefix-numeric-value arg) 0)))
7211 (when gnus-dead-summary-mode
01c52d31 7212 (add-minor-mode
a8151ef7 7213 'gnus-dead-summary-mode " Dead" gnus-dead-summary-mode-map))))
eec82323
LMI
7214
7215(defun gnus-deaden-summary ()
7216 "Make the current summary buffer into a dead summary buffer."
7217 ;; Kill any previous dead summary buffer.
7218 (when (and gnus-dead-summary
7219 (buffer-name gnus-dead-summary))
01c52d31 7220 (with-current-buffer gnus-dead-summary
eec82323
LMI
7221 (when gnus-dead-summary-mode
7222 (kill-buffer (current-buffer)))))
7223 ;; Make this the current dead summary.
7224 (setq gnus-dead-summary (current-buffer))
7225 (gnus-dead-summary-mode 1)
7226 (let ((name (buffer-name)))
7227 (when (string-match "Summary" name)
7228 (rename-buffer
7229 (concat (substring name 0 (match-beginning 0)) "Dead "
7230 (substring name (match-beginning 0)))
16409b0b
GM
7231 t)
7232 (bury-buffer))))
eec82323
LMI
7233
7234(defun gnus-kill-or-deaden-summary (buffer)
7235 "Kill or deaden the summary BUFFER."
6748645f
LMI
7236 (save-excursion
7237 (when (and (buffer-name buffer)
7238 (not gnus-single-article-buffer))
01c52d31 7239 (with-current-buffer buffer
6748645f
LMI
7240 (gnus-kill-buffer gnus-article-buffer)
7241 (gnus-kill-buffer gnus-original-article-buffer)))
23f87bed
MB
7242 (cond
7243 ;; Kill the buffer.
7244 (gnus-kill-summary-on-exit
7245 (when (and gnus-use-trees
7246 (gnus-buffer-exists-p buffer))
c7a91ce1 7247 (with-current-buffer buffer
23f87bed
MB
7248 (gnus-tree-close gnus-newsgroup-name)))
7249 (gnus-kill-buffer buffer))
7250 ;; Deaden the buffer.
7251 ((gnus-buffer-exists-p buffer)
c7a91ce1 7252 (with-current-buffer buffer
23f87bed 7253 (gnus-deaden-summary))))))
eec82323
LMI
7254
7255(defun gnus-summary-wake-up-the-dead (&rest args)
7256 "Wake up the dead summary buffer."
7257 (interactive)
7258 (gnus-dead-summary-mode -1)
7259 (let ((name (buffer-name)))
7260 (when (string-match "Dead " name)
7261 (rename-buffer
7262 (concat (substring name 0 (match-beginning 0))
7263 (substring name (match-end 0)))
7264 t)))
7265 (gnus-message 3 "This dead summary is now alive again"))
7266
7267;; Suggested by Andrew Eskilsson <pi92ae@pt.hk-r.se>.
7268(defun gnus-summary-fetch-faq (&optional faq-dir)
7269 "Fetch the FAQ for the current group.
7270If FAQ-DIR (the prefix), prompt for a directory to search for the faq
7271in."
7272 (interactive
7273 (list
7274 (when current-prefix-arg
7275 (completing-read
8f688cb0 7276 "FAQ dir: " (and (listp gnus-group-faq-directory)
01c52d31 7277 (mapcar 'list
a8151ef7 7278 gnus-group-faq-directory))))))
eec82323
LMI
7279 (let (gnus-faq-buffer)
7280 (when (setq gnus-faq-buffer
7281 (gnus-group-fetch-faq gnus-newsgroup-name faq-dir))
7282 (gnus-configure-windows 'summary-faq))))
7283
7284;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
7285(defun gnus-summary-describe-group (&optional force)
7286 "Describe the current newsgroup."
7287 (interactive "P")
7288 (gnus-group-describe-group force gnus-newsgroup-name))
7289
7290(defun gnus-summary-describe-briefly ()
7291 "Describe summary mode commands briefly."
7292 (interactive)
16409b0b 7293 (gnus-message 6 (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")))
eec82323
LMI
7294
7295;; Walking around group mode buffer from summary mode.
7296
7297(defun gnus-summary-next-group (&optional no-article target-group backward)
7298 "Exit current newsgroup and then select next unread newsgroup.
7299If prefix argument NO-ARTICLE is non-nil, no article is selected
23f87bed 7300initially. If TARGET-GROUP, go to this group. If BACKWARD, go to
eec82323
LMI
7301previous group instead."
7302 (interactive "P")
eec82323
LMI
7303 ;; Stop pre-fetching.
7304 (gnus-async-halt-prefetch)
7305 (let ((current-group gnus-newsgroup-name)
7306 (current-buffer (current-buffer))
7307 entered)
7308 ;; First we semi-exit this group to update Xrefs and all variables.
7309 ;; We can't do a real exit, because the window conf must remain
7310 ;; the same in case the user is prompted for info, and we don't
7311 ;; want the window conf to change before that...
7312 (gnus-summary-exit t)
7313 (while (not entered)
7314 ;; Then we find what group we are supposed to enter.
7315 (set-buffer gnus-group-buffer)
7316 (gnus-group-jump-to-group current-group)
7317 (setq target-group
7318 (or target-group
7319 (if (eq gnus-keep-same-level 'best)
7320 (gnus-summary-best-group gnus-newsgroup-name)
7321 (gnus-summary-search-group backward gnus-keep-same-level))))
7322 (if (not target-group)
7323 ;; There are no further groups, so we return to the group
7324 ;; buffer.
7325 (progn
7326 (gnus-message 5 "Returning to the group buffer")
7327 (setq entered t)
7328 (when (gnus-buffer-live-p current-buffer)
7329 (set-buffer current-buffer)
7330 (gnus-summary-exit))
6748645f 7331 (gnus-run-hooks 'gnus-group-no-more-groups-hook))
eec82323
LMI
7332 ;; We try to enter the target group.
7333 (gnus-group-jump-to-group target-group)
7334 (let ((unreads (gnus-group-group-unread)))
7335 (if (and (or (eq t unreads)
7336 (and unreads (not (zerop unreads))))
23f87bed
MB
7337 (gnus-summary-read-group
7338 target-group nil no-article
7339 (and (buffer-name current-buffer) current-buffer)
7340 nil backward))
eec82323
LMI
7341 (setq entered t)
7342 (setq current-group target-group
7343 target-group nil)))))))
7344
7345(defun gnus-summary-prev-group (&optional no-article)
7346 "Exit current newsgroup and then select previous unread newsgroup.
7347If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
7348 (interactive "P")
7349 (gnus-summary-next-group no-article nil t))
7350
7351;; Walking around summary lines.
7352
23f87bed
MB
7353(defun gnus-summary-first-subject (&optional unread undownloaded unseen)
7354 "Go to the first subject satisfying any non-nil constraint.
7355If UNREAD is non-nil, the article should be unread.
7356If UNDOWNLOADED is non-nil, the article should be undownloaded.
7357If UNSEEN is non-nil, the article should be unseen.
7358Returns the article selected or nil if there are no matching articles."
eec82323 7359 (interactive "P")
23f87bed
MB
7360 (cond
7361 ;; Empty summary.
7362 ((null gnus-newsgroup-data)
7363 (gnus-message 3 "No articles in the group")
7364 nil)
7365 ;; Pick the first article.
7366 ((not (or unread undownloaded unseen))
7367 (goto-char (gnus-data-pos (car gnus-newsgroup-data)))
7368 (gnus-data-number (car gnus-newsgroup-data)))
7369 ;; Find the first unread article.
7370 (t
7371 (let ((data gnus-newsgroup-data))
7372 (while (and data
7373 (let ((num (gnus-data-number (car data))))
7374 (or (memq num gnus-newsgroup-unfetched)
7375 (not (or (and unread
7376 (memq num gnus-newsgroup-unreads))
7377 (and undownloaded
7378 (memq num gnus-newsgroup-undownloaded))
7379 (and unseen
7380 (memq num gnus-newsgroup-unseen)))))))
7381 (setq data (cdr data)))
7382 (prog1
7383 (if data
7384 (progn
7385 (goto-char (gnus-data-pos (car data)))
7386 (gnus-data-number (car data)))
7387 (gnus-message 3 "No more%s articles"
7388 (let* ((r (when unread " unread"))
7389 (d (when undownloaded " undownloaded"))
7390 (s (when unseen " unseen"))
7391 (l (delq nil (list r d s))))
7392 (cond ((= 3 (length l))
7393 (concat r "," d ", or" s))
7394 ((= 2 (length l))
7395 (concat (car l) ", or" (cadr l)))
7396 ((= 1 (length l))
7397 (car l))
7398 (t
7399 ""))))
7400 nil
7401 )
7402 (gnus-summary-position-point))))))
eec82323
LMI
7403
7404(defun gnus-summary-next-subject (n &optional unread dont-display)
7405 "Go to next N'th summary line.
7406If N is negative, go to the previous N'th subject line.
7407If UNREAD is non-nil, only unread articles are selected.
7408The difference between N and the actual number of steps taken is
7409returned."
7410 (interactive "p")
7411 (let ((backward (< n 0))
7412 (n (abs n)))
7413 (while (and (> n 0)
7414 (if backward
7415 (gnus-summary-find-prev unread)
7416 (gnus-summary-find-next unread)))
16409b0b
GM
7417 (unless (zerop (setq n (1- n)))
7418 (gnus-summary-show-thread)))
eec82323
LMI
7419 (when (/= 0 n)
7420 (gnus-message 7 "No more%s articles"
7421 (if unread " unread" "")))
7422 (unless dont-display
7423 (gnus-summary-recenter)
7424 (gnus-summary-position-point))
7425 n))
7426
7427(defun gnus-summary-next-unread-subject (n)
7428 "Go to next N'th unread summary line."
7429 (interactive "p")
7430 (gnus-summary-next-subject n t))
7431
7432(defun gnus-summary-prev-subject (n &optional unread)
7433 "Go to previous N'th summary line.
7434If optional argument UNREAD is non-nil, only unread article is selected."
7435 (interactive "p")
7436 (gnus-summary-next-subject (- n) unread))
7437
7438(defun gnus-summary-prev-unread-subject (n)
7439 "Go to previous N'th unread summary line."
7440 (interactive "p")
7441 (gnus-summary-next-subject (- n) t))
7442
23f87bed
MB
7443(defun gnus-summary-goto-subjects (articles)
7444 "Insert the subject header for ARTICLES in the current buffer."
7445 (save-excursion
7446 (dolist (article articles)
7447 (gnus-summary-goto-subject article t)))
7448 (gnus-summary-limit (append articles gnus-newsgroup-limit))
7449 (gnus-summary-position-point))
132cf96d 7450
eec82323 7451(defun gnus-summary-goto-subject (article &optional force silent)
d55fe5bb 7452 "Go to the subject line of ARTICLE.
eec82323
LMI
7453If FORCE, also allow jumping to articles not currently shown."
7454 (interactive "nArticle number: ")
23f87bed
MB
7455 (unless (numberp article)
7456 (error "Article %s is not a number" article))
eec82323
LMI
7457 (let ((b (point))
7458 (data (gnus-data-find article)))
7459 ;; We read in the article if we have to.
7460 (and (not data)
7461 force
6748645f
LMI
7462 (gnus-summary-insert-subject
7463 article
7464 (if (or (numberp force) (vectorp force)) force)
7465 t)
eec82323
LMI
7466 (setq data (gnus-data-find article)))
7467 (goto-char b)
7468 (if (not data)
7469 (progn
7470 (unless silent
7471 (gnus-message 3 "Can't find article %d" article))
7472 nil)
23f87bed
MB
7473 (let ((pt (gnus-data-pos data)))
7474 (goto-char pt)
7475 (gnus-summary-set-article-display-arrow pt))
6748645f 7476 (gnus-summary-position-point)
eec82323
LMI
7477 article)))
7478
7479;; Walking around summary lines with displaying articles.
7480
7481(defun gnus-summary-expand-window (&optional arg)
7482 "Make the summary buffer take up the entire Emacs frame.
7483Given a prefix, will force an `article' buffer configuration."
7484 (interactive "P")
eec82323
LMI
7485 (if arg
7486 (gnus-configure-windows 'article 'force)
7487 (gnus-configure-windows 'summary 'force)))
7488
7489(defun gnus-summary-display-article (article &optional all-header)
7490 "Display ARTICLE in article buffer."
01c52d31
MB
7491 (unless (and (gnus-buffer-live-p gnus-article-buffer)
7492 (with-current-buffer gnus-article-buffer
7493 (eq major-mode 'gnus-article-mode)))
7494 (gnus-article-setup-buffer))
eec82323 7495 (gnus-set-global-variables)
01c52d31
MB
7496 (with-current-buffer gnus-article-buffer
7497 (setq gnus-article-charset gnus-newsgroup-charset)
7498 (setq gnus-article-ignored-charsets gnus-newsgroup-ignored-charsets)
7499 (mm-enable-multibyte))
eec82323
LMI
7500 (if (null article)
7501 nil
7502 (prog1
7503 (if gnus-summary-display-article-function
7504 (funcall gnus-summary-display-article-function article all-header)
7505 (gnus-article-prepare article all-header))
6748645f 7506 (gnus-run-hooks 'gnus-select-article-hook)
eec82323
LMI
7507 (when (and gnus-current-article
7508 (not (zerop gnus-current-article)))
7509 (gnus-summary-goto-subject gnus-current-article))
7510 (gnus-summary-recenter)
7511 (when (and gnus-use-trees gnus-show-threads)
7512 (gnus-possibly-generate-tree article)
7513 (gnus-highlight-selected-tree article))
7514 ;; Successfully display article.
7515 (gnus-article-set-window-start
7516 (cdr (assq article gnus-newsgroup-bookmarks))))))
7517
7518(defun gnus-summary-select-article (&optional all-headers force pseudo article)
7519 "Select the current article.
7520If ALL-HEADERS is non-nil, show all header fields. If FORCE is
7521non-nil, the article will be re-fetched even if it already present in
7522the article buffer. If PSEUDO is non-nil, pseudo-articles will also
7523be displayed."
7524 ;; Make sure we are in the summary buffer to work around bbdb bug.
7525 (unless (eq major-mode 'gnus-summary-mode)
7526 (set-buffer gnus-summary-buffer))
7527 (let ((article (or article (gnus-summary-article-number)))
f0529b5b 7528 (all-headers (not (not all-headers))) ;Must be t or nil.
16409b0b 7529 gnus-summary-display-article-function)
eec82323
LMI
7530 (and (not pseudo)
7531 (gnus-summary-article-pseudo-p article)
a8151ef7 7532 (error "This is a pseudo-article"))
c7a91ce1 7533 (with-current-buffer gnus-summary-buffer
16409b0b
GM
7534 (if (or (and gnus-single-article-buffer
7535 (or (null gnus-current-article)
7536 (null gnus-article-current)
7537 (null (get-buffer gnus-article-buffer))
7538 (not (eq article (cdr gnus-article-current)))
7539 (not (equal (car gnus-article-current)
7540 gnus-newsgroup-name))))
7541 (and (not gnus-single-article-buffer)
7542 (or (null gnus-current-article)
7543 (not (eq gnus-current-article article))))
7544 force)
7545 ;; The requested article is different from the current article.
7546 (progn
16409b0b
GM
7547 (gnus-summary-display-article article all-headers)
7548 (when (gnus-buffer-live-p gnus-article-buffer)
23f87bed 7549 (with-current-buffer gnus-article-buffer
16409b0b 7550 (if (not gnus-article-decoded-p) ;; a local variable
87545352 7551 (mm-disable-multibyte))))
16409b0b
GM
7552 (gnus-article-set-window-start
7553 (cdr (assq article gnus-newsgroup-bookmarks)))
7554 article)
16409b0b 7555 'old))))
eec82323 7556
23f87bed
MB
7557(defun gnus-summary-force-verify-and-decrypt ()
7558 "Display buttons for signed/encrypted parts and verify/decrypt them."
7559 (interactive)
7560 (let ((mm-verify-option 'known)
7561 (mm-decrypt-option 'known)
7562 (gnus-article-emulate-mime t)
7563 (gnus-buttonized-mime-types (append (list "multipart/signed"
7564 "multipart/encrypted")
7565 gnus-buttonized-mime-types)))
7566 (gnus-summary-select-article nil 'force)))
7567
eec82323
LMI
7568(defun gnus-summary-set-current-mark (&optional current-mark)
7569 "Obsolete function."
7570 nil)
7571
7572(defun gnus-summary-next-article (&optional unread subject backward push)
7573 "Select the next article.
7574If UNREAD, only unread articles are selected.
7575If SUBJECT, only articles with SUBJECT are selected.
7576If BACKWARD, the previous article is selected instead of the next."
7577 (interactive "P")
11e95b02
MB
7578 ;; Make sure we are in the summary buffer.
7579 (unless (eq major-mode 'gnus-summary-mode)
7580 (set-buffer gnus-summary-buffer))
eec82323
LMI
7581 (cond
7582 ;; Is there such an article?
7583 ((and (gnus-summary-search-forward unread subject backward)
7584 (or (gnus-summary-display-article (gnus-summary-article-number))
7585 (eq (gnus-summary-article-mark) gnus-canceled-mark)))
7586 (gnus-summary-position-point))
7587 ;; If not, we try the first unread, if that is wanted.
7588 ((and subject
7589 gnus-auto-select-same
7590 (gnus-summary-first-unread-article))
7591 (gnus-summary-position-point)
7592 (gnus-message 6 "Wrapped"))
7593 ;; Try to get next/previous article not displayed in this group.
7594 ((and gnus-auto-extend-newsgroup
7595 (not unread) (not subject))
7596 (gnus-summary-goto-article
7597 (if backward (1- gnus-newsgroup-begin) (1+ gnus-newsgroup-end))
6748645f 7598 nil (count-lines (point-min) (point))))
eec82323
LMI
7599 ;; Go to next/previous group.
7600 (t
7601 (unless (gnus-ephemeral-group-p gnus-newsgroup-name)
7602 (gnus-summary-jump-to-group gnus-newsgroup-name))
7603 (let ((cmd last-command-char)
7604 (point
01c52d31 7605 (with-current-buffer gnus-group-buffer
eec82323
LMI
7606 (point)))
7607 (group
7608 (if (eq gnus-keep-same-level 'best)
7609 (gnus-summary-best-group gnus-newsgroup-name)
7610 (gnus-summary-search-group backward gnus-keep-same-level))))
7611 ;; For some reason, the group window gets selected. We change
7612 ;; it back.
7613 (select-window (get-buffer-window (current-buffer)))
7614 ;; Select next unread newsgroup automagically.
7615 (cond
7616 ((or (not gnus-auto-select-next)
7617 (not cmd))
7618 (gnus-message 7 "No more%s articles" (if unread " unread" "")))
7619 ((or (eq gnus-auto-select-next 'quietly)
7620 (and (eq gnus-auto-select-next 'slightly-quietly)
7621 push)
7622 (and (eq gnus-auto-select-next 'almost-quietly)
7623 (gnus-summary-last-article-p)))
7624 ;; Select quietly.
7625 (if (gnus-ephemeral-group-p gnus-newsgroup-name)
7626 (gnus-summary-exit)
7627 (gnus-message 7 "No more%s articles (%s)..."
7628 (if unread " unread" "")
7629 (if group (concat "selecting " group)
7630 "exiting"))
7631 (gnus-summary-next-group nil group backward)))
7632 (t
7633 (when (gnus-key-press-event-p last-input-event)
7634 (gnus-summary-walk-group-buffer
7635 gnus-newsgroup-name cmd unread backward point))))))))
7636
7637(defun gnus-summary-walk-group-buffer (from-group cmd unread backward start)
7638 (let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1))
7639 (?\C-p (gnus-group-prev-unread-group 1))))
7640 (cursor-in-echo-area t)
23f87bed 7641 keve key group ended prompt)
c7a91ce1 7642 (with-current-buffer gnus-group-buffer
eec82323
LMI
7643 (goto-char start)
7644 (setq group
7645 (if (eq gnus-keep-same-level 'best)
7646 (gnus-summary-best-group gnus-newsgroup-name)
7647 (gnus-summary-search-group backward gnus-keep-same-level))))
7648 (while (not ended)
23f87bed
MB
7649 (setq prompt
7650 (format
7651 "No more%s articles%s " (if unread " unread" "")
7652 (if (and group
7653 (not (gnus-ephemeral-group-p gnus-newsgroup-name)))
7654 (format " (Type %s for %s [%s])"
91472578
MB
7655 (single-key-description cmd)
7656 (gnus-group-decoded-name group)
01c52d31 7657 (gnus-group-unread group))
23f87bed
MB
7658 (format " (Type %s to exit %s)"
7659 (single-key-description cmd)
91472578 7660 (gnus-group-decoded-name gnus-newsgroup-name)))))
eec82323 7661 ;; Confirm auto selection.
23f87bed
MB
7662 (setq key (car (setq keve (gnus-read-event-char prompt)))
7663 ended t)
eec82323
LMI
7664 (cond
7665 ((assq key keystrokes)
7666 (let ((obuf (current-buffer)))
7667 (switch-to-buffer gnus-group-buffer)
7668 (when group
7669 (gnus-group-jump-to-group group))
7670 (eval (cadr (assq key keystrokes)))
7671 (setq group (gnus-group-group-name))
7672 (switch-to-buffer obuf))
7673 (setq ended nil))
7674 ((equal key cmd)
7675 (if (or (not group)
7676 (gnus-ephemeral-group-p gnus-newsgroup-name))
7677 (gnus-summary-exit)
7678 (gnus-summary-next-group nil group backward)))
7679 (t
7680 (push (cdr keve) unread-command-events))))))
7681
7682(defun gnus-summary-next-unread-article ()
7683 "Select unread article after current one."
7684 (interactive)
7685 (gnus-summary-next-article
7686 (or (not (eq gnus-summary-goto-unread 'never))
7687 (gnus-summary-last-article-p (gnus-summary-article-number)))
7688 (and gnus-auto-select-same
7689 (gnus-summary-article-subject))))
7690
7691(defun gnus-summary-prev-article (&optional unread subject)
bbbe940b 7692 "Select the article before the current one.
eec82323
LMI
7693If UNREAD is non-nil, only unread articles are selected."
7694 (interactive "P")
7695 (gnus-summary-next-article unread subject t))
7696
7697(defun gnus-summary-prev-unread-article ()
7698 "Select unread article before current one."
7699 (interactive)
7700 (gnus-summary-prev-article
7701 (or (not (eq gnus-summary-goto-unread 'never))
7702 (gnus-summary-first-article-p (gnus-summary-article-number)))
7703 (and gnus-auto-select-same
7704 (gnus-summary-article-subject))))
7705
23f87bed 7706(defun gnus-summary-next-page (&optional lines circular stop)
eec82323
LMI
7707 "Show next page of the selected article.
7708If at the end of the current article, select the next article.
7709LINES says how many lines should be scrolled up.
7710
7711If CIRCULAR is non-nil, go to the start of the article instead of
7712selecting the next article when reaching the end of the current
23f87bed
MB
7713article.
7714
7715If STOP is non-nil, just stop when reaching the end of the message.
7716
7717Also see the variable `gnus-article-skip-boring'."
eec82323
LMI
7718 (interactive "P")
7719 (setq gnus-summary-buffer (current-buffer))
7720 (gnus-set-global-variables)
7721 (let ((article (gnus-summary-article-number))
7722 (article-window (get-buffer-window gnus-article-buffer t))
7723 endp)
6748645f
LMI
7724 ;; If the buffer is empty, we have no article.
7725 (unless article
7726 (error "No article to select"))
eec82323
LMI
7727 (gnus-configure-windows 'article)
7728 (if (eq (cdr (assq article gnus-newsgroup-reads)) gnus-canceled-mark)
7729 (if (and (eq gnus-summary-goto-unread 'never)
7730 (not (gnus-summary-last-article-p article)))
7731 (gnus-summary-next-article)
7732 (gnus-summary-next-unread-article))
7733 (if (or (null gnus-current-article)
7734 (null gnus-article-current)
7735 (/= article (cdr gnus-article-current))
7736 (not (equal (car gnus-article-current) gnus-newsgroup-name)))
7737 ;; Selected subject is different from current article's.
7738 (gnus-summary-display-article article)
7739 (when article-window
7740 (gnus-eval-in-buffer-window gnus-article-buffer
23f87bed
MB
7741 (setq endp (or (gnus-article-next-page lines)
7742 (gnus-article-only-boring-p))))
eec82323 7743 (when endp
23f87bed
MB
7744 (cond (stop
7745 (gnus-message 3 "End of message"))
7746 (circular
eec82323
LMI
7747 (gnus-summary-beginning-of-article))
7748 (lines
7749 (gnus-message 3 "End of message"))
7750 ((null lines)
7751 (if (and (eq gnus-summary-goto-unread 'never)
7752 (not (gnus-summary-last-article-p article)))
7753 (gnus-summary-next-article)
7754 (gnus-summary-next-unread-article))))))))
7755 (gnus-summary-recenter)
7756 (gnus-summary-position-point)))
7757
7758(defun gnus-summary-prev-page (&optional lines move)
7759 "Show previous page of selected article.
7760Argument LINES specifies lines to be scrolled down.
7761If MOVE, move to the previous unread article if point is at
7762the beginning of the buffer."
7763 (interactive "P")
eec82323
LMI
7764 (let ((article (gnus-summary-article-number))
7765 (article-window (get-buffer-window gnus-article-buffer t))
7766 endp)
7767 (gnus-configure-windows 'article)
7768 (if (or (null gnus-current-article)
7769 (null gnus-article-current)
7770 (/= article (cdr gnus-article-current))
7771 (not (equal (car gnus-article-current) gnus-newsgroup-name)))
7772 ;; Selected subject is different from current article's.
7773 (gnus-summary-display-article article)
7774 (gnus-summary-recenter)
7775 (when article-window
7776 (gnus-eval-in-buffer-window gnus-article-buffer
7777 (setq endp (gnus-article-prev-page lines)))
7778 (when (and move endp)
7779 (cond (lines
7780 (gnus-message 3 "Beginning of message"))
7781 ((null lines)
7782 (if (and (eq gnus-summary-goto-unread 'never)
7783 (not (gnus-summary-first-article-p article)))
7784 (gnus-summary-prev-article)
7785 (gnus-summary-prev-unread-article))))))))
7786 (gnus-summary-position-point))
7787
7788(defun gnus-summary-prev-page-or-article (&optional lines)
7789 "Show previous page of selected article.
7790Argument LINES specifies lines to be scrolled down.
7791If at the beginning of the article, go to the next article."
7792 (interactive "P")
7793 (gnus-summary-prev-page lines t))
7794
7795(defun gnus-summary-scroll-up (lines)
7796 "Scroll up (or down) one line current article.
7797Argument LINES specifies lines to be scrolled up (or down if negative)."
7798 (interactive "p")
eec82323
LMI
7799 (gnus-configure-windows 'article)
7800 (gnus-summary-show-thread)
7801 (when (eq (gnus-summary-select-article nil nil 'pseudo) 'old)
7802 (gnus-eval-in-buffer-window gnus-article-buffer
7803 (cond ((> lines 0)
7804 (when (gnus-article-next-page lines)
7805 (gnus-message 3 "End of message")))
7806 ((< lines 0)
7807 (gnus-article-prev-page (- lines))))))
7808 (gnus-summary-recenter)
7809 (gnus-summary-position-point))
7810
6748645f
LMI
7811(defun gnus-summary-scroll-down (lines)
7812 "Scroll down (or up) one line current article.
7813Argument LINES specifies lines to be scrolled down (or up if negative)."
7814 (interactive "p")
7815 (gnus-summary-scroll-up (- lines)))
7816
eec82323
LMI
7817(defun gnus-summary-next-same-subject ()
7818 "Select next article which has the same subject as current one."
7819 (interactive)
eec82323
LMI
7820 (gnus-summary-next-article nil (gnus-summary-article-subject)))
7821
7822(defun gnus-summary-prev-same-subject ()
7823 "Select previous article which has the same subject as current one."
7824 (interactive)
eec82323
LMI
7825 (gnus-summary-prev-article nil (gnus-summary-article-subject)))
7826
7827(defun gnus-summary-next-unread-same-subject ()
7828 "Select next unread article which has the same subject as current one."
7829 (interactive)
eec82323
LMI
7830 (gnus-summary-next-article t (gnus-summary-article-subject)))
7831
7832(defun gnus-summary-prev-unread-same-subject ()
7833 "Select previous unread article which has the same subject as current one."
7834 (interactive)
eec82323
LMI
7835 (gnus-summary-prev-article t (gnus-summary-article-subject)))
7836
7837(defun gnus-summary-first-unread-article ()
7838 "Select the first unread article.
7839Return nil if there are no unread articles."
7840 (interactive)
eec82323
LMI
7841 (prog1
7842 (when (gnus-summary-first-subject t)
7843 (gnus-summary-show-thread)
7844 (gnus-summary-first-subject t)
7845 (gnus-summary-display-article (gnus-summary-article-number)))
7846 (gnus-summary-position-point)))
7847
16409b0b
GM
7848(defun gnus-summary-first-unread-subject ()
7849 "Place the point on the subject line of the first unread article.
7850Return nil if there are no unread articles."
7851 (interactive)
7852 (prog1
7853 (when (gnus-summary-first-subject t)
7854 (gnus-summary-show-thread)
7855 (gnus-summary-first-subject t))
7856 (gnus-summary-position-point)))
7857
23f87bed
MB
7858(defun gnus-summary-first-unseen-subject ()
7859 "Place the point on the subject line of the first unseen article.
7860Return nil if there are no unseen articles."
7861 (interactive)
7862 (prog1
7863 (when (gnus-summary-first-subject nil nil t)
7864 (gnus-summary-show-thread)
7865 (gnus-summary-first-subject nil nil t))
7866 (gnus-summary-position-point)))
7867
7868(defun gnus-summary-first-unseen-or-unread-subject ()
7869 "Place the point on the subject line of the first unseen article or,
7870if all article have been seen, on the subject line of the first unread
7871article."
7872 (interactive)
7873 (prog1
7874 (unless (when (gnus-summary-first-subject nil nil t)
7875 (gnus-summary-show-thread)
7876 (gnus-summary-first-subject nil nil t))
7877 (when (gnus-summary-first-subject t)
7878 (gnus-summary-show-thread)
7879 (gnus-summary-first-subject t)))
7880 (gnus-summary-position-point)))
7881
eec82323
LMI
7882(defun gnus-summary-first-article ()
7883 "Select the first article.
7884Return nil if there are no articles."
7885 (interactive)
eec82323
LMI
7886 (prog1
7887 (when (gnus-summary-first-subject)
16409b0b
GM
7888 (gnus-summary-show-thread)
7889 (gnus-summary-first-subject)
7890 (gnus-summary-display-article (gnus-summary-article-number)))
eec82323
LMI
7891 (gnus-summary-position-point)))
7892
23f87bed
MB
7893(defun gnus-summary-best-unread-article (&optional arg)
7894 "Select the unread article with the highest score.
7895If given a prefix argument, select the next unread article that has a
7896score higher than the default score."
7897 (interactive "P")
7898 (let ((article (if arg
7899 (gnus-summary-better-unread-subject)
7900 (gnus-summary-best-unread-subject))))
7901 (if article
7902 (gnus-summary-goto-article article)
7903 (error "No unread articles"))))
7904
7905(defun gnus-summary-best-unread-subject ()
7906 "Select the unread subject with the highest score."
eec82323 7907 (interactive)
eec82323
LMI
7908 (let ((best -1000000)
7909 (data gnus-newsgroup-data)
7910 article score)
7911 (while data
7912 (and (gnus-data-unread-p (car data))
7913 (> (setq score
7914 (gnus-summary-article-score (gnus-data-number (car data))))
7915 best)
7916 (setq best score
7917 article (gnus-data-number (car data))))
7918 (setq data (cdr data)))
23f87bed
MB
7919 (when article
7920 (gnus-summary-goto-subject article))
7921 (gnus-summary-position-point)
7922 article))
7923
7924(defun gnus-summary-better-unread-subject ()
7925 "Select the first unread subject that has a score over the default score."
7926 (interactive)
7927 (let ((data gnus-newsgroup-data)
7928 article score)
7929 (while (and (setq article (gnus-data-number (car data)))
7930 (or (gnus-data-read-p (car data))
7931 (not (> (gnus-summary-article-score article)
7932 gnus-summary-default-score))))
7933 (setq data (cdr data)))
7934 (when article
7935 (gnus-summary-goto-subject article))
7936 (gnus-summary-position-point)
7937 article))
eec82323
LMI
7938
7939(defun gnus-summary-last-subject ()
7940 "Go to the last displayed subject line in the group."
7941 (let ((article (gnus-data-number (car (gnus-data-list t)))))
7942 (when article
7943 (gnus-summary-goto-subject article))))
7944
7945(defun gnus-summary-goto-article (article &optional all-headers force)
6748645f
LMI
7946 "Fetch ARTICLE (article number or Message-ID) and display it if it exists.
7947If ALL-HEADERS is non-nil, no header lines are hidden.
7948If FORCE, go to the article even if it isn't displayed. If FORCE
7949is a number, it is the line the article is to be displayed on."
eec82323
LMI
7950 (interactive
7951 (list
6748645f
LMI
7952 (completing-read
7953 "Article number or Message-ID: "
7954 (mapcar (lambda (number) (list (int-to-string number)))
7955 gnus-newsgroup-limit))
eec82323
LMI
7956 current-prefix-arg
7957 t))
7958 (prog1
6748645f 7959 (if (and (stringp article)
23f87bed 7960 (string-match "@\\|%40" article))
6748645f
LMI
7961 (gnus-summary-refer-article article)
7962 (when (stringp article)
7963 (setq article (string-to-number article)))
7964 (if (gnus-summary-goto-subject article force)
7965 (gnus-summary-display-article article all-headers)
7966 (gnus-message 4 "Couldn't go to article %s" article) nil))
eec82323
LMI
7967 (gnus-summary-position-point)))
7968
7969(defun gnus-summary-goto-last-article ()
7970 "Go to the previously read article."
7971 (interactive)
7972 (prog1
7973 (when gnus-last-article
6748645f 7974 (gnus-summary-goto-article gnus-last-article nil t))
eec82323
LMI
7975 (gnus-summary-position-point)))
7976
7977(defun gnus-summary-pop-article (number)
7978 "Pop one article off the history and go to the previous.
7979NUMBER articles will be popped off."
7980 (interactive "p")
7981 (let (to)
7982 (setq gnus-newsgroup-history
7983 (cdr (setq to (nthcdr number gnus-newsgroup-history))))
7984 (if to
6748645f 7985 (gnus-summary-goto-article (car to) nil t)
eec82323
LMI
7986 (error "Article history empty")))
7987 (gnus-summary-position-point))
7988
7989;; Summary commands and functions for limiting the summary buffer.
7990
7991(defun gnus-summary-limit-to-articles (n)
7992 "Limit the summary buffer to the next N articles.
7993If not given a prefix, use the process marked articles instead."
7994 (interactive "P")
eec82323
LMI
7995 (prog1
7996 (let ((articles (gnus-summary-work-articles n)))
7997 (setq gnus-newsgroup-processable nil)
7998 (gnus-summary-limit articles))
7999 (gnus-summary-position-point)))
8000
8001(defun gnus-summary-pop-limit (&optional total)
8002 "Restore the previous limit.
8003If given a prefix, remove all limits."
8004 (interactive "P")
eec82323
LMI
8005 (when total
8006 (setq gnus-newsgroup-limits
8007 (list (mapcar (lambda (h) (mail-header-number h))
8008 gnus-newsgroup-headers))))
8009 (unless gnus-newsgroup-limits
8010 (error "No limit to pop"))
8011 (prog1
8012 (gnus-summary-limit nil 'pop)
8013 (gnus-summary-position-point)))
8014
47b63dfa
SZ
8015(defun gnus-summary-limit-to-subject (subject &optional header not-matching)
8016 "Limit the summary buffer to articles that have subjects that match a regexp.
8017If NOT-MATCHING, excluding articles that have subjects that match a regexp."
a1506d29 8018 (interactive
47b63dfa
SZ
8019 (list (read-string (if current-prefix-arg
8020 "Exclude subject (regexp): "
a1506d29 8021 "Limit to subject (regexp): "))
47b63dfa 8022 nil current-prefix-arg))
eec82323
LMI
8023 (unless header
8024 (setq header "subject"))
8025 (when (not (equal "" subject))
8026 (prog1
8027 (let ((articles (gnus-summary-find-matching
a1506d29 8028 (or header "subject") subject 'all nil nil
47b63dfa 8029 not-matching)))
eec82323
LMI
8030 (unless articles
8031 (error "Found no matches for \"%s\"" subject))
8032 (gnus-summary-limit articles))
8033 (gnus-summary-position-point))))
8034
ef6e0ec7 8035(defun gnus-summary-limit-to-author (from &optional not-matching)
47b63dfa
SZ
8036 "Limit the summary buffer to articles that have authors that match a regexp.
8037If NOT-MATCHING, excluding articles that have authors that match a regexp."
a1506d29 8038 (interactive
47b63dfa
SZ
8039 (list (read-string (if current-prefix-arg
8040 "Exclude author (regexp): "
a1506d29 8041 "Limit to author (regexp): "))
ef6e0ec7
SZ
8042 current-prefix-arg))
8043 (gnus-summary-limit-to-subject from "from" not-matching))
eec82323 8044
01c52d31
MB
8045(defun gnus-summary-limit-to-recipient (recipient &optional not-matching)
8046 "Limit the summary buffer to articles with the given RECIPIENT.
8047
8048If NOT-MATCHING, exclude RECIPIENT.
8049
8050To and Cc headers are checked. You need to include them in
8051`nnmail-extra-headers'."
8052 ;; Unlike `rmail-summary-by-recipients', doesn't include From.
8053 (interactive
8054 (list (read-string (format "%s recipient (regexp): "
8055 (if current-prefix-arg "Exclude" "Limit to")))
8056 current-prefix-arg))
8057 (when (not (equal "" recipient))
8058 (prog1 (let* ((to
8059 (if (memq 'To nnmail-extra-headers)
8060 (gnus-summary-find-matching
8061 (cons 'extra 'To) recipient 'all nil nil
8062 not-matching)
8063 (gnus-message
8064 1 "`To' isn't present in `nnmail-extra-headers'")
8065 (sit-for 1)
8066 nil))
8067 (cc
8068 (if (memq 'Cc nnmail-extra-headers)
8069 (gnus-summary-find-matching
8070 (cons 'extra 'Cc) recipient 'all nil nil
8071 not-matching)
8072 (gnus-message
8073 1 "`Cc' isn't present in `nnmail-extra-headers'")
8074 (sit-for 1)
8075 nil))
8076 (articles
8077 (if not-matching
8078 ;; We need the numbers that are in both lists:
8079 (mapcar (lambda (a)
8080 (and (memq a to) a))
8081 cc)
8082 (nconc to cc))))
8083 (unless articles
8084 (error "Found no matches for \"%s\"" recipient))
8085 (gnus-summary-limit articles))
8086 (gnus-summary-position-point))))
8087
8088(defun gnus-summary-limit-to-address (address &optional not-matching)
8089 "Limit the summary buffer to articles with the given ADDRESS.
8090
8091If NOT-MATCHING, exclude ADDRESS.
8092
8093To, Cc and From headers are checked. You need to include `To' and `Cc'
8094in `nnmail-extra-headers'."
8095 (interactive
8096 (list (read-string (format "%s address (regexp): "
8097 (if current-prefix-arg "Exclude" "Limit to")))
8098 current-prefix-arg))
8099 (when (not (equal "" address))
8100 (prog1 (let* ((to
8101 (if (memq 'To nnmail-extra-headers)
8102 (gnus-summary-find-matching
8103 (cons 'extra 'To) address 'all nil nil
8104 not-matching)
8105 (gnus-message
8106 1 "`To' isn't present in `nnmail-extra-headers'")
8107 (sit-for 1)
8108 t))
8109 (cc
8110 (if (memq 'Cc nnmail-extra-headers)
8111 (gnus-summary-find-matching
8112 (cons 'extra 'Cc) address 'all nil nil
8113 not-matching)
8114 (gnus-message
8115 1 "`Cc' isn't present in `nnmail-extra-headers'")
8116 (sit-for 1)
8117 t))
8118 (from
8119 (gnus-summary-find-matching "from" address
8120 'all nil nil not-matching))
8121 (articles
8122 (if not-matching
8123 ;; We need the numbers that are in all lists:
8124 (if (eq cc t)
8125 (if (eq to t)
8126 from
8127 (mapcar (lambda (a) (car (memq a from))) to))
8128 (if (eq to t)
8129 (mapcar (lambda (a) (car (memq a from))) cc)
8130 (mapcar (lambda (a) (car (memq a from)))
8131 (mapcar (lambda (a) (car (memq a to)))
8132 cc))))
8133 (nconc (if (eq to t) nil to)
8134 (if (eq cc t) nil cc)
8135 from))))
8136 (unless articles
8137 (error "Found no matches for \"%s\"" address))
8138 (gnus-summary-limit articles))
8139 (gnus-summary-position-point))))
8140
8141(defun gnus-summary-limit-strange-charsets-predicate (header)
8142 (let ((string (concat (mail-header-subject header)
8143 (mail-header-from header)))
8144 charset found)
8145 (dotimes (i (1- (length string)))
8146 (setq charset (format "%s" (char-charset (aref string (1+ i)))))
8147 (when (string-match "unicode\\|big\\|japanese" charset)
8148 (setq found t)))
8149 found))
8150
8151(defun gnus-summary-limit-to-predicate (predicate)
8152 "Limit to articles where PREDICATE returns non-nil.
8153PREDICATE will be called with the header structures of the
8154articles."
8155 (let ((articles nil)
8156 (case-fold-search t))
8157 (dolist (header gnus-newsgroup-headers)
8158 (when (funcall predicate header)
8159 (push (mail-header-number header) articles)))
8160 (gnus-summary-limit (nreverse articles))))
8161
eec82323
LMI
8162(defun gnus-summary-limit-to-age (age &optional younger-p)
8163 "Limit the summary buffer to articles that are older than (or equal) AGE days.
8164If YOUNGER-P (the prefix) is non-nil, limit the summary buffer to
8165articles that are younger than AGE days."
16409b0b
GM
8166 (interactive
8167 (let ((younger current-prefix-arg)
8168 (days-got nil)
8169 days)
8170 (while (not days-got)
8171 (setq days (if younger
23f87bed
MB
8172 (read-string "Limit to articles younger than (in days, older when negative): ")
8173 (read-string
8174 "Limit to articles older than (in days, younger when negative): ")))
16409b0b
GM
8175 (when (> (length days) 0)
8176 (setq days (read days)))
8177 (if (numberp days)
23f87bed
MB
8178 (progn
8179 (setq days-got t)
01c52d31
MB
8180 (when (< days 0)
8181 (setq younger (not younger))
8182 (setq days (* days -1))))
16409b0b
GM
8183 (message "Please enter a number.")
8184 (sleep-for 1)))
8185 (list days younger)))
eec82323
LMI
8186 (prog1
8187 (let ((data gnus-newsgroup-data)
16409b0b 8188 (cutoff (days-to-time age))
eec82323
LMI
8189 articles d date is-younger)
8190 (while (setq d (pop data))
8191 (when (and (vectorp (gnus-data-header d))
8192 (setq date (mail-header-date (gnus-data-header d))))
16409b0b
GM
8193 (setq is-younger (time-less-p
8194 (time-since (condition-case ()
8195 (date-to-time date)
8196 (error '(0 0))))
eec82323 8197 cutoff))
6748645f
LMI
8198 (when (if younger-p
8199 is-younger
8200 (not is-younger))
eec82323
LMI
8201 (push (gnus-data-number d) articles))))
8202 (gnus-summary-limit (nreverse articles)))
8203 (gnus-summary-position-point)))
8204
47b63dfa 8205(defun gnus-summary-limit-to-extra (header regexp &optional not-matching)
16409b0b
GM
8206 "Limit the summary buffer to articles that match an 'extra' header."
8207 (interactive
8208 (let ((header
8209 (intern
23f87bed 8210 (gnus-completing-read-with-default
16409b0b 8211 (symbol-name (car gnus-extra-headers))
47b63dfa 8212 (if current-prefix-arg
81df110a
RF
8213 "Exclude extra header"
8214 "Limit extra header")
16409b0b
GM
8215 (mapcar (lambda (x)
8216 (cons (symbol-name x) x))
8217 gnus-extra-headers)
8218 nil
8219 t))))
8220 (list header
a1506d29 8221 (read-string (format "%s header %s (regexp): "
47b63dfa
SZ
8222 (if current-prefix-arg "Exclude" "Limit to")
8223 header))
8224 current-prefix-arg)))
16409b0b
GM
8225 (when (not (equal "" regexp))
8226 (prog1
8227 (let ((articles (gnus-summary-find-matching
a1506d29 8228 (cons 'extra header) regexp 'all nil nil
47b63dfa 8229 not-matching)))
16409b0b
GM
8230 (unless articles
8231 (error "Found no matches for \"%s\"" regexp))
8232 (gnus-summary-limit articles))
8233 (gnus-summary-position-point))))
8234
23f87bed
MB
8235(defun gnus-summary-limit-to-display-predicate ()
8236 "Limit the summary buffer to the predicated in the `display' group parameter."
8237 (interactive)
8238 (unless gnus-newsgroup-display
8239 (error "There is no `display' group parameter"))
8240 (let (articles)
8241 (dolist (number gnus-newsgroup-articles)
8242 (when (funcall gnus-newsgroup-display)
8243 (push number articles)))
8244 (gnus-summary-limit articles))
8245 (gnus-summary-position-point))
8246
eec82323
LMI
8247(defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
8248(make-obsolete
8249 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
8250
8251(defun gnus-summary-limit-to-unread (&optional all)
8252 "Limit the summary buffer to articles that are not marked as read.
8253If ALL is non-nil, limit strictly to unread articles."
8254 (interactive "P")
8255 (if all
8256 (gnus-summary-limit-to-marks (char-to-string gnus-unread-mark))
8257 (gnus-summary-limit-to-marks
8258 ;; Concat all the marks that say that an article is read and have
8259 ;; those removed.
8260 (list gnus-del-mark gnus-read-mark gnus-ancient-mark
23f87bed 8261 gnus-killed-mark gnus-spam-mark gnus-kill-file-mark
eec82323
LMI
8262 gnus-low-score-mark gnus-expirable-mark
8263 gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark
8264 gnus-duplicate-mark gnus-souped-mark)
8265 'reverse)))
8266
01c52d31
MB
8267(defun gnus-summary-limit-to-headers (match &optional reverse)
8268 "Limit the summary buffer to articles that have headers that match MATCH.
8269If REVERSE (the prefix), limit to articles that don't match."
8270 (interactive "sMatch headers (regexp): \nP")
8271 (gnus-summary-limit-to-bodies match reverse t))
8272
8273(defun gnus-summary-limit-to-bodies (match &optional reverse headersp)
8274 "Limit the summary buffer to articles that have bodies that match MATCH.
8275If REVERSE (the prefix), limit to articles that don't match."
8276 (interactive "sMatch body (regexp): \nP")
8277 (let ((articles nil)
8278 (gnus-select-article-hook nil) ;Disable hook.
8279 (gnus-article-prepare-hook nil)
8280 (gnus-use-article-prefetch nil)
8281 (gnus-keep-backlog nil)
8282 (gnus-break-pages nil)
8283 (gnus-summary-display-arrow nil)
8284 (gnus-updated-mode-lines nil)
8285 (gnus-auto-center-summary nil)
8286 (gnus-display-mime-function nil))
8287 (dolist (data gnus-newsgroup-data)
8288 (let (gnus-mark-article-hook)
8289 (gnus-summary-select-article t t nil (gnus-data-number data)))
8290 (save-excursion
8291 (set-buffer gnus-article-buffer)
8292 (article-goto-body)
8293 (let* ((case-fold-search t)
8294 (found (if headersp
8295 (re-search-backward match nil t)
8296 (re-search-forward match nil t))))
8297 (when (or (and found
8298 (not reverse))
8299 (and (not found)
8300 reverse))
8301 (push (gnus-data-number data) articles)))))
8302 (if (not articles)
8303 (message "No messages matched")
8304 (gnus-summary-limit articles)))
8305 (gnus-summary-position-point))
8306
8307(defun gnus-summary-limit-to-singletons (&optional threadsp)
8308 "Limit the summary buffer to articles that aren't part on any thread.
8309If THREADSP (the prefix), limit to articles that are in threads."
8310 (interactive "P")
8311 (let ((articles nil)
8312 thread-articles
8313 threads)
8314 (dolist (thread gnus-newsgroup-threads)
8315 (if (stringp (car thread))
8316 (dolist (thread (cdr thread))
8317 (push thread threads))
8318 (push thread threads)))
8319 (dolist (thread threads)
8320 (setq thread-articles (gnus-articles-in-thread thread))
8321 (when (or (and threadsp
8322 (> (length thread-articles) 1))
8323 (and (not threadsp)
8324 (= (length thread-articles) 1)))
8325 (setq articles (nconc thread-articles articles))))
8326 (if (not articles)
8327 (message "No messages matched")
8328 (gnus-summary-limit articles))
8329 (gnus-summary-position-point)))
8330
8331(defun gnus-summary-limit-to-replied (&optional unreplied)
8332 "Limit the summary buffer to replied articles.
8333If UNREPLIED (the prefix), limit to unreplied articles."
8334 (interactive "P")
8335 (if unreplied
8336 (gnus-summary-limit
8337 (gnus-set-difference gnus-newsgroup-articles
8338 gnus-newsgroup-replied))
8339 (gnus-summary-limit gnus-newsgroup-replied))
8340 (gnus-summary-position-point))
8341
eec82323
LMI
8342(defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-exclude-marks)
8343(make-obsolete 'gnus-summary-delete-marked-with
81ceefe2 8344 'gnus-summary-limit-exclude-marks)
eec82323
LMI
8345
8346(defun gnus-summary-limit-exclude-marks (marks &optional reverse)
8347 "Exclude articles that are marked with MARKS (e.g. \"DK\").
8348If REVERSE, limit the summary buffer to articles that are marked
8349with MARKS. MARKS can either be a string of marks or a list of marks.
8350Returns how many articles were removed."
8351 (interactive "sMarks: ")
8352 (gnus-summary-limit-to-marks marks t))
8353
8354(defun gnus-summary-limit-to-marks (marks &optional reverse)
8355 "Limit the summary buffer to articles that are marked with MARKS (e.g. \"DK\").
8356If REVERSE (the prefix), limit the summary buffer to articles that are
8357not marked with MARKS. MARKS can either be a string of marks or a
8358list of marks.
8359Returns how many articles were removed."
6748645f 8360 (interactive "sMarks: \nP")
eec82323
LMI
8361 (prog1
8362 (let ((data gnus-newsgroup-data)
8363 (marks (if (listp marks) marks
8364 (append marks nil))) ; Transform to list.
8365 articles)
8366 (while data
8367 (when (if reverse (not (memq (gnus-data-mark (car data)) marks))
8368 (memq (gnus-data-mark (car data)) marks))
8369 (push (gnus-data-number (car data)) articles))
8370 (setq data (cdr data)))
8371 (gnus-summary-limit articles))
8372 (gnus-summary-position-point)))
8373
23f87bed 8374(defun gnus-summary-limit-to-score (score)
eec82323 8375 "Limit to articles with score at or above SCORE."
23f87bed 8376 (interactive "NLimit to articles with score of at least: ")
eec82323
LMI
8377 (let ((data gnus-newsgroup-data)
8378 articles)
8379 (while data
8380 (when (>= (gnus-summary-article-score (gnus-data-number (car data)))
8381 score)
8382 (push (gnus-data-number (car data)) articles))
8383 (setq data (cdr data)))
8384 (prog1
8385 (gnus-summary-limit articles)
8386 (gnus-summary-position-point))))
8387
23f87bed
MB
8388(defun gnus-summary-limit-to-unseen ()
8389 "Limit to unseen articles."
8390 (interactive)
8391 (prog1
8392 (gnus-summary-limit gnus-newsgroup-unseen)
8393 (gnus-summary-position-point)))
8394
6748645f 8395(defun gnus-summary-limit-include-thread (id)
23f87bed
MB
8396 "Display all the hidden articles that is in the thread with ID in it.
8397When called interactively, ID is the Message-ID of the current
8398article."
6748645f
LMI
8399 (interactive (list (mail-header-id (gnus-summary-article-header))))
8400 (let ((articles (gnus-articles-in-thread
8401 (gnus-id-to-thread (gnus-root-id id)))))
8402 (prog1
8403 (gnus-summary-limit (nconc articles gnus-newsgroup-limit))
23f87bed
MB
8404 (gnus-summary-limit-include-matching-articles
8405 "subject"
8406 (regexp-quote (gnus-simplify-subject-re
8407 (mail-header-subject (gnus-id-to-header id)))))
6748645f
LMI
8408 (gnus-summary-position-point))))
8409
23f87bed
MB
8410(defun gnus-summary-limit-include-matching-articles (header regexp)
8411 "Display all the hidden articles that have HEADERs that match REGEXP."
8412 (interactive (list (read-string "Match on header: ")
8413 (read-string "Regexp: ")))
8414 (let ((articles (gnus-find-matching-articles header regexp)))
8415 (prog1
8416 (gnus-summary-limit (nconc articles gnus-newsgroup-limit))
8417 (gnus-summary-position-point))))
8418
8419(defun gnus-summary-insert-dormant-articles ()
8420 "Insert all the dormant articles for this group into the current buffer."
8421 (interactive)
8422 (let ((gnus-verbose (max 6 gnus-verbose)))
8423 (if (not gnus-newsgroup-dormant)
db629244 8424 (gnus-message 3 "No dormant articles for this group")
23f87bed
MB
8425 (gnus-summary-goto-subjects gnus-newsgroup-dormant))))
8426
01c52d31
MB
8427(defun gnus-summary-insert-ticked-articles ()
8428 "Insert ticked articles for this group into the current buffer."
8429 (interactive)
8430 (let ((gnus-verbose (max 6 gnus-verbose)))
8431 (if (not gnus-newsgroup-marked)
8432 (gnus-message 3 "No ticked articles for this group")
8433 (gnus-summary-goto-subjects gnus-newsgroup-marked))))
8434
eec82323 8435(defun gnus-summary-limit-include-dormant ()
6748645f
LMI
8436 "Display all the hidden articles that are marked as dormant.
8437Note that this command only works on a subset of the articles currently
8438fetched for this group."
eec82323 8439 (interactive)
eec82323
LMI
8440 (unless gnus-newsgroup-dormant
8441 (error "There are no dormant articles in this group"))
8442 (prog1
8443 (gnus-summary-limit (append gnus-newsgroup-dormant gnus-newsgroup-limit))
8444 (gnus-summary-position-point)))
8445
8446(defun gnus-summary-limit-exclude-dormant ()
8447 "Hide all dormant articles."
8448 (interactive)
eec82323
LMI
8449 (prog1
8450 (gnus-summary-limit-to-marks (list gnus-dormant-mark) 'reverse)
8451 (gnus-summary-position-point)))
8452
8453(defun gnus-summary-limit-exclude-childless-dormant ()
8454 "Hide all dormant articles that have no children."
8455 (interactive)
eec82323
LMI
8456 (let ((data (gnus-data-list t))
8457 articles d children)
8458 ;; Find all articles that are either not dormant or have
8459 ;; children.
8460 (while (setq d (pop data))
8461 (when (or (not (= (gnus-data-mark d) gnus-dormant-mark))
8462 (and (setq children
8463 (gnus-article-children (gnus-data-number d)))
8464 (let (found)
8465 (while children
8466 (when (memq (car children) articles)
8467 (setq children nil
8468 found t))
8469 (pop children))
8470 found)))
8471 (push (gnus-data-number d) articles)))
8472 ;; Do the limiting.
8473 (prog1
8474 (gnus-summary-limit articles)
8475 (gnus-summary-position-point))))
8476
8477(defun gnus-summary-limit-mark-excluded-as-read (&optional all)
8478 "Mark all unread excluded articles as read.
8479If ALL, mark even excluded ticked and dormants as read."
8480 (interactive "P")
23f87bed
MB
8481 (setq gnus-newsgroup-limit (sort gnus-newsgroup-limit '<))
8482 (let ((articles (gnus-sorted-ndifference
eec82323
LMI
8483 (sort
8484 (mapcar (lambda (h) (mail-header-number h))
8485 gnus-newsgroup-headers)
8486 '<)
23f87bed 8487 gnus-newsgroup-limit))
eec82323 8488 article)
6748645f 8489 (setq gnus-newsgroup-unreads
23f87bed
MB
8490 (gnus-sorted-intersection gnus-newsgroup-unreads
8491 gnus-newsgroup-limit))
eec82323
LMI
8492 (if all
8493 (setq gnus-newsgroup-dormant nil
8494 gnus-newsgroup-marked nil
8495 gnus-newsgroup-reads
8496 (nconc
8497 (mapcar (lambda (n) (cons n gnus-catchup-mark)) articles)
8498 gnus-newsgroup-reads))
8499 (while (setq article (pop articles))
8500 (unless (or (memq article gnus-newsgroup-dormant)
8501 (memq article gnus-newsgroup-marked))
8502 (push (cons article gnus-catchup-mark) gnus-newsgroup-reads))))))
8503
8504(defun gnus-summary-limit (articles &optional pop)
8505 (if pop
8506 ;; We pop the previous limit off the stack and use that.
8507 (setq articles (car gnus-newsgroup-limits)
8508 gnus-newsgroup-limits (cdr gnus-newsgroup-limits))
8509 ;; We use the new limit, so we push the old limit on the stack.
8510 (push gnus-newsgroup-limit gnus-newsgroup-limits))
8511 ;; Set the limit.
8512 (setq gnus-newsgroup-limit articles)
8513 (let ((total (length gnus-newsgroup-data))
8514 (data (gnus-data-find-list (gnus-summary-article-number)))
8515 (gnus-summary-mark-below nil) ; Inhibit this.
8516 found)
8517 ;; This will do all the work of generating the new summary buffer
8518 ;; according to the new limit.
8519 (gnus-summary-prepare)
8520 ;; Hide any threads, possibly.
23f87bed 8521 (gnus-summary-maybe-hide-threads)
eec82323
LMI
8522 ;; Try to return to the article you were at, or one in the
8523 ;; neighborhood.
8524 (when data
8525 ;; We try to find some article after the current one.
8526 (while data
8527 (when (gnus-summary-goto-subject (gnus-data-number (car data)) nil t)
8528 (setq data nil
8529 found t))
8530 (setq data (cdr data))))
8531 (unless found
8532 ;; If there is no data, that means that we were after the last
8533 ;; article. The same goes when we can't find any articles
8534 ;; after the current one.
8535 (goto-char (point-max))
8536 (gnus-summary-find-prev))
6748645f 8537 (gnus-set-mode-line 'summary)
eec82323
LMI
8538 ;; We return how many articles were removed from the summary
8539 ;; buffer as a result of the new limit.
8540 (- total (length gnus-newsgroup-data))))
8541
8542(defsubst gnus-invisible-cut-children (threads)
8543 (let ((num 0))
8544 (while threads
8545 (when (memq (mail-header-number (caar threads)) gnus-newsgroup-limit)
8546 (incf num))
8547 (pop threads))
8548 (< num 2)))
8549
8550(defsubst gnus-cut-thread (thread)
8551 "Go forwards in the thread until we find an article that we want to display."
8552 (when (or (eq gnus-fetch-old-headers 'some)
6748645f 8553 (eq gnus-fetch-old-headers 'invisible)
16409b0b 8554 (numberp gnus-fetch-old-headers)
eec82323
LMI
8555 (eq gnus-build-sparse-threads 'some)
8556 (eq gnus-build-sparse-threads 'more))
8557 ;; Deal with old-fetched headers and sparse threads.
8558 (while (and
8559 thread
8560 (or
8561 (gnus-summary-article-sparse-p (mail-header-number (car thread)))
8562 (gnus-summary-article-ancient-p
8563 (mail-header-number (car thread))))
6748645f
LMI
8564 (if (or (<= (length (cdr thread)) 1)
8565 (eq gnus-fetch-old-headers 'invisible))
8566 (setq gnus-newsgroup-limit
8567 (delq (mail-header-number (car thread))
8568 gnus-newsgroup-limit)
8569 thread (cadr thread))
8570 (when (gnus-invisible-cut-children (cdr thread))
8571 (let ((th (cdr thread)))
8572 (while th
8573 (if (memq (mail-header-number (caar th))
a8151ef7 8574 gnus-newsgroup-limit)
6748645f
LMI
8575 (setq thread (car th)
8576 th nil)
8577 (setq th (cdr th))))))))))
eec82323
LMI
8578 thread)
8579
8580(defun gnus-cut-threads (threads)
23f87bed 8581 "Cut off all uninteresting articles from the beginning of THREADS."
eec82323 8582 (when (or (eq gnus-fetch-old-headers 'some)
6748645f 8583 (eq gnus-fetch-old-headers 'invisible)
16409b0b 8584 (numberp gnus-fetch-old-headers)
eec82323
LMI
8585 (eq gnus-build-sparse-threads 'some)
8586 (eq gnus-build-sparse-threads 'more))
8587 (let ((th threads))
8588 (while th
8589 (setcar th (gnus-cut-thread (car th)))
8590 (setq th (cdr th)))))
8591 ;; Remove nixed out threads.
8592 (delq nil threads))
8593
8594(defun gnus-summary-initial-limit (&optional show-if-empty)
8595 "Figure out what the initial limit is supposed to be on group entry.
8596This entails weeding out unwanted dormants, low-scored articles,
8597fetch-old-headers verbiage, and so on."
8598 ;; Most groups have nothing to remove.
8599 (if (or gnus-inhibit-limiting
8600 (and (null gnus-newsgroup-dormant)
23f87bed 8601 (eq gnus-newsgroup-display 'gnus-not-ignore)
eec82323 8602 (not (eq gnus-fetch-old-headers 'some))
16409b0b 8603 (not (numberp gnus-fetch-old-headers))
6748645f 8604 (not (eq gnus-fetch-old-headers 'invisible))
eec82323
LMI
8605 (null gnus-summary-expunge-below)
8606 (not (eq gnus-build-sparse-threads 'some))
8607 (not (eq gnus-build-sparse-threads 'more))
8608 (null gnus-thread-expunge-below)
8609 (not gnus-use-nocem)))
8610 () ; Do nothing.
8611 (push gnus-newsgroup-limit gnus-newsgroup-limits)
8612 (setq gnus-newsgroup-limit nil)
8613 (mapatoms
8614 (lambda (node)
8615 (unless (car (symbol-value node))
8616 ;; These threads have no parents -- they are roots.
8617 (let ((nodes (cdr (symbol-value node)))
8618 thread)
8619 (while nodes
8620 (if (and gnus-thread-expunge-below
8621 (< (gnus-thread-total-score (car nodes))
8622 gnus-thread-expunge-below))
8623 (gnus-expunge-thread (pop nodes))
8624 (setq thread (pop nodes))
8625 (gnus-summary-limit-children thread))))))
8626 gnus-newsgroup-dependencies)
8627 ;; If this limitation resulted in an empty group, we might
8628 ;; pop the previous limit and use it instead.
8629 (when (and (not gnus-newsgroup-limit)
8630 show-if-empty)
8631 (setq gnus-newsgroup-limit (pop gnus-newsgroup-limits)))
8632 gnus-newsgroup-limit))
8633
8634(defun gnus-summary-limit-children (thread)
8635 "Return 1 if this subthread is visible and 0 if it is not."
8636 ;; First we get the number of visible children to this thread. This
8637 ;; is done by recursing down the thread using this function, so this
8638 ;; will really go down to a leaf article first, before slowly
8639 ;; working its way up towards the root.
8640 (when thread
04b61ae9 8641 (let* ((max-lisp-eval-depth (max 5000 max-lisp-eval-depth))
23f87bed 8642 (children
eec82323
LMI
8643 (if (cdr thread)
8644 (apply '+ (mapcar 'gnus-summary-limit-children
8645 (cdr thread)))
8646 0))
8647 (number (mail-header-number (car thread)))
8648 score)
8649 (if (and
8650 (not (memq number gnus-newsgroup-marked))
8651 (or
8652 ;; If this article is dormant and has absolutely no visible
8653 ;; children, then this article isn't visible.
8654 (and (memq number gnus-newsgroup-dormant)
8655 (zerop children))
8656 ;; If this is "fetch-old-headered" and there is no
8657 ;; visible children, then we don't want this article.
16409b0b
GM
8658 (and (or (eq gnus-fetch-old-headers 'some)
8659 (numberp gnus-fetch-old-headers))
eec82323
LMI
8660 (gnus-summary-article-ancient-p number)
8661 (zerop children))
6748645f
LMI
8662 ;; If this is "fetch-old-headered" and `invisible', then
8663 ;; we don't want this article.
8664 (and (eq gnus-fetch-old-headers 'invisible)
8665 (gnus-summary-article-ancient-p number))
eec82323
LMI
8666 ;; If this is a sparsely inserted article with no children,
8667 ;; we don't want it.
8668 (and (eq gnus-build-sparse-threads 'some)
8669 (gnus-summary-article-sparse-p number)
8670 (zerop children))
8671 ;; If we use expunging, and this article is really
8672 ;; low-scored, then we don't want this article.
8673 (when (and gnus-summary-expunge-below
8674 (< (setq score
8675 (or (cdr (assq number gnus-newsgroup-scored))
8676 gnus-summary-default-score))
8677 gnus-summary-expunge-below))
8678 ;; We increase the expunge-tally here, but that has
8679 ;; nothing to do with the limits, really.
8680 (incf gnus-newsgroup-expunged-tally)
8681 ;; We also mark as read here, if that's wanted.
8682 (when (and gnus-summary-mark-below
8683 (< score gnus-summary-mark-below))
8684 (setq gnus-newsgroup-unreads
8685 (delq number gnus-newsgroup-unreads))
8686 (if gnus-newsgroup-auto-expire
8687 (push number gnus-newsgroup-expirable)
8688 (push (cons number gnus-low-score-mark)
8689 gnus-newsgroup-reads)))
8690 t)
23f87bed
MB
8691 ;; Do the `display' group parameter.
8692 (and gnus-newsgroup-display
8693 (not (funcall gnus-newsgroup-display)))
eec82323 8694 ;; Check NoCeM things.
01c52d31
MB
8695 (when (and gnus-use-nocem
8696 (gnus-nocem-unwanted-article-p
8697 (mail-header-id (car thread))))
8698 (setq gnus-newsgroup-unreads
8699 (delq number gnus-newsgroup-unreads))
8700 t)))
eec82323
LMI
8701 ;; Nope, invisible article.
8702 0
8703 ;; Ok, this article is to be visible, so we add it to the limit
8704 ;; and return 1.
8705 (push number gnus-newsgroup-limit)
8706 1))))
8707
8708(defun gnus-expunge-thread (thread)
8709 "Mark all articles in THREAD as read."
8710 (let* ((number (mail-header-number (car thread))))
8711 (incf gnus-newsgroup-expunged-tally)
8712 ;; We also mark as read here, if that's wanted.
8713 (setq gnus-newsgroup-unreads
8714 (delq number gnus-newsgroup-unreads))
8715 (if gnus-newsgroup-auto-expire
8716 (push number gnus-newsgroup-expirable)
8717 (push (cons number gnus-low-score-mark)
8718 gnus-newsgroup-reads)))
8719 ;; Go recursively through all subthreads.
8720 (mapcar 'gnus-expunge-thread (cdr thread)))
8721
8722;; Summary article oriented commands
8723
8724(defun gnus-summary-refer-parent-article (n)
8725 "Refer parent article N times.
8726If N is negative, go to ancestor -N instead.
8727The difference between N and the number of articles fetched is returned."
8728 (interactive "p")
eec82323
LMI
8729 (let ((skip 1)
8730 error header ref)
8731 (when (not (natnump n))
8732 (setq skip (abs n)
8733 n 1))
8734 (while (and (> n 0)
8735 (not error))
8736 (setq header (gnus-summary-article-header))
8737 (if (and (eq (mail-header-number header)
8738 (cdr gnus-article-current))
8739 (equal gnus-newsgroup-name
8740 (car gnus-article-current)))
8741 ;; If we try to find the parent of the currently
8742 ;; displayed article, then we take a look at the actual
8743 ;; References header, since this is slightly more
8744 ;; reliable than the References field we got from the
8745 ;; server.
c7a91ce1 8746 (with-current-buffer gnus-original-article-buffer
eec82323
LMI
8747 (nnheader-narrow-to-headers)
8748 (unless (setq ref (message-fetch-field "references"))
23f87bed
MB
8749 (when (setq ref (message-fetch-field "in-reply-to"))
8750 (setq ref (gnus-extract-message-id-from-in-reply-to ref))))
eec82323
LMI
8751 (widen))
8752 (setq ref
8753 ;; It's not the current article, so we take a bet on
8754 ;; the value we got from the server.
8755 (mail-header-references header)))
8756 (if (and ref
8757 (not (equal ref "")))
8758 (unless (gnus-summary-refer-article (gnus-parent-id ref skip))
8759 (gnus-message 1 "Couldn't find parent"))
8760 (gnus-message 1 "No references in article %d"
8761 (gnus-summary-article-number))
8762 (setq error t))
8763 (decf n))
8764 (gnus-summary-position-point)
8765 n))
8766
8767(defun gnus-summary-refer-references ()
8768 "Fetch all articles mentioned in the References header.
6748645f 8769Return the number of articles fetched."
eec82323 8770 (interactive)
eec82323
LMI
8771 (let ((ref (mail-header-references (gnus-summary-article-header)))
8772 (current (gnus-summary-article-number))
8773 (n 0))
8774 (if (or (not ref)
8775 (equal ref ""))
8776 (error "No References in the current article")
8777 ;; For each Message-ID in the References header...
8778 (while (string-match "<[^>]*>" ref)
8779 (incf n)
8780 ;; ... fetch that article.
8781 (gnus-summary-refer-article
8782 (prog1 (match-string 0 ref)
8783 (setq ref (substring ref (match-end 0))))))
8784 (gnus-summary-goto-subject current)
8785 (gnus-summary-position-point)
8786 n)))
8787
6748645f
LMI
8788(defun gnus-summary-refer-thread (&optional limit)
8789 "Fetch all articles in the current thread.
8790If LIMIT (the numerical prefix), fetch that many old headers instead
8791of what's specified by the `gnus-refer-thread-limit' variable."
8792 (interactive "P")
8793 (let ((id (mail-header-id (gnus-summary-article-header)))
8794 (limit (if limit (prefix-numeric-value limit)
8795 gnus-refer-thread-limit)))
6748645f
LMI
8796 (unless (eq gnus-fetch-old-headers 'invisible)
8797 (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name)
8798 ;; Retrieve the headers and read them in.
23f87bed
MB
8799 (if (eq (if (numberp limit)
8800 (gnus-retrieve-headers
8801 (list (min
8802 (+ (mail-header-number
8803 (gnus-summary-article-header))
8804 limit)
8805 gnus-newsgroup-end))
8806 gnus-newsgroup-name (* limit 2))
8807 ;; gnus-refer-thread-limit is t, i.e. fetch _all_
8808 ;; headers.
8809 (gnus-retrieve-headers (list gnus-newsgroup-end)
8810 gnus-newsgroup-name limit))
6748645f
LMI
8811 'nov)
8812 (gnus-build-all-threads)
23f87bed 8813 (error "Can't fetch thread from back ends that don't support NOV"))
6748645f
LMI
8814 (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name))
8815 (gnus-summary-limit-include-thread id)))
8816
16409b0b
GM
8817(defun gnus-summary-refer-article (message-id)
8818 "Fetch an article specified by MESSAGE-ID."
8819 (interactive "sMessage-ID: ")
eec82323
LMI
8820 (when (and (stringp message-id)
8821 (not (zerop (length message-id))))
23f87bed 8822 (setq message-id (gnus-replace-in-string message-id " " ""))
eec82323
LMI
8823 ;; Construct the correct Message-ID if necessary.
8824 ;; Suggested by tale@pawl.rpi.edu.
8825 (unless (string-match "^<" message-id)
8826 (setq message-id (concat "<" message-id)))
8827 (unless (string-match ">$" message-id)
8828 (setq message-id (concat message-id ">")))
23f87bed
MB
8829 ;; People often post MIDs from URLs, so unhex it:
8830 (unless (string-match "@" message-id)
8831 (setq message-id (gnus-url-unhex-string message-id)))
eec82323
LMI
8832 (let* ((header (gnus-id-to-header message-id))
8833 (sparse (and header
8834 (gnus-summary-article-sparse-p
a8151ef7
LMI
8835 (mail-header-number header))
8836 (memq (mail-header-number header)
16409b0b
GM
8837 gnus-newsgroup-limit)))
8838 number)
6748645f
LMI
8839 (cond
8840 ;; If the article is present in the buffer we just go to it.
8841 ((and header
8842 (or (not (gnus-summary-article-sparse-p
8843 (mail-header-number header)))
8844 sparse))
8845 (prog1
8846 (gnus-summary-goto-article
8847 (mail-header-number header) nil t)
8848 (when sparse
8849 (gnus-summary-update-article (mail-header-number header)))))
8850 (t
16409b0b
GM
8851 ;; We fetch the article.
8852 (catch 'found
8853 (dolist (gnus-override-method (gnus-refer-article-methods))
23f87bed
MB
8854 (when (and (gnus-check-server gnus-override-method)
8855 ;; Fetch the header,
8856 (setq number (gnus-summary-insert-subject message-id)))
8857 ;; and display the article.
eec82323 8858 (gnus-summary-select-article nil nil nil number)
16409b0b
GM
8859 (throw 'found t)))
8860 (gnus-message 3 "Couldn't fetch article %s" message-id)))))))
8861
8862(defun gnus-refer-article-methods ()
8f688cb0 8863 "Return a list of referable methods."
16409b0b
GM
8864 (cond
8865 ;; No method, so we default to current and native.
8866 ((null gnus-refer-article-method)
8867 (list gnus-current-select-method gnus-select-method))
8868 ;; Current.
8869 ((eq 'current gnus-refer-article-method)
8870 (list gnus-current-select-method))
8871 ;; List of select methods.
d4dfaa19
DL
8872 ((not (and (symbolp (car gnus-refer-article-method))
8873 (assq (car gnus-refer-article-method) nnoo-definition-alist)))
16409b0b
GM
8874 (let (out)
8875 (dolist (method gnus-refer-article-method)
8876 (push (if (eq 'current method)
8877 gnus-current-select-method
8878 method)
8879 out))
8880 (nreverse out)))
8881 ;; One single select method.
8882 (t
8883 (list gnus-refer-article-method))))
6748645f
LMI
8884
8885(defun gnus-summary-edit-parameters ()
8886 "Edit the group parameters of the current group."
8887 (interactive)
8888 (gnus-group-edit-group gnus-newsgroup-name 'params))
eec82323 8889
16409b0b
GM
8890(defun gnus-summary-customize-parameters ()
8891 "Customize the group parameters of the current group."
8892 (interactive)
8893 (gnus-group-customize gnus-newsgroup-name))
8894
eec82323
LMI
8895(defun gnus-summary-enter-digest-group (&optional force)
8896 "Enter an nndoc group based on the current article.
8897If FORCE, force a digest interpretation. If not, try
8898to guess what the document format is."
8899 (interactive "P")
eec82323 8900 (let ((conf gnus-current-window-configuration))
23f87bed
MB
8901 (save-window-excursion
8902 (save-excursion
8903 (let (gnus-article-prepare-hook
8904 gnus-display-mime-function
8905 gnus-break-pages)
8906 (gnus-summary-select-article))))
eec82323
LMI
8907 (setq gnus-current-window-configuration conf)
8908 (let* ((name (format "%s-%d"
8909 (gnus-group-prefixed-name
8910 gnus-newsgroup-name (list 'nndoc ""))
01c52d31 8911 (with-current-buffer gnus-summary-buffer
eec82323
LMI
8912 gnus-current-article)))
8913 (ogroup gnus-newsgroup-name)
8914 (params (append (gnus-info-params (gnus-get-info ogroup))
8915 (list (cons 'to-group ogroup))
23f87bed 8916 (list (cons 'parent-group ogroup))
eec82323
LMI
8917 (list (cons 'save-article-group ogroup))))
8918 (case-fold-search t)
8919 (buf (current-buffer))
16409b0b 8920 dig to-address)
c7a91ce1 8921 (with-current-buffer gnus-original-article-buffer
16409b0b
GM
8922 ;; Have the digest group inherit the main mail address of
8923 ;; the parent article.
23f87bed
MB
8924 (when (setq to-address (or (gnus-fetch-field "reply-to")
8925 (gnus-fetch-field "from")))
343d6628
MB
8926 (setq params
8927 (append
8928 (list (cons 'to-address
8929 (funcall gnus-decode-encoded-address-function
8930 to-address))))))
eec82323
LMI
8931 (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*"))
8932 (insert-buffer-substring gnus-original-article-buffer)
8933 ;; Remove lines that may lead nndoc to misinterpret the
8934 ;; document type.
8935 (narrow-to-region
8936 (goto-char (point-min))
8937 (or (search-forward "\n\n" nil t) (point)))
8938 (goto-char (point-min))
16409b0b 8939 (delete-matching-lines "^Path:\\|^From ")
eec82323
LMI
8940 (widen))
8941 (unwind-protect
23f87bed 8942 (if (let ((gnus-newsgroup-ephemeral-charset gnus-newsgroup-charset)
16409b0b
GM
8943 (gnus-newsgroup-ephemeral-ignored-charsets
8944 gnus-newsgroup-ignored-charsets))
8945 (gnus-group-read-ephemeral-group
8946 name `(nndoc ,name (nndoc-address ,(get-buffer dig))
8947 (nndoc-article-type
23f87bed
MB
8948 ,(if force 'mbox 'guess)))
8949 t nil nil nil
8950 `((adapt-file . ,(gnus-score-file-name gnus-newsgroup-name
8951 "ADAPT")))))
16409b0b 8952 ;; Make all postings to this group go to the parent group.
23f87bed
MB
8953 (nconc (gnus-info-params (gnus-get-info name))
8954 params)
8955 ;; Couldn't select this doc group.
8956 (switch-to-buffer buf)
8957 (gnus-set-global-variables)
8958 (gnus-configure-windows 'summary)
8959 (gnus-message 3 "Article couldn't be entered?"))
eec82323
LMI
8960 (kill-buffer dig)))))
8961
8962(defun gnus-summary-read-document (n)
8963 "Open a new group based on the current article(s).
8964This will allow you to read digests and other similar
8965documents as newsgroups.
8966Obeys the standard process/prefix convention."
8967 (interactive "P")
01c52d31 8968 (let* ((ogroup gnus-newsgroup-name)
eec82323
LMI
8969 (params (append (gnus-info-params (gnus-get-info ogroup))
8970 (list (cons 'to-group ogroup))))
01c52d31
MB
8971 group egroup groups vgroup)
8972 (dolist (article (gnus-summary-work-articles n))
eec82323
LMI
8973 (setq group (format "%s-%d" gnus-newsgroup-name article))
8974 (gnus-summary-remove-process-mark article)
8975 (when (gnus-summary-display-article article)
8976 (save-excursion
16409b0b 8977 (with-temp-buffer
eec82323
LMI
8978 (insert-buffer-substring gnus-original-article-buffer)
8979 ;; Remove some headers that may lead nndoc to make
8980 ;; the wrong guess.
8981 (message-narrow-to-head)
8982 (goto-char (point-min))
01c52d31 8983 (delete-matching-lines "^Path:\\|^From ")
eec82323
LMI
8984 (widen)
8985 (if (setq egroup
8986 (gnus-group-read-ephemeral-group
8987 group `(nndoc ,group (nndoc-address ,(current-buffer))
8988 (nndoc-article-type guess))
8989 t nil t))
8990 (progn
c7a91ce1 8991 ;; Make all postings to this group go to the parent group.
eec82323
LMI
8992 (nconc (gnus-info-params (gnus-get-info egroup))
8993 params)
8994 (push egroup groups))
8995 ;; Couldn't select this doc group.
8996 (gnus-error 3 "Article couldn't be entered"))))))
8997 ;; Now we have selected all the documents.
8998 (cond
8999 ((not groups)
9000 (error "None of the articles could be interpreted as documents"))
9001 ((gnus-group-read-ephemeral-group
9002 (setq vgroup (format
9003 "nnvirtual:%s-%s" gnus-newsgroup-name
9004 (format-time-string "%Y%m%dT%H%M%S" (current-time))))
9005 `(nnvirtual ,vgroup (nnvirtual-component-groups ,groups))
9006 t
9007 (cons (current-buffer) 'summary)))
9008 (t
9009 (error "Couldn't select virtual nndoc group")))))
9010
9011(defun gnus-summary-isearch-article (&optional regexp-p)
9012 "Do incremental search forward on the current article.
9013If REGEXP-P (the prefix) is non-nil, do regexp isearch."
9014 (interactive "P")
eec82323
LMI
9015 (gnus-summary-select-article)
9016 (gnus-configure-windows 'article)
9017 (gnus-eval-in-buffer-window gnus-article-buffer
6748645f
LMI
9018 (save-restriction
9019 (widen)
9020 (isearch-forward regexp-p))))
eec82323 9021
01c52d31
MB
9022(defun gnus-summary-repeat-search-article-forward ()
9023 "Repeat the previous search forwards."
9024 (interactive)
9025 (unless gnus-last-search-regexp
9026 (error "No previous search"))
9027 (gnus-summary-search-article-forward gnus-last-search-regexp))
9028
9029(defun gnus-summary-repeat-search-article-backward ()
9030 "Repeat the previous search backwards."
9031 (interactive)
9032 (unless gnus-last-search-regexp
9033 (error "No previous search"))
9034 (gnus-summary-search-article-forward gnus-last-search-regexp t))
9035
eec82323
LMI
9036(defun gnus-summary-search-article-forward (regexp &optional backward)
9037 "Search for an article containing REGEXP forward.
9038If BACKWARD, search backward instead."
9039 (interactive
9040 (list (read-string
9041 (format "Search article %s (regexp%s): "
9042 (if current-prefix-arg "backward" "forward")
9043 (if gnus-last-search-regexp
9044 (concat ", default " gnus-last-search-regexp)
9045 "")))
9046 current-prefix-arg))
eec82323
LMI
9047 (if (string-equal regexp "")
9048 (setq regexp (or gnus-last-search-regexp ""))
23f87bed
MB
9049 (setq gnus-last-search-regexp regexp)
9050 (setq gnus-article-before-search gnus-current-article))
9051 ;; Intentionally set gnus-last-article.
9052 (setq gnus-last-article gnus-article-before-search)
9053 (let ((gnus-last-article gnus-last-article))
9054 (if (gnus-summary-search-article regexp backward)
9055 (gnus-summary-show-thread)
abc40aab 9056 (signal 'search-failed (list regexp)))))
eec82323
LMI
9057
9058(defun gnus-summary-search-article-backward (regexp)
9059 "Search for an article containing REGEXP backward."
9060 (interactive
9061 (list (read-string
9062 (format "Search article backward (regexp%s): "
9063 (if gnus-last-search-regexp
9064 (concat ", default " gnus-last-search-regexp)
9065 "")))))
9066 (gnus-summary-search-article-forward regexp 'backward))
9067
9068(defun gnus-summary-search-article (regexp &optional backward)
9069 "Search for an article containing REGEXP.
9070Optional argument BACKWARD means do search for backward.
9071`gnus-select-article-hook' is not called during the search."
a8151ef7
LMI
9072 ;; We have to require this here to make sure that the following
9073 ;; dynamic binding isn't shadowed by autoloading.
9074 (require 'gnus-async)
16409b0b 9075 (require 'gnus-art)
eec82323 9076 (let ((gnus-select-article-hook nil) ;Disable hook.
16409b0b 9077 (gnus-article-prepare-hook nil)
eec82323
LMI
9078 (gnus-mark-article-hook nil) ;Inhibit marking as read.
9079 (gnus-use-article-prefetch nil)
9080 (gnus-xmas-force-redisplay nil) ;Inhibit XEmacs redisplay.
a8151ef7 9081 (gnus-use-trees nil) ;Inhibit updating tree buffer.
23f87bed
MB
9082 (gnus-visual nil)
9083 (gnus-keep-backlog nil)
9084 (gnus-break-pages nil)
9085 (gnus-summary-display-arrow nil)
9086 (gnus-updated-mode-lines nil)
9087 (gnus-auto-center-summary nil)
eec82323 9088 (sum (current-buffer))
16409b0b 9089 (gnus-display-mime-function nil)
eec82323
LMI
9090 (found nil)
9091 point)
9092 (gnus-save-hidden-threads
9093 (gnus-summary-select-article)
9094 (set-buffer gnus-article-buffer)
16409b0b 9095 (goto-char (window-point (get-buffer-window (current-buffer))))
eec82323
LMI
9096 (when backward
9097 (forward-line -1))
9098 (while (not found)
9099 (gnus-message 7 "Searching article: %d..." (cdr gnus-article-current))
9100 (if (if backward
9101 (re-search-backward regexp nil t)
9102 (re-search-forward regexp nil t))
9103 ;; We found the regexp.
9104 (progn
9105 (setq found 'found)
9106 (beginning-of-line)
9107 (set-window-start
9108 (get-buffer-window (current-buffer))
9109 (point))
9110 (forward-line 1)
16409b0b
GM
9111 (set-window-point
9112 (get-buffer-window (current-buffer))
9113 (point))
eec82323
LMI
9114 (set-buffer sum)
9115 (setq point (point)))
9116 ;; We didn't find it, so we go to the next article.
9117 (set-buffer sum)
9118 (setq found 'not)
9119 (while (eq found 'not)
9120 (if (not (if backward (gnus-summary-find-prev)
9121 (gnus-summary-find-next)))
9122 ;; No more articles.
9123 (setq found t)
9124 ;; Select the next article and adjust point.
9125 (unless (gnus-summary-article-sparse-p
9126 (gnus-summary-article-number))
9127 (setq found nil)
9128 (gnus-summary-select-article)
9129 (set-buffer gnus-article-buffer)
9130 (widen)
9131 (goto-char (if backward (point-max) (point-min))))))))
9132 (gnus-message 7 ""))
9133 ;; Return whether we found the regexp.
9134 (when (eq found 'found)
9135 (goto-char point)
9136 (gnus-summary-show-thread)
9137 (gnus-summary-goto-subject gnus-current-article)
9138 (gnus-summary-position-point)
9139 t)))
9140
23f87bed
MB
9141(defun gnus-find-matching-articles (header regexp)
9142 "Return a list of all articles that match REGEXP on HEADER.
9143This search includes all articles in the current group that Gnus has
9144fetched headers for, whether they are displayed or not."
9145 (let ((articles nil)
c7a91ce1 9146 ;; Can't eta-reduce because it's a macro.
23f87bed
MB
9147 (func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))
9148 (case-fold-search t))
9149 (dolist (header gnus-newsgroup-headers)
9150 (when (string-match regexp (funcall func header))
9151 (push (mail-header-number header) articles)))
9152 (nreverse articles)))
9153
eec82323 9154(defun gnus-summary-find-matching (header regexp &optional backward unread
47b63dfa 9155 not-case-fold not-matching)
eec82323
LMI
9156 "Return a list of all articles that match REGEXP on HEADER.
9157The search stars on the current article and goes forwards unless
9158BACKWARD is non-nil. If BACKWARD is `all', do all articles.
9159If UNREAD is non-nil, only unread articles will
9160be taken into consideration. If NOT-CASE-FOLD, case won't be folded
a1506d29 9161in the comparisons. If NOT-MATCHING, return a list of all articles that
47b63dfa
SZ
9162not match REGEXP on HEADER."
9163 (let ((case-fold-search (not not-case-fold))
16409b0b
GM
9164 articles d func)
9165 (if (consp header)
9166 (if (eq (car header) 'extra)
9167 (setq func
9168 `(lambda (h)
9169 (or (cdr (assq ',(cdr header) (mail-header-extra h)))
9170 "")))
9171 (error "%s is an invalid header" header))
9172 (unless (fboundp (intern (concat "mail-header-" header)))
9173 (error "%s is not a valid header" header))
9174 (setq func `(lambda (h) (,(intern (concat "mail-header-" header)) h))))
47b63dfa
SZ
9175 (dolist (d (if (eq backward 'all)
9176 gnus-newsgroup-data
9177 (gnus-data-find-list
9178 (gnus-summary-article-number)
9179 (gnus-data-list backward))))
9180 (when (and (or (not unread) ; We want all articles...
9181 (gnus-data-unread-p d)) ; Or just unreads.
9182 (vectorp (gnus-data-header d)) ; It's not a pseudo.
9183 (if not-matching
a1506d29 9184 (not (string-match
47b63dfa
SZ
9185 regexp
9186 (funcall func (gnus-data-header d))))
9187 (string-match regexp
9188 (funcall func (gnus-data-header d)))))
9189 (push (gnus-data-number d) articles))) ; Success!
eec82323
LMI
9190 (nreverse articles)))
9191
9192(defun gnus-summary-execute-command (header regexp command &optional backward)
9193 "Search forward for an article whose HEADER matches REGEXP and execute COMMAND.
9194If HEADER is an empty string (or nil), the match is done on the entire
9195article. If BACKWARD (the prefix) is non-nil, search backward instead."
9196 (interactive
9197 (list (let ((completion-ignore-case t))
9198 (completing-read
9199 "Header name: "
23f87bed
MB
9200 (mapcar (lambda (header) (list (format "%s" header)))
9201 (append
9202 '("Number" "Subject" "From" "Lines" "Date"
9203 "Message-ID" "Xref" "References" "Body")
9204 gnus-extra-headers))
eec82323
LMI
9205 nil 'require-match))
9206 (read-string "Regexp: ")
9207 (read-key-sequence "Command: ")
9208 current-prefix-arg))
9209 (when (equal header "Body")
9210 (setq header ""))
eec82323
LMI
9211 ;; Hidden thread subtrees must be searched as well.
9212 (gnus-summary-show-all-threads)
9213 ;; We don't want to change current point nor window configuration.
9214 (save-excursion
9215 (save-window-excursion
23f87bed
MB
9216 (let (gnus-visual
9217 gnus-treat-strip-trailing-blank-lines
9218 gnus-treat-strip-leading-blank-lines
9219 gnus-treat-strip-multiple-blank-lines
9220 gnus-treat-hide-boring-headers
9221 gnus-treat-fold-newsgroups
9222 gnus-article-prepare-hook)
9223 (gnus-message 6 "Executing %s..." (key-description command))
9224 ;; We'd like to execute COMMAND interactively so as to give arguments.
9225 (gnus-execute header regexp
9226 `(call-interactively ',(key-binding command))
9227 backward)
9228 (gnus-message 6 "Executing %s...done" (key-description command))))))
eec82323
LMI
9229
9230(defun gnus-summary-beginning-of-article ()
9231 "Scroll the article back to the beginning."
9232 (interactive)
eec82323
LMI
9233 (gnus-summary-select-article)
9234 (gnus-configure-windows 'article)
9235 (gnus-eval-in-buffer-window gnus-article-buffer
9236 (widen)
9237 (goto-char (point-min))
23f87bed 9238 (when gnus-break-pages
eec82323
LMI
9239 (gnus-narrow-to-page))))
9240
9241(defun gnus-summary-end-of-article ()
9242 "Scroll to the end of the article."
9243 (interactive)
eec82323
LMI
9244 (gnus-summary-select-article)
9245 (gnus-configure-windows 'article)
9246 (gnus-eval-in-buffer-window gnus-article-buffer
9247 (widen)
9248 (goto-char (point-max))
9249 (recenter -3)
23f87bed 9250 (when gnus-break-pages
eec82323
LMI
9251 (gnus-narrow-to-page))))
9252
23f87bed
MB
9253(defun gnus-summary-print-truncate-and-quote (string &optional len)
9254 "Truncate to LEN and quote all \"(\"'s in STRING."
9255 (gnus-replace-in-string (if (and len (> (length string) len))
9256 (substring string 0 len)
9257 string)
9258 "[()]" "\\\\\\&"))
9259
6748645f 9260(defun gnus-summary-print-article (&optional filename n)
23f87bed
MB
9261 "Generate and print a PostScript image of the process-marked (mail) articles.
9262
9263If used interactively, print the current article if none are
9264process-marked. With prefix arg, prompt the user for the name of the
9265file to save in.
6748645f 9266
23f87bed
MB
9267When used from Lisp, accept two optional args FILENAME and N. N means
9268to print the next N articles. If N is negative, print the N previous
9269articles. If N is nil and articles have been marked with the process
9270mark, print these instead.
eec82323 9271
16409b0b 9272If the optional first argument FILENAME is nil, send the image to the
6748645f
LMI
9273printer. If FILENAME is a string, save the PostScript image in a file with
9274that name. If FILENAME is a number, prompt the user for the name of the file
eec82323 9275to save in."
676a7cc9 9276 (interactive (list (ps-print-preprint current-prefix-arg)))
6748645f
LMI
9277 (dolist (article (gnus-summary-work-articles n))
9278 (gnus-summary-select-article nil nil 'pseudo article)
9279 (gnus-eval-in-buffer-window gnus-article-buffer
23f87bed 9280 (gnus-print-buffer))
676a7cc9
SZ
9281 (gnus-summary-remove-process-mark article))
9282 (ps-despool filename))
eec82323 9283
23f87bed
MB
9284(defun gnus-print-buffer ()
9285 (let ((buffer (generate-new-buffer " *print*")))
9286 (unwind-protect
9287 (progn
9288 (copy-to-buffer buffer (point-min) (point-max))
9289 (set-buffer buffer)
9290 (gnus-remove-text-with-property 'gnus-decoration)
9291 (when (gnus-visual-p 'article-highlight 'highlight)
9292 ;; Copy-to-buffer doesn't copy overlay. So redo
9293 ;; highlight.
9294 (let ((gnus-article-buffer buffer))
9295 (gnus-article-highlight-citation t)
9296 (gnus-article-highlight-signature)
9297 (gnus-article-emphasize)
9298 (gnus-article-delete-invisible-text)))
9299 (let ((ps-left-header
9300 (list
9301 (concat "("
9302 (gnus-summary-print-truncate-and-quote
9303 (mail-header-subject gnus-current-headers)
9304 66) ")")
9305 (concat "("
9306 (gnus-summary-print-truncate-and-quote
9307 (mail-header-from gnus-current-headers)
9308 45) ")")))
9309 (ps-right-header
9310 (list
9311 "/pagenumberstring load"
9312 (concat "("
9313 (mail-header-date gnus-current-headers) ")"))))
9314 (gnus-run-hooks 'gnus-ps-print-hook)
9315 (save-excursion
a7b50e1c 9316 (if ps-print-color-p
23f87bed
MB
9317 (ps-spool-buffer-with-faces)
9318 (ps-spool-buffer)))))
9319 (kill-buffer buffer))))
9320
eec82323 9321(defun gnus-summary-show-article (&optional arg)
23f87bed 9322 "Force redisplaying of the current article.
16409b0b
GM
9323If ARG (the prefix) is a number, show the article with the charset
9324defined in `gnus-summary-show-article-charset-alist', or the charset
23f87bed 9325input.
16409b0b 9326If ARG (the prefix) is non-nil and not a number, show the raw article
23f87bed
MB
9327without any article massaging functions being run. Normally, the key
9328strokes are `C-u g'."
eec82323 9329 (interactive "P")
16409b0b
GM
9330 (cond
9331 ((numberp arg)
23f87bed 9332 (gnus-summary-show-article t)
16409b0b
GM
9333 (let ((gnus-newsgroup-charset
9334 (or (cdr (assq arg gnus-summary-show-article-charset-alist))
23f87bed
MB
9335 (mm-read-coding-system
9336 "View as charset: " ;; actually it is coding system.
01c52d31 9337 (with-current-buffer gnus-article-buffer
23f87bed 9338 (mm-detect-coding-region (point) (point-max))))))
16409b0b 9339 (gnus-newsgroup-ignored-charsets 'gnus-all))
23f87bed
MB
9340 (gnus-summary-select-article nil 'force)
9341 (let ((deps gnus-newsgroup-dependencies)
9342 head header lines)
c7a91ce1 9343 (with-current-buffer gnus-original-article-buffer
23f87bed
MB
9344 (save-restriction
9345 (message-narrow-to-head)
9346 (setq head (buffer-string))
9347 (goto-char (point-min))
9348 (unless (re-search-forward "^lines:[ \t]\\([0-9]+\\)" nil t)
9349 (goto-char (point-max))
9350 (widen)
9351 (setq lines (1- (count-lines (point) (point-max))))))
9352 (with-temp-buffer
9353 (insert (format "211 %d Article retrieved.\n"
9354 (cdr gnus-article-current)))
9355 (insert head)
9356 (if lines (insert (format "Lines: %d\n" lines)))
9357 (insert ".\n")
9358 (let ((nntp-server-buffer (current-buffer)))
9359 (setq header (car (gnus-get-newsgroup-headers deps t))))))
9360 (gnus-data-set-header
9361 (gnus-data-find (cdr gnus-article-current))
9362 header)
9363 (gnus-summary-update-article-line
9364 (cdr gnus-article-current) header)
9365 (when (gnus-summary-goto-subject (cdr gnus-article-current) nil t)
9366 (gnus-summary-update-secondary-mark (cdr gnus-article-current))))))
16409b0b
GM
9367 ((not arg)
9368 ;; Select the article the normal way.
9369 (gnus-summary-select-article nil 'force))
9370 (t
9371 ;; We have to require this here to make sure that the following
9372 ;; dynamic binding isn't shadowed by autoloading.
9373 (require 'gnus-async)
9374 (require 'gnus-art)
eec82323
LMI
9375 ;; Bind the article treatment functions to nil.
9376 (let ((gnus-have-all-headers t)
eec82323 9377 gnus-article-prepare-hook
16409b0b
GM
9378 gnus-article-decode-hook
9379 gnus-display-mime-function
9380 gnus-break-pages)
9381 ;; Destroy any MIME parts.
9382 (when (gnus-buffer-live-p gnus-article-buffer)
c7a91ce1 9383 (with-current-buffer gnus-article-buffer
16409b0b
GM
9384 (mm-destroy-parts gnus-article-mime-handles)
9385 ;; Set it to nil for safety reason.
9386 (setq gnus-article-mime-handle-alist nil)
9387 (setq gnus-article-mime-handles nil)))
9388 (gnus-summary-select-article nil 'force))))
eec82323
LMI
9389 (gnus-summary-goto-subject gnus-current-article)
9390 (gnus-summary-position-point))
9391
23f87bed
MB
9392(defun gnus-summary-show-raw-article ()
9393 "Show the raw article without any article massaging functions being run."
9394 (interactive)
9395 (gnus-summary-show-article t))
9396
eec82323
LMI
9397(defun gnus-summary-verbose-headers (&optional arg)
9398 "Toggle permanent full header display.
9399If ARG is a positive number, turn header display on.
9400If ARG is a negative number, turn header display off."
9401 (interactive "P")
eec82323
LMI
9402 (setq gnus-show-all-headers
9403 (cond ((or (not (numberp arg))
9404 (zerop arg))
9405 (not gnus-show-all-headers))
9406 ((natnump arg)
9407 t)))
9408 (gnus-summary-show-article))
9409
9410(defun gnus-summary-toggle-header (&optional arg)
9411 "Show the headers if they are hidden, or hide them if they are shown.
9412If ARG is a positive number, show the entire header.
9413If ARG is a negative number, hide the unwanted header lines."
9414 (interactive "P")
23f87bed
MB
9415 (let ((window (and (gnus-buffer-live-p gnus-article-buffer)
9416 (get-buffer-window gnus-article-buffer t))))
9417 (with-current-buffer gnus-article-buffer
9418 (widen)
9419 (article-narrow-to-head)
c7a91ce1 9420 (let* ((inhibit-read-only t)
16409b0b 9421 (inhibit-point-motion-hooks t)
23f87bed
MB
9422 (hidden (if (numberp arg)
9423 (>= arg 0)
f0096211
MB
9424 (or (not (looking-at "[^ \t\n]+:"))
9425 (gnus-article-hidden-text-p 'headers))))
23f87bed
MB
9426 s e)
9427 (delete-region (point-min) (point-max))
667e0ba6
SM
9428 (with-current-buffer gnus-original-article-buffer
9429 (goto-char (setq s (point-min)))
23f87bed
MB
9430 (setq e (if (search-forward "\n\n" nil t)
9431 (1- (point))
9432 (point-max))))
667e0ba6 9433 (insert-buffer-substring gnus-original-article-buffer s e)
23f87bed
MB
9434 (run-hooks 'gnus-article-decode-hook)
9435 (if hidden
9436 (let ((gnus-treat-hide-headers nil)
9437 (gnus-treat-hide-boring-headers nil))
9438 (gnus-delete-wash-type 'headers)
9439 (gnus-treat-article 'head))
9440 (gnus-treat-article 'head))
9441 (widen)
9442 (if window
9443 (set-window-start window (goto-char (point-min))))
9444 (if gnus-break-pages
9445 (gnus-narrow-to-page)
9446 (when (gnus-visual-p 'page-marker)
c7a91ce1 9447 (let ((inhibit-read-only t))
23f87bed
MB
9448 (gnus-remove-text-with-property 'gnus-prev)
9449 (gnus-remove-text-with-property 'gnus-next))))
16409b0b 9450 (gnus-set-mode-line 'article)))))
eec82323
LMI
9451
9452(defun gnus-summary-show-all-headers ()
9453 "Make all header lines visible."
9454 (interactive)
23f87bed 9455 (gnus-summary-toggle-header 1))
eec82323 9456
eec82323
LMI
9457(defun gnus-summary-caesar-message (&optional arg)
9458 "Caesar rotate the current article by 13.
01c52d31
MB
9459With a non-numerical prefix, also rotate headers. A numerical
9460prefix specifies how many places to rotate each letter forward."
eec82323 9461 (interactive "P")
eec82323
LMI
9462 (gnus-summary-select-article)
9463 (let ((mail-header-separator ""))
9464 (gnus-eval-in-buffer-window gnus-article-buffer
9465 (save-restriction
9466 (widen)
9467 (let ((start (window-start))
c7a91ce1 9468 (inhibit-read-only t))
01c52d31
MB
9469 (if (equal arg '(4))
9470 (message-caesar-buffer-body nil t)
9471 (message-caesar-buffer-body arg))
ff4d3926
MB
9472 (set-window-start (get-buffer-window (current-buffer)) start)))))
9473 ;; Create buttons and stuff...
9474 (gnus-treat-article nil))
eec82323 9475
704f1663
GM
9476(declare-function idna-to-unicode "ext:idna" (str))
9477
01c52d31
MB
9478(defun gnus-summary-idna-message (&optional arg)
9479 "Decode IDNA encoded domain names in the current articles.
9480IDNA encoded domain names looks like `xn--bar'. If a string
9481remain unencoded after running this function, it is likely an
9482invalid IDNA string (`xn--bar' is invalid).
9483
9484You must have GNU Libidn (`http://www.gnu.org/software/libidn/')
9485installed for this command to work."
9486 (interactive "P")
9487 (if (not (and (condition-case nil (require 'idna)
9488 (file-error))
9489 (mm-coding-system-p 'utf-8)
9490 (executable-find (symbol-value 'idna-program))))
9491 (gnus-message
9492 5 "GNU Libidn not installed properly (`idn' or `idna.el' missing)")
9493 (gnus-summary-select-article)
9494 (let ((mail-header-separator ""))
9495 (gnus-eval-in-buffer-window gnus-article-buffer
9496 (save-restriction
9497 (widen)
9498 (let ((start (window-start))
9499 buffer-read-only)
9500 (while (re-search-forward "\\(xn--[-0-9a-z]+\\)" nil t)
9501 (replace-match (idna-to-unicode (match-string 1))))
9502 (set-window-start (get-buffer-window (current-buffer)) start)))))))
23f87bed
MB
9503
9504(defun gnus-summary-morse-message (&optional arg)
9505 "Morse decode the current article."
9506 (interactive "P")
9507 (gnus-summary-select-article)
9508 (let ((mail-header-separator ""))
9509 (gnus-eval-in-buffer-window gnus-article-buffer
9510 (save-excursion
9511 (save-restriction
9512 (widen)
9513 (let ((pos (window-start))
c7a91ce1 9514 (inhibit-read-only t))
23f87bed
MB
9515 (goto-char (point-min))
9516 (when (message-goto-body)
9517 (gnus-narrow-to-body))
9518 (goto-char (point-min))
01c52d31 9519