comparison lisp/gnus/gnus-sum.el @ 88155:d7ddb3e565de

sync with trunk
author Henrik Enberg <henrik.enberg@telia.com>
date Mon, 16 Jan 2006 00:03:54 +0000
parents 0d8b17d428b5
children
comparison
equal deleted inserted replaced
88154:8ce476d3ba36 88155:d7ddb3e565de
1 ;;; gnus-sum.el --- summary mode commands for Gnus 1 ;;; gnus-sum.el --- summary mode commands for Gnus
2 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 2
3 ;; Free Software Foundation, Inc. 3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 ;; 2005 Free Software Foundation, Inc.
4 5
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> 6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
6 ;; Keywords: news 7 ;; Keywords: news
7 8
8 ;; This file is part of GNU Emacs. 9 ;; This file is part of GNU Emacs.
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details. 19 ;; GNU General Public License for more details.
19 20
20 ;; You should have received a copy of the GNU General Public License 21 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the 22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02111-1307, USA. 24 ;; Boston, MA 02110-1301, USA.
24 25
25 ;;; Commentary: 26 ;;; Commentary:
26 27
27 ;;; Code: 28 ;;; Code:
28 29
29 (eval-when-compile (require 'cl)) 30 (eval-when-compile
31 (require 'cl)
32 (defvar tool-bar-map))
30 33
31 (require 'gnus) 34 (require 'gnus)
32 (require 'gnus-group) 35 (require 'gnus-group)
33 (require 'gnus-spec) 36 (require 'gnus-spec)
34 (require 'gnus-range) 37 (require 'gnus-range)
35 (require 'gnus-int) 38 (require 'gnus-int)
36 (require 'gnus-undo) 39 (require 'gnus-undo)
37 (require 'gnus-util) 40 (require 'gnus-util)
38 (require 'mm-decode) 41 (require 'mm-decode)
39 ;; Recursive :-(.
40 ;; (require 'gnus-art)
41 (require 'nnoo) 42 (require 'nnoo)
43
42 (autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t) 44 (autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t)
43 (autoload 'gnus-cache-write-active "gnus-cache") 45 (autoload 'gnus-cache-write-active "gnus-cache")
46 (autoload 'gnus-mailing-list-insinuate "gnus-ml" nil t)
47 (autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" nil t)
48 (autoload 'gnus-pick-line-number "gnus-salt" nil t)
44 (autoload 'mm-uu-dissect "mm-uu") 49 (autoload 'mm-uu-dissect "mm-uu")
50 (autoload 'gnus-article-outlook-deuglify-article "deuglify"
51 "Deuglify broken Outlook (Express) articles and redisplay."
52 t)
53 (autoload 'gnus-article-outlook-unwrap-lines "deuglify" nil t)
54 (autoload 'gnus-article-outlook-repair-attribution "deuglify" nil t)
55 (autoload 'gnus-article-outlook-rearrange-citation "deuglify" nil t)
45 56
46 (defcustom gnus-kill-summary-on-exit t 57 (defcustom gnus-kill-summary-on-exit t
47 "*If non-nil, kill the summary buffer when you exit from it. 58 "*If non-nil, kill the summary buffer when you exit from it.
48 If nil, the summary will become a \"*Dead Summary*\" buffer, and 59 If nil, the summary will become a \"*Dead Summary*\" buffer, and
49 it will be killed sometime later." 60 it will be killed sometime later."
52 63
53 (defcustom gnus-fetch-old-headers nil 64 (defcustom gnus-fetch-old-headers nil
54 "*Non-nil means that Gnus will try to build threads by grabbing old headers. 65 "*Non-nil means that Gnus will try to build threads by grabbing old headers.
55 If an unread article in the group refers to an older, already read (or 66 If an unread article in the group refers to an older, already read (or
56 just marked as read) article, the old article will not normally be 67 just marked as read) article, the old article will not normally be
57 displayed in the Summary buffer. If this variable is non-nil, Gnus 68 displayed in the Summary buffer. If this variable is t, Gnus
58 will attempt to grab the headers to the old articles, and thereby 69 will attempt to grab the headers to the old articles, and thereby
59 build complete threads. If it has the value `some', only enough 70 build complete threads. If it has the value `some', only enough
60 headers to connect otherwise loose threads will be displayed. This 71 headers to connect otherwise loose threads will be displayed. This
61 variable can also be a number. In that case, no more than that number 72 variable can also be a number. In that case, no more than that number
62 of old headers will be fetched. If it has the value `invisible', all 73 of old headers will be fetched. If it has the value `invisible', all
63 old headers will be fetched, but none will be displayed. 74 old headers will be fetched, but none will be displayed.
64 75
65 The server has to support NOV for any of this to work." 76 The server has to support NOV for any of this to work."
66 :group 'gnus-thread 77 :group 'gnus-thread
67 :type '(choice (const :tag "off" nil) 78 :type '(choice (const :tag "off" nil)
79 (const :tag "on" t)
68 (const some) 80 (const some)
81 (const invisible)
69 number 82 number
70 (sexp :menu-tag "other" t))) 83 (sexp :menu-tag "other" t)))
71 84
72 (defcustom gnus-refer-thread-limit 200 85 (defcustom gnus-refer-thread-limit 200
73 "*The number of old headers to fetch when doing \\<gnus-summary-mode-map>\\[gnus-summary-refer-thread]. 86 "*The number of old headers to fetch when doing \\<gnus-summary-mode-map>\\[gnus-summary-refer-thread].
103 (const none) 116 (const none)
104 (const dummy) 117 (const dummy)
105 (const adopt) 118 (const adopt)
106 (const empty))) 119 (const empty)))
107 120
121 (defcustom gnus-summary-make-false-root-always nil
122 "Always make a false dummy root."
123 :version "22.1"
124 :group 'gnus-thread
125 :type 'boolean)
126
108 (defcustom gnus-summary-gather-exclude-subject "^ *$\\|^(none)$" 127 (defcustom gnus-summary-gather-exclude-subject "^ *$\\|^(none)$"
109 "*A regexp to match subjects to be excluded from loose thread gathering. 128 "*A regexp to match subjects to be excluded from loose thread gathering.
110 As loose thread gathering is done on subjects only, that means that 129 As loose thread gathering is done on subjects only, that means that
111 there can be many false gatherings performed. By rooting out certain 130 there can be many false gatherings performed. By rooting out certain
112 common subjects, gathering might become saner." 131 common subjects, gathering might become saner."
130 149
131 (defcustom gnus-simplify-subject-functions nil 150 (defcustom gnus-simplify-subject-functions nil
132 "List of functions taking a string argument that simplify subjects. 151 "List of functions taking a string argument that simplify subjects.
133 The functions are applied recursively. 152 The functions are applied recursively.
134 153
135 Useful functions to put in this list include: `gnus-simplify-subject-re', 154 Useful functions to put in this list include:
136 `gnus-simplify-subject-fuzzy' and `gnus-simplify-whitespace'." 155 `gnus-simplify-subject-re', `gnus-simplify-subject-fuzzy',
156 `gnus-simplify-whitespace', and `gnus-simplify-all-whitespace'."
137 :group 'gnus-thread 157 :group 'gnus-thread
138 :type '(repeat function)) 158 :type '(repeat function))
139 159
140 (defcustom gnus-simplify-ignored-prefixes nil 160 (defcustom gnus-simplify-ignored-prefixes nil
141 "*Regexp, matches for which are removed from subject lines when simplifying fuzzily." 161 "*Remove matches for this regexp from subject lines when simplifying fuzzily."
142 :group 'gnus-thread 162 :group 'gnus-thread
143 :type '(choice (const :tag "off" nil) 163 :type '(choice (const :tag "off" nil)
144 regexp)) 164 regexp))
145 165
146 (defcustom gnus-build-sparse-threads nil 166 (defcustom gnus-build-sparse-threads nil
195 If this variable is nil, scoring will be disabled." 215 If this variable is nil, scoring will be disabled."
196 :group 'gnus-score-default 216 :group 'gnus-score-default
197 :type '(choice (const :tag "disable") 217 :type '(choice (const :tag "disable")
198 integer)) 218 integer))
199 219
220 (defcustom gnus-summary-default-high-score 0
221 "*Default threshold for a high scored article.
222 An article will be highlighted as high scored if its score is greater
223 than this score."
224 :version "22.1"
225 :group 'gnus-score-default
226 :type 'integer)
227
228 (defcustom gnus-summary-default-low-score 0
229 "*Default threshold for a low scored article.
230 An article will be highlighted as low scored if its score is smaller
231 than this score."
232 :version "22.1"
233 :group 'gnus-score-default
234 :type 'integer)
235
200 (defcustom gnus-summary-zcore-fuzz 0 236 (defcustom gnus-summary-zcore-fuzz 0
201 "*Fuzziness factor for the zcore in the summary buffer. 237 "*Fuzziness factor for the zcore in the summary buffer.
202 Articles with scores closer than this to `gnus-summary-default-score' 238 Articles with scores closer than this to `gnus-summary-default-score'
203 will not be marked." 239 will not be marked."
204 :group 'gnus-summary-format 240 :group 'gnus-summary-format
217 :group 'gnus-thread 253 :group 'gnus-thread
218 :type 'boolean) 254 :type 'boolean)
219 255
220 (defcustom gnus-thread-hide-subtree nil 256 (defcustom gnus-thread-hide-subtree nil
221 "*If non-nil, hide all threads initially. 257 "*If non-nil, hide all threads initially.
258 This can be a predicate specifier which says which threads to hide.
222 If threads are hidden, you have to run the command 259 If threads are hidden, you have to run the command
223 `gnus-summary-show-thread' by hand or use `gnus-select-article-hook' 260 `gnus-summary-show-thread' by hand or select an article."
224 to expose hidden threads."
225 :group 'gnus-thread 261 :group 'gnus-thread
226 :type 'boolean) 262 :type '(radio (sexp :format "Non-nil\n"
263 :match (lambda (widget value)
264 (not (or (consp value) (functionp value))))
265 :value t)
266 (const nil)
267 (sexp :tag "Predicate specifier")))
227 268
228 (defcustom gnus-thread-hide-killed t 269 (defcustom gnus-thread-hide-killed t
229 "*If non-nil, hide killed threads automatically." 270 "*If non-nil, hide killed threads automatically."
230 :group 'gnus-thread 271 :group 'gnus-thread
231 :type 'boolean) 272 :type 'boolean)
260 "*If non-nil, extend newsgroup forward and backward when requested." 301 "*If non-nil, extend newsgroup forward and backward when requested."
261 :group 'gnus-summary-choose 302 :group 'gnus-summary-choose
262 :type 'boolean) 303 :type 'boolean)
263 304
264 (defcustom gnus-auto-select-first t 305 (defcustom gnus-auto-select-first t
265 "*If nil, don't select the first unread article when entering a group. 306 "*If non-nil, select the article under point.
266 If this variable is `best', select the highest-scored unread article 307 Which article this is is controlled by the `gnus-auto-select-subject'
267 in the group. If t, select the first unread article. 308 variable.
268 309
269 This variable can also be a function to place point on a likely 310 If you want to prevent automatic selection of articles in some
270 subject line. Useful values include `gnus-summary-first-unread-subject', 311 newsgroups, set the variable to nil in `gnus-select-group-hook'."
271 `gnus-summary-first-unread-article' and
272 `gnus-summary-best-unread-article'.
273
274 If you want to prevent automatic selection of the first unread article
275 in some newsgroups, set the variable to nil in
276 `gnus-select-group-hook'."
277 :group 'gnus-group-select 312 :group 'gnus-group-select
278 :type '(choice (const :tag "none" nil) 313 :type '(choice (const :tag "none" nil)
279 (const best) 314 (sexp :menu-tag "first" t)))
280 (sexp :menu-tag "first" t) 315
281 (function-item gnus-summary-first-unread-subject) 316 (defcustom gnus-auto-select-subject 'unread
282 (function-item gnus-summary-first-unread-article) 317 "*Says what subject to place under point when entering a group.
283 (function-item gnus-summary-best-unread-article))) 318
319 This variable can either be the symbols `first' (place point on the
320 first subject), `unread' (place point on the subject line of the first
321 unread article), `best' (place point on the subject line of the
322 higest-scored article), `unseen' (place point on the subject line of
323 the first unseen article), `unseen-or-unread' (place point on the subject
324 line of the first unseen article or, if all article have been seen, on the
325 subject line of the first unread article), or a function to be called to
326 place point on some subject line."
327 :version "22.1"
328 :group 'gnus-group-select
329 :type '(choice (const best)
330 (const unread)
331 (const first)
332 (const unseen)
333 (const unseen-or-unread)))
284 334
285 (defcustom gnus-auto-select-next t 335 (defcustom gnus-auto-select-next t
286 "*If non-nil, offer to go to the next group from the end of the previous. 336 "*If non-nil, offer to go to the next group from the end of the previous.
287 If the value is t and the next newsgroup is empty, Gnus will exit 337 If the value is t and the next newsgroup is empty, Gnus will exit
288 summary mode and go back to group mode. If the value is neither nil 338 summary mode and go back to group mode. If the value is neither nil
289 nor t, Gnus will select the following unread newsgroup. In 339 nor t, Gnus will select the following unread newsgroup. In
290 particular, if the value is the symbol `quietly', the next unread 340 particular, if the value is the symbol `quietly', the next unread
291 newsgroup will be selected without any confirmation, and if it is 341 newsgroup will be selected without any confirmation, and if it is
292 `almost-quietly', the next group will be selected without any 342 `almost-quietly', the next group will be selected without any
293 confirmation if you are located on the last article in the group. 343 confirmation if you are located on the last article in the group.
294 Finally, if this variable is `slightly-quietly', the `Z n' command 344 Finally, if this variable is `slightly-quietly', the `\\<gnus-summary-mode-map>\\[gnus-summary-catchup-and-goto-next-group]' command
295 will go to the next group without confirmation." 345 will go to the next group without confirmation."
296 :group 'gnus-summary-maneuvering 346 :group 'gnus-summary-maneuvering
297 :type '(choice (const :tag "off" nil) 347 :type '(choice (const :tag "off" nil)
298 (const quietly) 348 (const quietly)
299 (const almost-quietly) 349 (const almost-quietly)
304 "*If non-nil, select the next article with the same subject. 354 "*If non-nil, select the next article with the same subject.
305 If there are no more articles with the same subject, go to 355 If there are no more articles with the same subject, go to
306 the first unread article." 356 the first unread article."
307 :group 'gnus-summary-maneuvering 357 :group 'gnus-summary-maneuvering
308 :type 'boolean) 358 :type 'boolean)
359
360 (defcustom gnus-auto-goto-ignores 'unfetched
361 "*Says how to handle unfetched articles when maneuvering.
362
363 This variable can either be the symbols nil (maneuver to any
364 article), `undownloaded' (maneuvering while unplugged ignores articles
365 that have not been fetched), `always-undownloaded' (maneuvering always
366 ignores articles that have not been fetched), `unfetched' (maneuvering
367 ignores articles whose headers have not been fetched).
368
369 NOTE: The list of unfetched articles will always be nil when plugged
370 and, when unplugged, a subset of the undownloaded article list."
371 :version "22.1"
372 :group 'gnus-summary-maneuvering
373 :type '(choice (const :tag "None" nil)
374 (const :tag "Undownloaded when unplugged" undownloaded)
375 (const :tag "Undownloaded" always-undownloaded)
376 (const :tag "Unfetched" unfetched)))
309 377
310 (defcustom gnus-summary-check-current nil 378 (defcustom gnus-summary-check-current nil
311 "*If non-nil, consider the current article when moving. 379 "*If non-nil, consider the current article when moving.
312 The \"unread\" movement commands will stay on the same line if the 380 The \"unread\" movement commands will stay on the same line if the
313 current article is unread." 381 current article is unread."
322 :type '(choice (const :tag "none" nil) 390 :type '(choice (const :tag "none" nil)
323 (const vertical) 391 (const vertical)
324 (integer :tag "height") 392 (integer :tag "height")
325 (sexp :menu-tag "both" t))) 393 (sexp :menu-tag "both" t)))
326 394
395 (defvar gnus-auto-center-group t
396 "*If non-nil, always center the group buffer.")
397
327 (defcustom gnus-show-all-headers nil 398 (defcustom gnus-show-all-headers nil
328 "*If non-nil, don't hide any headers." 399 "*If non-nil, don't hide any headers."
329 :group 'gnus-article-hiding 400 :group 'gnus-article-hiding
330 :group 'gnus-article-headers 401 :group 'gnus-article-headers
331 :type 'boolean) 402 :type 'boolean)
348 :group 'gnus-article-various 419 :group 'gnus-article-various
349 :type 'boolean) 420 :type 'boolean)
350 421
351 (defcustom gnus-move-split-methods nil 422 (defcustom gnus-move-split-methods nil
352 "*Variable used to suggest where articles are to be moved to. 423 "*Variable used to suggest where articles are to be moved to.
353 It uses the same syntax as the `gnus-split-methods' variable." 424 It uses the same syntax as the `gnus-split-methods' variable.
425 However, whereas `gnus-split-methods' specifies file names as targets,
426 this variable specifies group names."
354 :group 'gnus-summary-mail 427 :group 'gnus-summary-mail
355 :type '(repeat (choice (list :value (fun) function) 428 :type '(repeat (choice (list :value (fun) function)
356 (cons :value ("" "") regexp (repeat string)) 429 (cons :value ("" "") regexp (repeat string))
357 (sexp :value nil)))) 430 (sexp :value nil))))
358 431
359 (defcustom gnus-unread-mark ? ;Whitespace 432 ;; FIXME: Although the custom type is `character' for the following variables,
433 ;; using multibyte characters (Latin-1, UTF-8) doesn't work. -- rs
434
435 (defcustom gnus-unread-mark ? ;Whitespace
360 "*Mark used for unread articles." 436 "*Mark used for unread articles."
361 :group 'gnus-summary-marks 437 :group 'gnus-summary-marks
362 :type 'character) 438 :type 'character)
363 439
364 (defcustom gnus-ticked-mark ?! 440 (defcustom gnus-ticked-mark ?!
389 (defcustom gnus-killed-mark ?K 465 (defcustom gnus-killed-mark ?K
390 "*Mark used for killed articles." 466 "*Mark used for killed articles."
391 :group 'gnus-summary-marks 467 :group 'gnus-summary-marks
392 :type 'character) 468 :type 'character)
393 469
470 (defcustom gnus-spam-mark ?$
471 "*Mark used for spam articles."
472 :version "22.1"
473 :group 'gnus-summary-marks
474 :type 'character)
475
394 (defcustom gnus-souped-mark ?F 476 (defcustom gnus-souped-mark ?F
395 "*Mark used for killed articles." 477 "*Mark used for souped articles."
396 :group 'gnus-summary-marks 478 :group 'gnus-summary-marks
397 :type 'character) 479 :type 'character)
398 480
399 (defcustom gnus-kill-file-mark ?X 481 (defcustom gnus-kill-file-mark ?X
400 "*Mark used for articles killed by kill files." 482 "*Mark used for articles killed by kill files."
414 (defcustom gnus-replied-mark ?A 496 (defcustom gnus-replied-mark ?A
415 "*Mark used for articles that have been replied to." 497 "*Mark used for articles that have been replied to."
416 :group 'gnus-summary-marks 498 :group 'gnus-summary-marks
417 :type 'character) 499 :type 'character)
418 500
501 (defcustom gnus-forwarded-mark ?F
502 "*Mark used for articles that have been forwarded."
503 :version "22.1"
504 :group 'gnus-summary-marks
505 :type 'character)
506
507 (defcustom gnus-recent-mark ?N
508 "*Mark used for articles that are recent."
509 :version "22.1"
510 :group 'gnus-summary-marks
511 :type 'character)
512
419 (defcustom gnus-cached-mark ?* 513 (defcustom gnus-cached-mark ?*
420 "*Mark used for articles that are in the cache." 514 "*Mark used for articles that are in the cache."
421 :group 'gnus-summary-marks 515 :group 'gnus-summary-marks
422 :type 'character) 516 :type 'character)
423 517
424 (defcustom gnus-saved-mark ?S 518 (defcustom gnus-saved-mark ?S
425 "*Mark used for articles that have been saved to." 519 "*Mark used for articles that have been saved."
520 :group 'gnus-summary-marks
521 :type 'character)
522
523 (defcustom gnus-unseen-mark ?.
524 "*Mark used for articles that haven't been seen."
525 :version "22.1"
526 :group 'gnus-summary-marks
527 :type 'character)
528
529 (defcustom gnus-no-mark ? ;Whitespace
530 "*Mark used for articles that have no other secondary mark."
531 :version "22.1"
426 :group 'gnus-summary-marks 532 :group 'gnus-summary-marks
427 :type 'character) 533 :type 'character)
428 534
429 (defcustom gnus-ancient-mark ?O 535 (defcustom gnus-ancient-mark ?O
430 "*Mark used for ancient articles." 536 "*Mark used for ancient articles."
444 (defcustom gnus-duplicate-mark ?M 550 (defcustom gnus-duplicate-mark ?M
445 "*Mark used for duplicate articles." 551 "*Mark used for duplicate articles."
446 :group 'gnus-summary-marks 552 :group 'gnus-summary-marks
447 :type 'character) 553 :type 'character)
448 554
449 (defcustom gnus-undownloaded-mark ?@ 555 (defcustom gnus-undownloaded-mark ?-
450 "*Mark used for articles that weren't downloaded." 556 "*Mark used for articles that weren't downloaded."
557 :version "22.1"
558 :group 'gnus-summary-marks
559 :type 'character)
560
561 (defcustom gnus-downloaded-mark ?+
562 "*Mark used for articles that were downloaded."
451 :group 'gnus-summary-marks 563 :group 'gnus-summary-marks
452 :type 'character) 564 :type 'character)
453 565
454 (defcustom gnus-downloadable-mark ?% 566 (defcustom gnus-downloadable-mark ?%
455 "*Mark used for articles that are to be downloaded." 567 "*Mark used for articles that are to be downloaded."
469 (defcustom gnus-score-below-mark ?- 581 (defcustom gnus-score-below-mark ?-
470 "*Score mark used for articles with low scores." 582 "*Score mark used for articles with low scores."
471 :group 'gnus-summary-marks 583 :group 'gnus-summary-marks
472 :type 'character) 584 :type 'character)
473 585
474 (defcustom gnus-empty-thread-mark ? ;Whitespace 586 (defcustom gnus-empty-thread-mark ? ;Whitespace
475 "*There is no thread under the article." 587 "*There is no thread under the article."
476 :group 'gnus-summary-marks 588 :group 'gnus-summary-marks
477 :type 'character) 589 :type 'character)
478 590
479 (defcustom gnus-not-empty-thread-mark ?= 591 (defcustom gnus-not-empty-thread-mark ?=
521 "*If non-nil, insert pseudo-articles when decoding articles." 633 "*If non-nil, insert pseudo-articles when decoding articles."
522 :group 'gnus-extract-view 634 :group 'gnus-extract-view
523 :type 'boolean) 635 :type 'boolean)
524 636
525 (defcustom gnus-summary-dummy-line-format 637 (defcustom gnus-summary-dummy-line-format
526 " %(: :%) %S\n" 638 " %(: :%) %S\n"
527 "*The format specification for the dummy roots in the summary buffer. 639 "*The format specification for the dummy roots in the summary buffer.
528 It works along the same lines as a normal formatting string, 640 It works along the same lines as a normal formatting string,
529 with some simple extensions. 641 with some simple extensions.
530 642
531 %S The subject" 643 %S The subject
644
645 General format specifiers can also be used.
646 See `(gnus)Formatting Variables'."
647 :link '(custom-manual "(gnus)Formatting Variables")
532 :group 'gnus-threading 648 :group 'gnus-threading
533 :type 'string) 649 :type 'string)
534 650
535 (defcustom gnus-summary-mode-line-format "Gnus: %g [%A] %Z" 651 (defcustom gnus-summary-mode-line-format "Gnus: %g [%A] %Z"
536 "*The format specification for the summary mode line. 652 "*The format specification for the summary mode line.
572 :group 'gnus-score-default 688 :group 'gnus-score-default
573 :type 'integer) 689 :type 'integer)
574 690
575 (defcustom gnus-article-sort-functions '(gnus-article-sort-by-number) 691 (defcustom gnus-article-sort-functions '(gnus-article-sort-by-number)
576 "*List of functions used for sorting articles in the summary buffer. 692 "*List of functions used for sorting articles in the summary buffer.
577 This variable is only used when not using a threaded display." 693
694 Each function takes two articles and returns non-nil if the first
695 article should be sorted before the other. If you use more than one
696 function, the primary sort function should be the last. You should
697 probably always include `gnus-article-sort-by-number' in the list of
698 sorting functions -- preferably first. Also note that sorting by date
699 is often much slower than sorting by number, and the sorting order is
700 very similar. (Sorting by date means sorting by the time the message
701 was sent, sorting by number means sorting by arrival time.)
702
703 Ready-made functions include `gnus-article-sort-by-number',
704 `gnus-article-sort-by-author', `gnus-article-sort-by-subject',
705 `gnus-article-sort-by-date', `gnus-article-sort-by-random'
706 and `gnus-article-sort-by-score'.
707
708 When threading is turned on, the variable `gnus-thread-sort-functions'
709 controls how articles are sorted."
578 :group 'gnus-summary-sort 710 :group 'gnus-summary-sort
579 :type '(repeat (choice (function-item gnus-article-sort-by-number) 711 :type '(repeat (choice (function-item gnus-article-sort-by-number)
580 (function-item gnus-article-sort-by-author) 712 (function-item gnus-article-sort-by-author)
581 (function-item gnus-article-sort-by-subject) 713 (function-item gnus-article-sort-by-subject)
582 (function-item gnus-article-sort-by-date) 714 (function-item gnus-article-sort-by-date)
583 (function-item gnus-article-sort-by-score) 715 (function-item gnus-article-sort-by-score)
716 (function-item gnus-article-sort-by-random)
584 (function :tag "other")))) 717 (function :tag "other"))))
585 718
586 (defcustom gnus-thread-sort-functions '(gnus-thread-sort-by-number) 719 (defcustom gnus-thread-sort-functions '(gnus-thread-sort-by-number)
587 "*List of functions used for sorting threads in the summary buffer. 720 "*List of functions used for sorting threads in the summary buffer.
588 By default, threads are sorted by article number. 721 By default, threads are sorted by article number.
589 722
590 Each function takes two threads and return non-nil if the first thread 723 Each function takes two threads and returns non-nil if the first
591 should be sorted before the other. If you use more than one function, 724 thread should be sorted before the other. If you use more than one
592 the primary sort function should be the last. You should probably 725 function, the primary sort function should be the last. You should
593 always include `gnus-thread-sort-by-number' in the list of sorting 726 probably always include `gnus-thread-sort-by-number' in the list of
594 functions -- preferably first. 727 sorting functions -- preferably first. Also note that sorting by date
728 is often much slower than sorting by number, and the sorting order is
729 very similar. (Sorting by date means sorting by the time the message
730 was sent, sorting by number means sorting by arrival time.)
595 731
596 Ready-made functions include `gnus-thread-sort-by-number', 732 Ready-made functions include `gnus-thread-sort-by-number',
597 `gnus-thread-sort-by-author', `gnus-thread-sort-by-subject', 733 `gnus-thread-sort-by-author', `gnus-thread-sort-by-subject',
598 `gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and 734 `gnus-thread-sort-by-date', `gnus-thread-sort-by-score',
599 `gnus-thread-sort-by-total-score' (see `gnus-thread-score-function')." 735 `gnus-thread-sort-by-most-recent-number',
736 `gnus-thread-sort-by-most-recent-date',
737 `gnus-thread-sort-by-random', and
738 `gnus-thread-sort-by-total-score' (see `gnus-thread-score-function').
739
740 When threading is turned off, the variable
741 `gnus-article-sort-functions' controls how articles are sorted."
600 :group 'gnus-summary-sort 742 :group 'gnus-summary-sort
601 :type '(repeat (choice (function-item gnus-thread-sort-by-number) 743 :type '(repeat (choice (function-item gnus-thread-sort-by-number)
602 (function-item gnus-thread-sort-by-author) 744 (function-item gnus-thread-sort-by-author)
603 (function-item gnus-thread-sort-by-subject) 745 (function-item gnus-thread-sort-by-subject)
604 (function-item gnus-thread-sort-by-date) 746 (function-item gnus-thread-sort-by-date)
605 (function-item gnus-thread-sort-by-score) 747 (function-item gnus-thread-sort-by-score)
606 (function-item gnus-thread-sort-by-total-score) 748 (function-item gnus-thread-sort-by-total-score)
749 (function-item gnus-thread-sort-by-random)
607 (function :tag "other")))) 750 (function :tag "other"))))
608 751
609 (defcustom gnus-thread-score-function '+ 752 (defcustom gnus-thread-score-function '+
610 "*Function used for calculating the total score of a thread. 753 "*Function used for calculating the total score of a thread.
611 754
635 integer)) 778 integer))
636 779
637 (defcustom gnus-summary-mode-hook nil 780 (defcustom gnus-summary-mode-hook nil
638 "*A hook for Gnus summary mode. 781 "*A hook for Gnus summary mode.
639 This hook is run before any variables are set in the summary buffer." 782 This hook is run before any variables are set in the summary buffer."
640 :options '(turn-on-gnus-mailing-list-mode) 783 :options '(turn-on-gnus-mailing-list-mode gnus-pick-mode)
641 :group 'gnus-summary-various 784 :group 'gnus-summary-various
642 :type 'hook) 785 :type 'hook)
786
787 ;; Extracted from gnus-xmas-redefine in order to preserve user settings
788 (when (featurep 'xemacs)
789 (add-hook 'gnus-summary-mode-hook 'gnus-xmas-summary-menu-add)
790 (add-hook 'gnus-summary-mode-hook 'gnus-xmas-setup-summary-toolbar)
791 (add-hook 'gnus-summary-mode-hook
792 'gnus-xmas-switch-horizontal-scrollbar-off))
643 793
644 (defcustom gnus-summary-menu-hook nil 794 (defcustom gnus-summary-menu-hook nil
645 "*Hook run after the creation of the summary mode menu." 795 "*Hook run after the creation of the summary mode menu."
646 :group 'gnus-summary-visual 796 :group 'gnus-summary-visual
647 :type 'hook) 797 :type 'hook)
675 825
676 If you'd like to simplify subjects like the 826 If you'd like to simplify subjects like the
677 `gnus-summary-next-same-subject' command does, you can use the 827 `gnus-summary-next-same-subject' command does, you can use the
678 following hook: 828 following hook:
679 829
680 (setq gnus-select-group-hook 830 (add-hook gnus-select-group-hook
681 (list 831 (lambda ()
682 (lambda () 832 (mapcar (lambda (header)
683 (mapcar (lambda (header) 833 (mail-header-set-subject
684 (mail-header-set-subject 834 header
685 header 835 (gnus-simplify-subject
686 (gnus-simplify-subject 836 (mail-header-subject header) 're-only)))
687 (mail-header-subject header) 're-only))) 837 gnus-newsgroup-headers)))"
688 gnus-newsgroup-headers))))"
689 :group 'gnus-group-select 838 :group 'gnus-group-select
690 :type 'hook) 839 :type 'hook)
691 840
692 (defcustom gnus-select-article-hook nil 841 (defcustom gnus-select-article-hook nil
693 "*A hook called when an article is selected." 842 "*A hook called when an article is selected."
694 :group 'gnus-summary-choose 843 :group 'gnus-summary-choose
844 :options '(gnus-agent-fetch-selected-article)
695 :type 'hook) 845 :type 'hook)
696 846
697 (defcustom gnus-visual-mark-article-hook 847 (defcustom gnus-visual-mark-article-hook
698 (list 'gnus-highlight-selected-summary) 848 (list 'gnus-highlight-selected-summary)
699 "*Hook run after selecting an article in the summary buffer. 849 "*Hook run after selecting an article in the summary buffer.
739 (defcustom gnus-ps-print-hook nil 889 (defcustom gnus-ps-print-hook nil
740 "*A hook run before ps-printing something from Gnus." 890 "*A hook run before ps-printing something from Gnus."
741 :group 'gnus-summary 891 :group 'gnus-summary
742 :type 'hook) 892 :type 'hook)
743 893
744 (defcustom gnus-summary-selected-face 'gnus-summary-selected-face 894 (defcustom gnus-summary-article-move-hook nil
895 "*A hook called after an article is moved, copied, respooled, or crossposted."
896 :version "22.1"
897 :group 'gnus-summary
898 :type 'hook)
899
900 (defcustom gnus-summary-article-delete-hook nil
901 "*A hook called after an article is deleted."
902 :version "22.1"
903 :group 'gnus-summary
904 :type 'hook)
905
906 (defcustom gnus-summary-article-expire-hook nil
907 "*A hook called after an article is expired."
908 :version "22.1"
909 :group 'gnus-summary
910 :type 'hook)
911
912 (defcustom gnus-summary-display-arrow
913 (and (fboundp 'display-graphic-p)
914 (display-graphic-p))
915 "*If non-nil, display an arrow highlighting the current article."
916 :version "22.1"
917 :group 'gnus-summary
918 :type 'boolean)
919
920 (defcustom gnus-summary-selected-face 'gnus-summary-selected
745 "Face used for highlighting the current article in the summary buffer." 921 "Face used for highlighting the current article in the summary buffer."
746 :group 'gnus-summary-visual 922 :group 'gnus-summary-visual
747 :type 'face) 923 :type 'face)
748 924
925 (defvar gnus-tmp-downloaded nil)
926
749 (defcustom gnus-summary-highlight 927 (defcustom gnus-summary-highlight
750 '(((= mark gnus-canceled-mark) 928 '(((eq mark gnus-canceled-mark)
751 . gnus-summary-cancelled-face) 929 . gnus-summary-cancelled)
752 ((and (> score default) 930 ((and uncached (> score default-high))
753 (or (= mark gnus-dormant-mark) 931 . gnus-summary-high-undownloaded)
754 (= mark gnus-ticked-mark))) 932 ((and uncached (< score default-low))
755 . gnus-summary-high-ticked-face) 933 . gnus-summary-low-undownloaded)
756 ((and (< score default) 934 (uncached
757 (or (= mark gnus-dormant-mark) 935 . gnus-summary-normal-undownloaded)
758 (= mark gnus-ticked-mark))) 936 ((and (> score default-high)
759 . gnus-summary-low-ticked-face) 937 (or (eq mark gnus-dormant-mark)
760 ((or (= mark gnus-dormant-mark) 938 (eq mark gnus-ticked-mark)))
761 (= mark gnus-ticked-mark)) 939 . gnus-summary-high-ticked)
762 . gnus-summary-normal-ticked-face) 940 ((and (< score default-low)
763 ((and (> score default) (= mark gnus-ancient-mark)) 941 (or (eq mark gnus-dormant-mark)
764 . gnus-summary-high-ancient-face) 942 (eq mark gnus-ticked-mark)))
765 ((and (< score default) (= mark gnus-ancient-mark)) 943 . gnus-summary-low-ticked)
766 . gnus-summary-low-ancient-face) 944 ((or (eq mark gnus-dormant-mark)
767 ((= mark gnus-ancient-mark) 945 (eq mark gnus-ticked-mark))
768 . gnus-summary-normal-ancient-face) 946 . gnus-summary-normal-ticked)
769 ((and (> score default) (= mark gnus-unread-mark)) 947 ((and (> score default-high) (eq mark gnus-ancient-mark))
770 . gnus-summary-high-unread-face) 948 . gnus-summary-high-ancient)
771 ((and (< score default) (= mark gnus-unread-mark)) 949 ((and (< score default-low) (eq mark gnus-ancient-mark))
772 . gnus-summary-low-unread-face) 950 . gnus-summary-low-ancient)
773 ((= mark gnus-unread-mark) 951 ((eq mark gnus-ancient-mark)
774 . gnus-summary-normal-unread-face) 952 . gnus-summary-normal-ancient)
775 ((and (> score default) (memq mark (list gnus-downloadable-mark 953 ((and (> score default-high) (eq mark gnus-unread-mark))
776 gnus-undownloaded-mark))) 954 . gnus-summary-high-unread)
777 . gnus-summary-high-unread-face) 955 ((and (< score default-low) (eq mark gnus-unread-mark))
778 ((and (< score default) (memq mark (list gnus-downloadable-mark 956 . gnus-summary-low-unread)
779 gnus-undownloaded-mark))) 957 ((eq mark gnus-unread-mark)
780 . gnus-summary-low-unread-face) 958 . gnus-summary-normal-unread)
781 ((memq mark (list gnus-downloadable-mark gnus-undownloaded-mark)) 959 ((> score default-high)
782 . gnus-summary-normal-unread-face) 960 . gnus-summary-high-read)
783 ((> score default) 961 ((< score default-low)
784 . gnus-summary-high-read-face) 962 . gnus-summary-low-read)
785 ((< score default)
786 . gnus-summary-low-read-face)
787 (t 963 (t
788 . gnus-summary-normal-read-face)) 964 . gnus-summary-normal-read))
789 "*Controls the highlighting of summary buffer lines. 965 "*Controls the highlighting of summary buffer lines.
790 966
791 A list of (FORM . FACE) pairs. When deciding how a particular summary 967 A list of (FORM . FACE) pairs. When deciding how a a particular
792 line should be displayed, each form is evaluated. The content of the 968 summary line should be displayed, each form is evaluated. The content
793 face field after the first true form is used. You can change how those 969 of the face field after the first true form is used. You can change
794 summary lines are displayed, by editing the face field. 970 how those summary lines are displayed, by editing the face field.
795 971
796 You can use the following variables in the FORM field. 972 You can use the following variables in the FORM field.
797 973
798 score: The articles score 974 score: The article's score
799 default: The default article score. 975 default: The default article score.
800 below: The score below which articles are automatically marked as read. 976 default-high: The default score for high scored articles.
801 mark: The articles mark." 977 default-low: The default score for low scored articles.
978 below: The score below which articles are automatically marked as read.
979 mark: The article's mark.
980 uncached: Non-nil if the article is uncached."
802 :group 'gnus-summary-visual 981 :group 'gnus-summary-visual
803 :type '(repeat (cons (sexp :tag "Form" nil) 982 :type '(repeat (cons (sexp :tag "Form" nil)
804 face))) 983 face)))
805 984
806 (defcustom gnus-alter-header-function nil 985 (defcustom gnus-alter-header-function nil
812 :group 'gnus-summary) 991 :group 'gnus-summary)
813 992
814 (defvar gnus-decode-encoded-word-function 'mail-decode-encoded-word-string 993 (defvar gnus-decode-encoded-word-function 'mail-decode-encoded-word-string
815 "Variable that says which function should be used to decode a string with encoded words.") 994 "Variable that says which function should be used to decode a string with encoded words.")
816 995
817 (defcustom gnus-extra-headers nil 996 (defcustom gnus-extra-headers '(To Newsgroups)
818 "*Extra headers to parse." 997 "*Extra headers to parse."
819 :version "21.1" 998 :version "21.1"
820 :group 'gnus-summary 999 :group 'gnus-summary
821 :type '(repeat symbol)) 1000 :type '(repeat symbol))
822 1001
823 (defcustom gnus-ignored-from-addresses 1002 (defcustom gnus-ignored-from-addresses
824 (and user-mail-address (regexp-quote user-mail-address)) 1003 (and user-mail-address
1004 (not (string= user-mail-address ""))
1005 (regexp-quote user-mail-address))
825 "*Regexp of From headers that may be suppressed in favor of To headers." 1006 "*Regexp of From headers that may be suppressed in favor of To headers."
826 :version "21.1" 1007 :version "21.1"
827 :group 'gnus-summary 1008 :group 'gnus-summary
828 :type 'regexp) 1009 :type 'regexp)
829
830 (defcustom gnus-group-charset-alist
831 '(("^hk\\>\\|^tw\\>\\|\\<big5\\>" cn-big5)
832 ("^cn\\>\\|\\<chinese\\>" cn-gb-2312)
833 ("^fj\\>\\|^japan\\>" iso-2022-jp-2)
834 ("^tnn\\>\\|^pin\\>\\|^sci.lang.japan" iso-2022-7bit)
835 ("^relcom\\>" koi8-r)
836 ("^fido7\\>" koi8-r)
837 ("^\\(cz\\|hun\\|pl\\|sk\\|hr\\)\\>" iso-8859-2)
838 ("^israel\\>" iso-8859-1)
839 ("^han\\>" euc-kr)
840 ("^alt.chinese.text.big5\\>" chinese-big5)
841 ("^soc.culture.vietnamese\\>" vietnamese-viqr)
842 ("^\\(comp\\|rec\\|alt\\|sci\\|soc\\|news\\|gnu\\|bofh\\)\\>" iso-8859-1)
843 (".*" iso-8859-1))
844 "Alist of regexps (to match group names) and default charsets to be used when reading."
845 :type '(repeat (list (regexp :tag "Group")
846 (symbol :tag "Charset")))
847 :group 'gnus-charset)
848 1010
849 (defcustom gnus-newsgroup-ignored-charsets '(unknown-8bit x-unknown) 1011 (defcustom gnus-newsgroup-ignored-charsets '(unknown-8bit x-unknown)
850 "List of charsets that should be ignored. 1012 "List of charsets that should be ignored.
851 When these charsets are used in the \"charset\" parameter, the 1013 When these charsets are used in the \"charset\" parameter, the
852 default charset will be used instead." 1014 default charset will be used instead."
853 :version "21.1" 1015 :version "21.1"
854 :type '(repeat symbol) 1016 :type '(repeat symbol)
855 :group 'gnus-charset) 1017 :group 'gnus-charset)
856 1018
857 (defcustom gnus-group-ignored-charsets-alist 1019 (gnus-define-group-parameter
858 '(("alt\\.chinese\\.text" iso-8859-1)) 1020 ignored-charsets
859 "Alist of regexps (to match group names) and charsets that should be ignored. 1021 :type list
1022 :function-document
1023 "Return the ignored charsets of GROUP."
1024 :variable gnus-group-ignored-charsets-alist
1025 :variable-default
1026 '(("alt\\.chinese\\.text" iso-8859-1))
1027 :variable-document
1028 "Alist of regexps (to match group names) and charsets that should be ignored.
860 When these charsets are used in the \"charset\" parameter, the 1029 When these charsets are used in the \"charset\" parameter, the
861 default charset will be used instead." 1030 default charset will be used instead."
862 :type '(repeat (cons (regexp :tag "Group") 1031 :variable-group gnus-charset
863 (repeat symbol))) 1032 :variable-type '(repeat (cons (regexp :tag "Group")
864 :group 'gnus-charset) 1033 (repeat symbol)))
1034 :parameter-type '(choice :tag "Ignored charsets"
1035 :value nil
1036 (repeat (symbol)))
1037 :parameter-document "\
1038 List of charsets that should be ignored.
1039
1040 When these charsets are used in the \"charset\" parameter, the
1041 default charset will be used instead.")
865 1042
866 (defcustom gnus-group-highlight-words-alist nil 1043 (defcustom gnus-group-highlight-words-alist nil
867 "Alist of group regexps and highlight regexps. 1044 "Alist of group regexps and highlight regexps.
868 This variable uses the same syntax as `gnus-emphasis-alist'." 1045 This variable uses the same syntax as `gnus-emphasis-alist'."
869 :version "21.1" 1046 :version "21.1"
902 :group 'gnus-score-default 1079 :group 'gnus-score-default
903 :type '(choice (const nil) 1080 :type '(choice (const nil)
904 integer)) 1081 integer))
905 1082
906 (defcustom gnus-summary-save-parts-default-mime "image/.*" 1083 (defcustom gnus-summary-save-parts-default-mime "image/.*"
907 "*A regexp to match MIME parts when saving multiple parts of a message 1084 "*A regexp to match MIME parts when saving multiple parts of a
908 with gnus-summary-save-parts (X m). This regexp will be used by default 1085 message with `gnus-summary-save-parts' (\\<gnus-summary-mode-map>\\[gnus-summary-save-parts]).
909 when prompting the user for which type of files to save." 1086 This regexp will be used by default when prompting the user for which
1087 type of files to save."
910 :group 'gnus-summary 1088 :group 'gnus-summary
911 :type 'regexp) 1089 :type 'regexp)
912 1090
1091 (defcustom gnus-read-all-available-headers nil
1092 "Whether Gnus should parse all headers made available to it.
1093 This is mostly relevant for slow back ends where the user may
1094 wish to widen the summary buffer to include all headers
1095 that were fetched. Say, for nnultimate groups."
1096 :version "22.1"
1097 :group 'gnus-summary
1098 :type '(choice boolean regexp))
1099
1100 (defcustom gnus-summary-muttprint-program "muttprint"
1101 "Command (and optional arguments) used to run Muttprint."
1102 :version "22.1"
1103 :group 'gnus-summary
1104 :type 'string)
1105
1106 (defcustom gnus-article-loose-mime nil
1107 "If non-nil, don't require MIME-Version header.
1108 Some brain-damaged MUA/MTA, e.g. Lotus Domino 5.0.6 clients, does not
1109 supply the MIME-Version header or deliberately strip it from the mail.
1110 Set it to non-nil, Gnus will treat some articles as MIME even if
1111 the MIME-Version header is missed."
1112 :version "22.1"
1113 :type 'boolean
1114 :group 'gnus-article-mime)
1115
1116 (defcustom gnus-article-emulate-mime t
1117 "If non-nil, use MIME emulation for uuencode and the like.
1118 This means that Gnus will search message bodies for text that look
1119 like uuencoded bits, yEncoded bits, and so on, and present that using
1120 the normal Gnus MIME machinery."
1121 :version "22.1"
1122 :type 'boolean
1123 :group 'gnus-article-mime)
913 1124
914 ;;; Internal variables 1125 ;;; Internal variables
915 1126
1127 (defvar gnus-summary-display-cache nil)
916 (defvar gnus-article-mime-handles nil) 1128 (defvar gnus-article-mime-handles nil)
917 (defvar gnus-article-decoded-p nil) 1129 (defvar gnus-article-decoded-p nil)
1130 (defvar gnus-article-charset nil)
1131 (defvar gnus-article-ignored-charsets nil)
918 (defvar gnus-scores-exclude-files nil) 1132 (defvar gnus-scores-exclude-files nil)
919 (defvar gnus-page-broken nil) 1133 (defvar gnus-page-broken nil)
920 (defvar gnus-inhibit-mime-unbuttonizing nil)
921 1134
922 (defvar gnus-original-article nil) 1135 (defvar gnus-original-article nil)
923 (defvar gnus-article-internal-prepare-hook nil) 1136 (defvar gnus-article-internal-prepare-hook nil)
924 (defvar gnus-newsgroup-process-stack nil) 1137 (defvar gnus-newsgroup-process-stack nil)
925 1138
927 (defvar gnus-thread-indent-array-level gnus-thread-indent-level) 1140 (defvar gnus-thread-indent-array-level gnus-thread-indent-level)
928 (defvar gnus-sort-gathered-threads-function 'gnus-thread-sort-by-number 1141 (defvar gnus-sort-gathered-threads-function 'gnus-thread-sort-by-number
929 "Function called to sort the articles within a thread after it has been gathered together.") 1142 "Function called to sort the articles within a thread after it has been gathered together.")
930 1143
931 (defvar gnus-summary-save-parts-type-history nil) 1144 (defvar gnus-summary-save-parts-type-history nil)
932 (defvar gnus-summary-save-parts-last-directory nil) 1145 (defvar gnus-summary-save-parts-last-directory mm-default-directory)
933 1146
934 ;; Avoid highlighting in kill files. 1147 ;; Avoid highlighting in kill files.
935 (defvar gnus-summary-inhibit-highlight nil) 1148 (defvar gnus-summary-inhibit-highlight nil)
936 (defvar gnus-newsgroup-selected-overlay nil) 1149 (defvar gnus-newsgroup-selected-overlay nil)
937 (defvar gnus-inhibit-limiting nil) 1150 (defvar gnus-inhibit-limiting nil)
938 (defvar gnus-newsgroup-adaptive-score-file nil) 1151 (defvar gnus-newsgroup-adaptive-score-file nil)
939 (defvar gnus-current-score-file nil) 1152 (defvar gnus-current-score-file nil)
940 (defvar gnus-current-move-group nil) 1153 (defvar gnus-current-move-group nil)
941 (defvar gnus-current-copy-group nil) 1154 (defvar gnus-current-copy-group nil)
942 (defvar gnus-current-crosspost-group nil) 1155 (defvar gnus-current-crosspost-group nil)
1156 (defvar gnus-newsgroup-display nil)
943 1157
944 (defvar gnus-newsgroup-dependencies nil) 1158 (defvar gnus-newsgroup-dependencies nil)
945 (defvar gnus-newsgroup-adaptive nil) 1159 (defvar gnus-newsgroup-adaptive nil)
946 (defvar gnus-summary-display-article-function nil) 1160 (defvar gnus-summary-display-article-function nil)
947 (defvar gnus-summary-highlight-line-function nil 1161 (defvar gnus-summary-highlight-line-function nil
962 (?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s) 1176 (?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s)
963 (?o (gnus-date-iso8601 (mail-header-date gnus-tmp-header)) ?s) 1177 (?o (gnus-date-iso8601 (mail-header-date gnus-tmp-header)) ?s)
964 (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s) 1178 (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s)
965 (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s) 1179 (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s)
966 (?c (or (mail-header-chars gnus-tmp-header) 0) ?d) 1180 (?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
967 (?L gnus-tmp-lines ?d) 1181 (?k (gnus-summary-line-message-size gnus-tmp-header) ?s)
1182 (?L gnus-tmp-lines ?s)
1183 (?O gnus-tmp-downloaded ?c)
968 (?I gnus-tmp-indentation ?s) 1184 (?I gnus-tmp-indentation ?s)
969 (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s) 1185 (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
970 (?R gnus-tmp-replied ?c) 1186 (?R gnus-tmp-replied ?c)
971 (?\[ gnus-tmp-opening-bracket ?c) 1187 (?\[ gnus-tmp-opening-bracket ?c)
972 (?\] gnus-tmp-closing-bracket ?c) 1188 (?\] gnus-tmp-closing-bracket ?c)
975 (?i gnus-tmp-score ?d) 1191 (?i gnus-tmp-score ?d)
976 (?z gnus-tmp-score-char ?c) 1192 (?z gnus-tmp-score-char ?c)
977 (?l (bbb-grouplens-score gnus-tmp-header) ?s) 1193 (?l (bbb-grouplens-score gnus-tmp-header) ?s)
978 (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d) 1194 (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d)
979 (?U gnus-tmp-unread ?c) 1195 (?U gnus-tmp-unread ?c)
980 (?f (gnus-summary-from-or-to-or-newsgroups gnus-tmp-header) ?s) 1196 (?f (gnus-summary-from-or-to-or-newsgroups gnus-tmp-header gnus-tmp-from)
1197 ?s)
981 (?t (gnus-summary-number-of-articles-in-thread 1198 (?t (gnus-summary-number-of-articles-in-thread
982 (and (boundp 'thread) (car thread)) gnus-tmp-level) 1199 (and (boundp 'thread) (car thread)) gnus-tmp-level)
983 ?d) 1200 ?d)
984 (?e (gnus-summary-number-of-articles-in-thread 1201 (?e (gnus-summary-number-of-articles-in-thread
985 (and (boundp 'thread) (car thread)) gnus-tmp-level t) 1202 (and (boundp 'thread) (car thread)) gnus-tmp-level t)
986 ?c) 1203 ?c)
987 (?u gnus-tmp-user-defined ?s) 1204 (?u gnus-tmp-user-defined ?s)
988 (?P (gnus-pick-line-number) ?d)) 1205 (?P (gnus-pick-line-number) ?d)
1206 (?B gnus-tmp-thread-tree-header-string ?s)
1207 (user-date (gnus-user-date
1208 ,(macroexpand '(mail-header-date gnus-tmp-header))) ?s))
989 "An alist of format specifications that can appear in summary lines. 1209 "An alist of format specifications that can appear in summary lines.
990 These are paired with what variables they correspond with, along with 1210 These are paired with what variables they correspond with, along with
991 the type of the variable (string, integer, character, etc).") 1211 the type of the variable (string, integer, character, etc).")
992 1212
993 (defvar gnus-summary-dummy-line-format-alist 1213 (defvar gnus-summary-dummy-line-format-alist
1006 (?S gnus-tmp-subject ?s) 1226 (?S gnus-tmp-subject ?s)
1007 (?e gnus-tmp-unselected ?d) 1227 (?e gnus-tmp-unselected ?d)
1008 (?u gnus-tmp-user-defined ?s) 1228 (?u gnus-tmp-user-defined ?s)
1009 (?d (length gnus-newsgroup-dormant) ?d) 1229 (?d (length gnus-newsgroup-dormant) ?d)
1010 (?t (length gnus-newsgroup-marked) ?d) 1230 (?t (length gnus-newsgroup-marked) ?d)
1231 (?h (length gnus-newsgroup-spam-marked) ?d)
1011 (?r (length gnus-newsgroup-reads) ?d) 1232 (?r (length gnus-newsgroup-reads) ?d)
1012 (?z (gnus-summary-article-score gnus-tmp-article-number) ?d) 1233 (?z (gnus-summary-article-score gnus-tmp-article-number) ?d)
1013 (?E gnus-newsgroup-expunged-tally ?d) 1234 (?E gnus-newsgroup-expunged-tally ?d)
1014 (?s (gnus-current-score-file-nondirectory) ?s))) 1235 (?s (gnus-current-score-file-nondirectory) ?s)))
1015 1236
1017 "Default regexp for article search command.") 1238 "Default regexp for article search command.")
1018 1239
1019 (defvar gnus-last-shell-command nil 1240 (defvar gnus-last-shell-command nil
1020 "Default shell command on article.") 1241 "Default shell command on article.")
1021 1242
1243 (defvar gnus-newsgroup-agentized nil
1244 "Locally bound in each summary buffer to indicate whether the server has been agentized.")
1022 (defvar gnus-newsgroup-begin nil) 1245 (defvar gnus-newsgroup-begin nil)
1023 (defvar gnus-newsgroup-end nil) 1246 (defvar gnus-newsgroup-end nil)
1024 (defvar gnus-newsgroup-last-rmail nil) 1247 (defvar gnus-newsgroup-last-rmail nil)
1025 (defvar gnus-newsgroup-last-mail nil) 1248 (defvar gnus-newsgroup-last-mail nil)
1026 (defvar gnus-newsgroup-last-folder nil) 1249 (defvar gnus-newsgroup-last-folder nil)
1030 1253
1031 (defvar gnus-newsgroup-data nil) 1254 (defvar gnus-newsgroup-data nil)
1032 (defvar gnus-newsgroup-data-reverse nil) 1255 (defvar gnus-newsgroup-data-reverse nil)
1033 (defvar gnus-newsgroup-limit nil) 1256 (defvar gnus-newsgroup-limit nil)
1034 (defvar gnus-newsgroup-limits nil) 1257 (defvar gnus-newsgroup-limits nil)
1258 (defvar gnus-summary-use-undownloaded-faces nil)
1035 1259
1036 (defvar gnus-newsgroup-unreads nil 1260 (defvar gnus-newsgroup-unreads nil
1037 "List of unread articles in the current newsgroup.") 1261 "Sorted list of unread articles in the current newsgroup.")
1038 1262
1039 (defvar gnus-newsgroup-unselected nil 1263 (defvar gnus-newsgroup-unselected nil
1040 "List of unselected unread articles in the current newsgroup.") 1264 "Sorted list of unselected unread articles in the current newsgroup.")
1041 1265
1042 (defvar gnus-newsgroup-reads nil 1266 (defvar gnus-newsgroup-reads nil
1043 "Alist of read articles and article marks in the current newsgroup.") 1267 "Alist of read articles and article marks in the current newsgroup.")
1044 1268
1045 (defvar gnus-newsgroup-expunged-tally nil) 1269 (defvar gnus-newsgroup-expunged-tally nil)
1046 1270
1047 (defvar gnus-newsgroup-marked nil 1271 (defvar gnus-newsgroup-marked nil
1048 "List of ticked articles in the current newsgroup (a subset of unread art).") 1272 "Sorted list of ticked articles in the current newsgroup (a subset of unread art).")
1273
1274 (defvar gnus-newsgroup-spam-marked nil
1275 "List of ranges of articles that have been marked as spam.")
1049 1276
1050 (defvar gnus-newsgroup-killed nil 1277 (defvar gnus-newsgroup-killed nil
1051 "List of ranges of articles that have been through the scoring process.") 1278 "List of ranges of articles that have been through the scoring process.")
1052 1279
1053 (defvar gnus-newsgroup-cached nil 1280 (defvar gnus-newsgroup-cached nil
1054 "List of articles that come from the article cache.") 1281 "Sorted list of articles that come from the article cache.")
1055 1282
1056 (defvar gnus-newsgroup-saved nil 1283 (defvar gnus-newsgroup-saved nil
1057 "List of articles that have been saved.") 1284 "List of articles that have been saved.")
1058 1285
1059 (defvar gnus-newsgroup-kill-headers nil) 1286 (defvar gnus-newsgroup-kill-headers nil)
1060 1287
1061 (defvar gnus-newsgroup-replied nil 1288 (defvar gnus-newsgroup-replied nil
1062 "List of articles that have been replied to in the current newsgroup.") 1289 "List of articles that have been replied to in the current newsgroup.")
1063 1290
1291 (defvar gnus-newsgroup-forwarded nil
1292 "List of articles that have been forwarded in the current newsgroup.")
1293
1294 (defvar gnus-newsgroup-recent nil
1295 "List of articles that have are recent in the current newsgroup.")
1296
1064 (defvar gnus-newsgroup-expirable nil 1297 (defvar gnus-newsgroup-expirable nil
1065 "List of articles in the current newsgroup that can be expired.") 1298 "Sorted list of articles in the current newsgroup that can be expired.")
1066 1299
1067 (defvar gnus-newsgroup-processable nil 1300 (defvar gnus-newsgroup-processable nil
1068 "List of articles in the current newsgroup that can be processed.") 1301 "List of articles in the current newsgroup that can be processed.")
1069 1302
1070 (defvar gnus-newsgroup-downloadable nil 1303 (defvar gnus-newsgroup-downloadable nil
1071 "List of articles in the current newsgroup that can be processed.") 1304 "Sorted list of articles in the current newsgroup that can be processed.")
1305
1306 (defvar gnus-newsgroup-unfetched nil
1307 "Sorted list of articles in the current newsgroup whose headers have
1308 not been fetched into the agent.
1309
1310 This list will always be a subset of gnus-newsgroup-undownloaded.")
1072 1311
1073 (defvar gnus-newsgroup-undownloaded nil 1312 (defvar gnus-newsgroup-undownloaded nil
1074 "List of articles in the current newsgroup that haven't been downloaded..") 1313 "List of articles in the current newsgroup that haven't been downloaded.")
1075 1314
1076 (defvar gnus-newsgroup-unsendable nil 1315 (defvar gnus-newsgroup-unsendable nil
1077 "List of articles in the current newsgroup that won't be sent.") 1316 "List of articles in the current newsgroup that won't be sent.")
1078 1317
1079 (defvar gnus-newsgroup-bookmarks nil 1318 (defvar gnus-newsgroup-bookmarks nil
1080 "List of articles in the current newsgroup that have bookmarks.") 1319 "List of articles in the current newsgroup that have bookmarks.")
1081 1320
1082 (defvar gnus-newsgroup-dormant nil 1321 (defvar gnus-newsgroup-dormant nil
1083 "List of dormant articles in the current newsgroup.") 1322 "Sorted list of dormant articles in the current newsgroup.")
1323
1324 (defvar gnus-newsgroup-unseen nil
1325 "List of unseen articles in the current newsgroup.")
1326
1327 (defvar gnus-newsgroup-seen nil
1328 "Range of seen articles in the current newsgroup.")
1329
1330 (defvar gnus-newsgroup-articles nil
1331 "List of articles in the current newsgroup.")
1084 1332
1085 (defvar gnus-newsgroup-scored nil 1333 (defvar gnus-newsgroup-scored nil
1086 "List of scored articles in the current newsgroup.") 1334 "List of scored articles in the current newsgroup.")
1087 1335
1088 (defvar gnus-newsgroup-headers nil 1336 (defvar gnus-newsgroup-headers nil
1106 (defvar gnus-newsgroup-history nil) 1354 (defvar gnus-newsgroup-history nil)
1107 (defvar gnus-newsgroup-charset nil) 1355 (defvar gnus-newsgroup-charset nil)
1108 (defvar gnus-newsgroup-ephemeral-charset nil) 1356 (defvar gnus-newsgroup-ephemeral-charset nil)
1109 (defvar gnus-newsgroup-ephemeral-ignored-charsets nil) 1357 (defvar gnus-newsgroup-ephemeral-ignored-charsets nil)
1110 1358
1111 (defconst gnus-summary-local-variables 1359 (defvar gnus-article-before-search nil)
1360
1361 (defvar gnus-summary-local-variables
1112 '(gnus-newsgroup-name 1362 '(gnus-newsgroup-name
1113 gnus-newsgroup-begin gnus-newsgroup-end 1363 gnus-newsgroup-begin gnus-newsgroup-end
1114 gnus-newsgroup-last-rmail gnus-newsgroup-last-mail 1364 gnus-newsgroup-last-rmail gnus-newsgroup-last-mail
1115 gnus-newsgroup-last-folder gnus-newsgroup-last-file 1365 gnus-newsgroup-last-folder gnus-newsgroup-last-file
1116 gnus-newsgroup-auto-expire gnus-newsgroup-unreads 1366 gnus-newsgroup-auto-expire gnus-newsgroup-unreads
1117 gnus-newsgroup-unselected gnus-newsgroup-marked 1367 gnus-newsgroup-unselected gnus-newsgroup-marked
1368 gnus-newsgroup-spam-marked
1118 gnus-newsgroup-reads gnus-newsgroup-saved 1369 gnus-newsgroup-reads gnus-newsgroup-saved
1119 gnus-newsgroup-replied gnus-newsgroup-expirable 1370 gnus-newsgroup-replied gnus-newsgroup-forwarded
1371 gnus-newsgroup-recent
1372 gnus-newsgroup-expirable
1120 gnus-newsgroup-processable gnus-newsgroup-killed 1373 gnus-newsgroup-processable gnus-newsgroup-killed
1121 gnus-newsgroup-downloadable gnus-newsgroup-undownloaded 1374 gnus-newsgroup-downloadable gnus-newsgroup-undownloaded
1122 gnus-newsgroup-unsendable 1375 gnus-newsgroup-unfetched
1376 gnus-newsgroup-unsendable gnus-newsgroup-unseen
1377 gnus-newsgroup-seen gnus-newsgroup-articles
1123 gnus-newsgroup-bookmarks gnus-newsgroup-dormant 1378 gnus-newsgroup-bookmarks gnus-newsgroup-dormant
1124 gnus-newsgroup-headers gnus-newsgroup-threads 1379 gnus-newsgroup-headers gnus-newsgroup-threads
1125 gnus-newsgroup-prepared gnus-summary-highlight-line-function 1380 gnus-newsgroup-prepared gnus-summary-highlight-line-function
1126 gnus-current-article gnus-current-headers gnus-have-all-headers 1381 gnus-current-article gnus-current-headers gnus-have-all-headers
1127 gnus-last-article gnus-article-internal-prepare-hook 1382 gnus-last-article gnus-article-internal-prepare-hook
1139 gnus-newsgroup-adaptive-score-file (gnus-reffed-article-number . -1) 1394 gnus-newsgroup-adaptive-score-file (gnus-reffed-article-number . -1)
1140 (gnus-newsgroup-expunged-tally . 0) 1395 (gnus-newsgroup-expunged-tally . 0)
1141 gnus-cache-removable-articles gnus-newsgroup-cached 1396 gnus-cache-removable-articles gnus-newsgroup-cached
1142 gnus-newsgroup-data gnus-newsgroup-data-reverse 1397 gnus-newsgroup-data gnus-newsgroup-data-reverse
1143 gnus-newsgroup-limit gnus-newsgroup-limits 1398 gnus-newsgroup-limit gnus-newsgroup-limits
1144 gnus-newsgroup-charset) 1399 gnus-newsgroup-charset gnus-newsgroup-display
1400 gnus-summary-use-undownloaded-faces)
1145 "Variables that are buffer-local to the summary buffers.") 1401 "Variables that are buffer-local to the summary buffers.")
1146 1402
1403 (defvar gnus-newsgroup-variables nil
1404 "A list of variables that have separate values in different newsgroups.
1405 A list of newsgroup (summary buffer) local variables, or cons of
1406 variables and their default expressions to be evalled (when the default
1407 values are not nil), that should be made global while the summary buffer
1408 is active.
1409
1410 Note: The default expressions will be evaluated (using function `eval')
1411 before assignment to the local variable rather than just assigned to it.
1412 If the default expression is the symbol `global', that symbol will not
1413 be evaluated but the global value of the local variable will be used
1414 instead.
1415
1416 These variables can be used to set variables in the group parameters
1417 while still allowing them to affect operations done in other buffers.
1418 For example:
1419
1420 \(setq gnus-newsgroup-variables
1421 '(message-use-followup-to
1422 (gnus-visible-headers .
1423 \"^From:\\\\|^Newsgroups:\\\\|^Subject:\\\\|^Date:\\\\|^To:\")))
1424 ")
1425
1147 ;; Byte-compiler warning. 1426 ;; Byte-compiler warning.
1148 (eval-when-compile (defvar gnus-article-mode-map)) 1427 (eval-when-compile
1428 ;; Bind features so that require will believe that gnus-sum has
1429 ;; already been loaded (avoids infinite recursion)
1430 (let ((features (cons 'gnus-sum features)))
1431 ;; Several of the declarations in gnus-sum are needed to load the
1432 ;; following files. Right now, these definitions have been
1433 ;; compiled but not defined (evaluated). We could either do a
1434 ;; eval-and-compile about all of the declarations or evaluate the
1435 ;; source file.
1436 (if (boundp 'gnus-newsgroup-variables)
1437 nil
1438 (load "gnus-sum.el" t t t))
1439 (require 'gnus)
1440 (require 'gnus-agent)
1441 (require 'gnus-art)))
1149 1442
1150 ;; MIME stuff. 1443 ;; MIME stuff.
1151 1444
1152 (defvar gnus-decode-encoded-word-methods 1445 (defvar gnus-decode-encoded-word-methods
1153 '(mail-decode-encoded-word-string) 1446 '(mail-decode-encoded-word-string)
1154 "List of methods used to decode encoded words. 1447 "List of methods used to decode encoded words.
1155 1448
1156 This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item is 1449 This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item
1157 FUNCTION, FUNCTION will be apply to all newsgroups. If item is a 1450 is FUNCTION, FUNCTION will be apply to all newsgroups. If item is a
1158 (REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups 1451 \(REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups
1159 whose names match REGEXP. 1452 whose names match REGEXP.
1160 1453
1161 For example: 1454 For example:
1162 ((\"chinese\" . gnus-decode-encoded-word-string-by-guess) 1455 \((\"chinese\" . gnus-decode-encoded-word-string-by-guess)
1163 mail-decode-encoded-word-string 1456 mail-decode-encoded-word-string
1164 (\"chinese\" . rfc1843-decode-string))") 1457 (\"chinese\" . rfc1843-decode-string))")
1165 1458
1166 (defvar gnus-decode-encoded-word-methods-cache nil) 1459 (defvar gnus-decode-encoded-word-methods-cache nil)
1167 1460
1176 (nconc gnus-decode-encoded-word-methods-cache (list x)) 1469 (nconc gnus-decode-encoded-word-methods-cache (list x))
1177 (if (and gnus-newsgroup-name 1470 (if (and gnus-newsgroup-name
1178 (string-match (car x) gnus-newsgroup-name)) 1471 (string-match (car x) gnus-newsgroup-name))
1179 (nconc gnus-decode-encoded-word-methods-cache 1472 (nconc gnus-decode-encoded-word-methods-cache
1180 (list (cdr x)))))) 1473 (list (cdr x))))))
1181 gnus-decode-encoded-word-methods)) 1474 gnus-decode-encoded-word-methods))
1182 (let ((xlist gnus-decode-encoded-word-methods-cache)) 1475 (let ((xlist gnus-decode-encoded-word-methods-cache))
1183 (pop xlist) 1476 (pop xlist)
1184 (while xlist 1477 (while xlist
1185 (setq string (funcall (pop xlist) string)))) 1478 (setq string (funcall (pop xlist) string))))
1186 string) 1479 string)
1187 1480
1188 ;; Subject simplification. 1481 ;; Subject simplification.
1189 1482
1190 (defun gnus-simplify-whitespace (str) 1483 (defun gnus-simplify-whitespace (str)
1191 "Remove excessive whitespace from STR." 1484 "Remove excessive whitespace from STR."
1192 (let ((mystr str)) 1485 ;; Multiple spaces.
1193 ;; Multiple spaces. 1486 (while (string-match "[ \t][ \t]+" str)
1194 (while (string-match "[ \t][ \t]+" mystr) 1487 (setq str (concat (substring str 0 (match-beginning 0))
1195 (setq mystr (concat (substring mystr 0 (match-beginning 0)) 1488 " "
1196 " " 1489 (substring str (match-end 0)))))
1197 (substring mystr (match-end 0))))) 1490 ;; Leading spaces.
1198 ;; Leading spaces. 1491 (when (string-match "^[ \t]+" str)
1199 (when (string-match "^[ \t]+" mystr) 1492 (setq str (substring str (match-end 0))))
1200 (setq mystr (substring mystr (match-end 0)))) 1493 ;; Trailing spaces.
1201 ;; Trailing spaces. 1494 (when (string-match "[ \t]+$" str)
1202 (when (string-match "[ \t]+$" mystr) 1495 (setq str (substring str 0 (match-beginning 0))))
1203 (setq mystr (substring mystr 0 (match-beginning 0)))) 1496 str)
1204 mystr)) 1497
1498 (defun gnus-simplify-all-whitespace (str)
1499 "Remove all whitespace from STR."
1500 (while (string-match "[ \t\n]+" str)
1501 (setq str (replace-match "" nil nil str)))
1502 str)
1205 1503
1206 (defsubst gnus-simplify-subject-re (subject) 1504 (defsubst gnus-simplify-subject-re (subject)
1207 "Remove \"Re:\" from subject lines." 1505 "Remove \"Re:\" from subject lines."
1208 (if (string-match "^[Rr][Ee]: *" subject) 1506 (if (string-match message-subject-re-regexp subject)
1209 (substring subject (match-end 0)) 1507 (substring subject (match-end 0))
1210 subject)) 1508 subject))
1211 1509
1212 (defun gnus-simplify-subject (subject &optional re-only) 1510 (defun gnus-simplify-subject (subject &optional re-only)
1213 "Remove `Re:' and words in parentheses. 1511 "Remove `Re:' and words in parentheses.
1277 (insert subject) 1575 (insert subject)
1278 (inline (gnus-simplify-buffer-fuzzy)) 1576 (inline (gnus-simplify-buffer-fuzzy))
1279 (buffer-string)))) 1577 (buffer-string))))
1280 1578
1281 (defsubst gnus-simplify-subject-fully (subject) 1579 (defsubst gnus-simplify-subject-fully (subject)
1282 "Simplify a subject string according to gnus-summary-gather-subject-limit." 1580 "Simplify a subject string according to `gnus-summary-gather-subject-limit'."
1283 (cond 1581 (cond
1284 (gnus-simplify-subject-functions 1582 (gnus-simplify-subject-functions
1285 (gnus-map-function gnus-simplify-subject-functions subject)) 1583 (gnus-map-function gnus-simplify-subject-functions subject))
1286 ((null gnus-summary-gather-subject-limit) 1584 ((null gnus-summary-gather-subject-limit)
1287 (gnus-simplify-subject-re subject)) 1585 (gnus-simplify-subject-re subject))
1293 (t 1591 (t
1294 subject))) 1592 subject)))
1295 1593
1296 (defsubst gnus-subject-equal (s1 s2 &optional simple-first) 1594 (defsubst gnus-subject-equal (s1 s2 &optional simple-first)
1297 "Check whether two subjects are equal. 1595 "Check whether two subjects are equal.
1298 If optional argument simple-first is t, first argument is already 1596 If optional argument SIMPLE-FIRST is t, first argument is already
1299 simplified." 1597 simplified."
1300 (cond 1598 (cond
1301 ((null simple-first) 1599 ((null simple-first)
1302 (equal (gnus-simplify-subject-fully s1) 1600 (equal (gnus-simplify-subject-fully s1)
1303 (gnus-simplify-subject-fully s2))) 1601 (gnus-simplify-subject-fully s2)))
1318 1616
1319 (put 'gnus-summary-mode 'mode-class 'special) 1617 (put 'gnus-summary-mode 'mode-class 'special)
1320 1618
1321 (defvar gnus-article-commands-menu) 1619 (defvar gnus-article-commands-menu)
1322 1620
1323 (when t 1621 ;; Non-orthogonal keys
1324 ;; Non-orthogonal keys 1622
1325 1623 (gnus-define-keys gnus-summary-mode-map
1326 (gnus-define-keys gnus-summary-mode-map 1624 " " gnus-summary-next-page
1327 " " gnus-summary-next-page 1625 "\177" gnus-summary-prev-page
1328 "\177" gnus-summary-prev-page 1626 [delete] gnus-summary-prev-page
1329 [delete] gnus-summary-prev-page 1627 [backspace] gnus-summary-prev-page
1330 [backspace] gnus-summary-prev-page 1628 "\r" gnus-summary-scroll-up
1331 "\r" gnus-summary-scroll-up 1629 "\M-\r" gnus-summary-scroll-down
1332 "\M-\r" gnus-summary-scroll-down 1630 "n" gnus-summary-next-unread-article
1333 "n" gnus-summary-next-unread-article 1631 "p" gnus-summary-prev-unread-article
1334 "p" gnus-summary-prev-unread-article 1632 "N" gnus-summary-next-article
1335 "N" gnus-summary-next-article 1633 "P" gnus-summary-prev-article
1336 "P" gnus-summary-prev-article 1634 "\M-\C-n" gnus-summary-next-same-subject
1337 "\M-\C-n" gnus-summary-next-same-subject 1635 "\M-\C-p" gnus-summary-prev-same-subject
1338 "\M-\C-p" gnus-summary-prev-same-subject 1636 "\M-n" gnus-summary-next-unread-subject
1339 "\M-n" gnus-summary-next-unread-subject 1637 "\M-p" gnus-summary-prev-unread-subject
1340 "\M-p" gnus-summary-prev-unread-subject 1638 "." gnus-summary-first-unread-article
1341 "." gnus-summary-first-unread-article 1639 "," gnus-summary-best-unread-article
1342 "," gnus-summary-best-unread-article 1640 "\M-s" gnus-summary-search-article-forward
1343 "\M-s" gnus-summary-search-article-forward 1641 "\M-r" gnus-summary-search-article-backward
1344 "\M-r" gnus-summary-search-article-backward 1642 "<" gnus-summary-beginning-of-article
1345 "<" gnus-summary-beginning-of-article 1643 ">" gnus-summary-end-of-article
1346 ">" gnus-summary-end-of-article 1644 "j" gnus-summary-goto-article
1347 "j" gnus-summary-goto-article 1645 "^" gnus-summary-refer-parent-article
1348 "^" gnus-summary-refer-parent-article 1646 "\M-^" gnus-summary-refer-article
1349 "\M-^" gnus-summary-refer-article 1647 "u" gnus-summary-tick-article-forward
1350 "u" gnus-summary-tick-article-forward 1648 "!" gnus-summary-tick-article-forward
1351 "!" gnus-summary-tick-article-forward 1649 "U" gnus-summary-tick-article-backward
1352 "U" gnus-summary-tick-article-backward 1650 "d" gnus-summary-mark-as-read-forward
1353 "d" gnus-summary-mark-as-read-forward 1651 "D" gnus-summary-mark-as-read-backward
1354 "D" gnus-summary-mark-as-read-backward 1652 "E" gnus-summary-mark-as-expirable
1355 "E" gnus-summary-mark-as-expirable 1653 "\M-u" gnus-summary-clear-mark-forward
1356 "\M-u" gnus-summary-clear-mark-forward 1654 "\M-U" gnus-summary-clear-mark-backward
1357 "\M-U" gnus-summary-clear-mark-backward 1655 "k" gnus-summary-kill-same-subject-and-select
1358 "k" gnus-summary-kill-same-subject-and-select 1656 "\C-k" gnus-summary-kill-same-subject
1359 "\C-k" gnus-summary-kill-same-subject 1657 "\M-\C-k" gnus-summary-kill-thread
1360 "\M-\C-k" gnus-summary-kill-thread 1658 "\M-\C-l" gnus-summary-lower-thread
1361 "\M-\C-l" gnus-summary-lower-thread 1659 "e" gnus-summary-edit-article
1362 "e" gnus-summary-edit-article 1660 "#" gnus-summary-mark-as-processable
1363 "#" gnus-summary-mark-as-processable 1661 "\M-#" gnus-summary-unmark-as-processable
1364 "\M-#" gnus-summary-unmark-as-processable 1662 "\M-\C-t" gnus-summary-toggle-threads
1365 "\M-\C-t" gnus-summary-toggle-threads 1663 "\M-\C-s" gnus-summary-show-thread
1366 "\M-\C-s" gnus-summary-show-thread 1664 "\M-\C-h" gnus-summary-hide-thread
1367 "\M-\C-h" gnus-summary-hide-thread 1665 "\M-\C-f" gnus-summary-next-thread
1368 "\M-\C-f" gnus-summary-next-thread 1666 "\M-\C-b" gnus-summary-prev-thread
1369 "\M-\C-b" gnus-summary-prev-thread 1667 [(meta down)] gnus-summary-next-thread
1370 [(meta down)] gnus-summary-next-thread 1668 [(meta up)] gnus-summary-prev-thread
1371 [(meta up)] gnus-summary-prev-thread 1669 "\M-\C-u" gnus-summary-up-thread
1372 "\M-\C-u" gnus-summary-up-thread 1670 "\M-\C-d" gnus-summary-down-thread
1373 "\M-\C-d" gnus-summary-down-thread 1671 "&" gnus-summary-execute-command
1374 "&" gnus-summary-execute-command 1672 "c" gnus-summary-catchup-and-exit
1375 "c" gnus-summary-catchup-and-exit 1673 "\C-w" gnus-summary-mark-region-as-read
1376 "\C-w" gnus-summary-mark-region-as-read 1674 "\C-t" gnus-summary-toggle-truncation
1377 "\C-t" gnus-summary-toggle-truncation 1675 "?" gnus-summary-mark-as-dormant
1378 "?" gnus-summary-mark-as-dormant 1676 "\C-c\M-\C-s" gnus-summary-limit-include-expunged
1379 "\C-c\M-\C-s" gnus-summary-limit-include-expunged 1677 "\C-c\C-s\C-n" gnus-summary-sort-by-number
1380 "\C-c\C-s\C-n" gnus-summary-sort-by-number 1678 "\C-c\C-s\C-l" gnus-summary-sort-by-lines
1381 "\C-c\C-s\C-l" gnus-summary-sort-by-lines 1679 "\C-c\C-s\C-c" gnus-summary-sort-by-chars
1382 "\C-c\C-s\C-c" gnus-summary-sort-by-chars 1680 "\C-c\C-s\C-a" gnus-summary-sort-by-author
1383 "\C-c\C-s\C-a" gnus-summary-sort-by-author 1681 "\C-c\C-s\C-s" gnus-summary-sort-by-subject
1384 "\C-c\C-s\C-s" gnus-summary-sort-by-subject 1682 "\C-c\C-s\C-d" gnus-summary-sort-by-date
1385 "\C-c\C-s\C-d" gnus-summary-sort-by-date 1683 "\C-c\C-s\C-i" gnus-summary-sort-by-score
1386 "\C-c\C-s\C-i" gnus-summary-sort-by-score 1684 "\C-c\C-s\C-o" gnus-summary-sort-by-original
1387 "=" gnus-summary-expand-window 1685 "\C-c\C-s\C-r" gnus-summary-sort-by-random
1388 "\C-x\C-s" gnus-summary-reselect-current-group 1686 "=" gnus-summary-expand-window
1389 "\M-g" gnus-summary-rescan-group 1687 "\C-x\C-s" gnus-summary-reselect-current-group
1390 "w" gnus-summary-stop-page-breaking 1688 "\M-g" gnus-summary-rescan-group
1391 "\C-c\C-r" gnus-summary-caesar-message 1689 "w" gnus-summary-stop-page-breaking
1392 "f" gnus-summary-followup 1690 "\C-c\C-r" gnus-summary-caesar-message
1393 "F" gnus-summary-followup-with-original 1691 "f" gnus-summary-followup
1394 "C" gnus-summary-cancel-article 1692 "F" gnus-summary-followup-with-original
1395 "r" gnus-summary-reply 1693 "C" gnus-summary-cancel-article
1396 "R" gnus-summary-reply-with-original 1694 "r" gnus-summary-reply
1397 "\C-c\C-f" gnus-summary-mail-forward 1695 "R" gnus-summary-reply-with-original
1398 "o" gnus-summary-save-article 1696 "\C-c\C-f" gnus-summary-mail-forward
1399 "\C-o" gnus-summary-save-article-mail 1697 "o" gnus-summary-save-article
1400 "|" gnus-summary-pipe-output 1698 "\C-o" gnus-summary-save-article-mail
1401 "\M-k" gnus-summary-edit-local-kill 1699 "|" gnus-summary-pipe-output
1402 "\M-K" gnus-summary-edit-global-kill 1700 "\M-k" gnus-summary-edit-local-kill
1403 ;; "V" gnus-version 1701 "\M-K" gnus-summary-edit-global-kill
1404 "\C-c\C-d" gnus-summary-describe-group 1702 ;; "V" gnus-version
1405 "q" gnus-summary-exit 1703 "\C-c\C-d" gnus-summary-describe-group
1406 "Q" gnus-summary-exit-no-update 1704 "q" gnus-summary-exit
1407 "\C-c\C-i" gnus-info-find-node 1705 "Q" gnus-summary-exit-no-update
1408 gnus-mouse-2 gnus-mouse-pick-article 1706 "\C-c\C-i" gnus-info-find-node
1409 "m" gnus-summary-mail-other-window 1707 gnus-mouse-2 gnus-mouse-pick-article
1410 "a" gnus-summary-post-news 1708 [follow-link] mouse-face
1411 "x" gnus-summary-limit-to-unread 1709 "m" gnus-summary-mail-other-window
1412 "s" gnus-summary-isearch-article 1710 "a" gnus-summary-post-news
1413 "t" gnus-summary-toggle-header 1711 "i" gnus-summary-news-other-window
1414 "g" gnus-summary-show-article 1712 "x" gnus-summary-limit-to-unread
1415 "l" gnus-summary-goto-last-article 1713 "s" gnus-summary-isearch-article
1416 "\C-c\C-v\C-v" gnus-uu-decode-uu-view 1714 "t" gnus-summary-toggle-header
1417 "\C-d" gnus-summary-enter-digest-group 1715 "g" gnus-summary-show-article
1418 "\M-\C-d" gnus-summary-read-document 1716 "l" gnus-summary-goto-last-article
1419 "\M-\C-e" gnus-summary-edit-parameters 1717 "\C-c\C-v\C-v" gnus-uu-decode-uu-view
1420 "\M-\C-a" gnus-summary-customize-parameters 1718 "\C-d" gnus-summary-enter-digest-group
1421 "\C-c\C-b" gnus-bug 1719 "\M-\C-d" gnus-summary-read-document
1422 "*" gnus-cache-enter-article 1720 "\M-\C-e" gnus-summary-edit-parameters
1423 "\M-*" gnus-cache-remove-article 1721 "\M-\C-a" gnus-summary-customize-parameters
1424 "\M-&" gnus-summary-universal-argument 1722 "\C-c\C-b" gnus-bug
1425 "\C-l" gnus-recenter 1723 "*" gnus-cache-enter-article
1426 "I" gnus-summary-increase-score 1724 "\M-*" gnus-cache-remove-article
1427 "L" gnus-summary-lower-score 1725 "\M-&" gnus-summary-universal-argument
1428 "\M-i" gnus-symbolic-argument 1726 "\C-l" gnus-recenter
1429 "h" gnus-summary-select-article-buffer 1727 "I" gnus-summary-increase-score
1430 1728 "L" gnus-summary-lower-score
1431 "b" gnus-article-view-part 1729 "\M-i" gnus-symbolic-argument
1432 "\M-t" gnus-summary-toggle-display-buttonized 1730 "h" gnus-summary-select-article-buffer
1433 1731
1434 "V" gnus-summary-score-map 1732 "b" gnus-article-view-part
1435 "X" gnus-uu-extract-map 1733 "\M-t" gnus-summary-toggle-display-buttonized
1436 "S" gnus-summary-send-map) 1734
1437 1735 "V" gnus-summary-score-map
1438 ;; Sort of orthogonal keymap 1736 "X" gnus-uu-extract-map
1439 (gnus-define-keys (gnus-summary-mark-map "M" gnus-summary-mode-map) 1737 "S" gnus-summary-send-map)
1440 "t" gnus-summary-tick-article-forward 1738
1441 "!" gnus-summary-tick-article-forward 1739 ;; Sort of orthogonal keymap
1442 "d" gnus-summary-mark-as-read-forward 1740 (gnus-define-keys (gnus-summary-mark-map "M" gnus-summary-mode-map)
1443 "r" gnus-summary-mark-as-read-forward 1741 "t" gnus-summary-tick-article-forward
1444 "c" gnus-summary-clear-mark-forward 1742 "!" gnus-summary-tick-article-forward
1445 " " gnus-summary-clear-mark-forward 1743 "d" gnus-summary-mark-as-read-forward
1446 "e" gnus-summary-mark-as-expirable 1744 "r" gnus-summary-mark-as-read-forward
1447 "x" gnus-summary-mark-as-expirable 1745 "c" gnus-summary-clear-mark-forward
1448 "?" gnus-summary-mark-as-dormant 1746 " " gnus-summary-clear-mark-forward
1449 "b" gnus-summary-set-bookmark 1747 "e" gnus-summary-mark-as-expirable
1450 "B" gnus-summary-remove-bookmark 1748 "x" gnus-summary-mark-as-expirable
1451 "#" gnus-summary-mark-as-processable 1749 "?" gnus-summary-mark-as-dormant
1452 "\M-#" gnus-summary-unmark-as-processable 1750 "b" gnus-summary-set-bookmark
1453 "S" gnus-summary-limit-include-expunged 1751 "B" gnus-summary-remove-bookmark
1454 "C" gnus-summary-catchup 1752 "#" gnus-summary-mark-as-processable
1455 "H" gnus-summary-catchup-to-here 1753 "\M-#" gnus-summary-unmark-as-processable
1456 "\C-c" gnus-summary-catchup-all 1754 "S" gnus-summary-limit-include-expunged
1457 "k" gnus-summary-kill-same-subject-and-select 1755 "C" gnus-summary-catchup
1458 "K" gnus-summary-kill-same-subject 1756 "H" gnus-summary-catchup-to-here
1459 "P" gnus-uu-mark-map) 1757 "h" gnus-summary-catchup-from-here
1460 1758 "\C-c" gnus-summary-catchup-all
1461 (gnus-define-keys (gnus-summary-mscore-map "V" gnus-summary-mark-map) 1759 "k" gnus-summary-kill-same-subject-and-select
1462 "c" gnus-summary-clear-above 1760 "K" gnus-summary-kill-same-subject
1463 "u" gnus-summary-tick-above 1761 "P" gnus-uu-mark-map)
1464 "m" gnus-summary-mark-above 1762
1465 "k" gnus-summary-kill-below) 1763 (gnus-define-keys (gnus-summary-mscore-map "V" gnus-summary-mark-map)
1466 1764 "c" gnus-summary-clear-above
1467 (gnus-define-keys (gnus-summary-limit-map "/" gnus-summary-mode-map) 1765 "u" gnus-summary-tick-above
1468 "/" gnus-summary-limit-to-subject 1766 "m" gnus-summary-mark-above
1469 "n" gnus-summary-limit-to-articles 1767 "k" gnus-summary-kill-below)
1470 "w" gnus-summary-pop-limit 1768
1471 "s" gnus-summary-limit-to-subject 1769 (gnus-define-keys (gnus-summary-limit-map "/" gnus-summary-mode-map)
1472 "a" gnus-summary-limit-to-author 1770 "/" gnus-summary-limit-to-subject
1473 "u" gnus-summary-limit-to-unread 1771 "n" gnus-summary-limit-to-articles
1474 "m" gnus-summary-limit-to-marks 1772 "w" gnus-summary-pop-limit
1475 "M" gnus-summary-limit-exclude-marks 1773 "s" gnus-summary-limit-to-subject
1476 "v" gnus-summary-limit-to-score 1774 "a" gnus-summary-limit-to-author
1477 "*" gnus-summary-limit-include-cached 1775 "u" gnus-summary-limit-to-unread
1478 "D" gnus-summary-limit-include-dormant 1776 "m" gnus-summary-limit-to-marks
1479 "T" gnus-summary-limit-include-thread 1777 "M" gnus-summary-limit-exclude-marks
1480 "d" gnus-summary-limit-exclude-dormant 1778 "v" gnus-summary-limit-to-score
1481 "t" gnus-summary-limit-to-age 1779 "*" gnus-summary-limit-include-cached
1482 "x" gnus-summary-limit-to-extra 1780 "D" gnus-summary-limit-include-dormant
1483 "E" gnus-summary-limit-include-expunged 1781 "T" gnus-summary-limit-include-thread
1484 "c" gnus-summary-limit-exclude-childless-dormant 1782 "d" gnus-summary-limit-exclude-dormant
1485 "C" gnus-summary-limit-mark-excluded-as-read) 1783 "t" gnus-summary-limit-to-age
1486 1784 "." gnus-summary-limit-to-unseen
1487 (gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map) 1785 "x" gnus-summary-limit-to-extra
1488 "n" gnus-summary-next-unread-article 1786 "p" gnus-summary-limit-to-display-predicate
1489 "p" gnus-summary-prev-unread-article 1787 "E" gnus-summary-limit-include-expunged
1490 "N" gnus-summary-next-article 1788 "c" gnus-summary-limit-exclude-childless-dormant
1491 "P" gnus-summary-prev-article 1789 "C" gnus-summary-limit-mark-excluded-as-read
1492 "\C-n" gnus-summary-next-same-subject 1790 "o" gnus-summary-insert-old-articles
1493 "\C-p" gnus-summary-prev-same-subject 1791 "N" gnus-summary-insert-new-articles)
1494 "\M-n" gnus-summary-next-unread-subject 1792
1495 "\M-p" gnus-summary-prev-unread-subject 1793 (gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map)
1496 "f" gnus-summary-first-unread-article 1794 "n" gnus-summary-next-unread-article
1497 "b" gnus-summary-best-unread-article 1795 "p" gnus-summary-prev-unread-article
1498 "j" gnus-summary-goto-article 1796 "N" gnus-summary-next-article
1499 "g" gnus-summary-goto-subject 1797 "P" gnus-summary-prev-article
1500 "l" gnus-summary-goto-last-article 1798 "\C-n" gnus-summary-next-same-subject
1501 "o" gnus-summary-pop-article) 1799 "\C-p" gnus-summary-prev-same-subject
1502 1800 "\M-n" gnus-summary-next-unread-subject
1503 (gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map) 1801 "\M-p" gnus-summary-prev-unread-subject
1504 "k" gnus-summary-kill-thread 1802 "f" gnus-summary-first-unread-article
1505 "l" gnus-summary-lower-thread 1803 "b" gnus-summary-best-unread-article
1506 "i" gnus-summary-raise-thread 1804 "j" gnus-summary-goto-article
1507 "T" gnus-summary-toggle-threads 1805 "g" gnus-summary-goto-subject
1508 "t" gnus-summary-rethread-current 1806 "l" gnus-summary-goto-last-article
1509 "^" gnus-summary-reparent-thread 1807 "o" gnus-summary-pop-article)
1510 "s" gnus-summary-show-thread 1808
1511 "S" gnus-summary-show-all-threads 1809 (gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map)
1512 "h" gnus-summary-hide-thread 1810 "k" gnus-summary-kill-thread
1513 "H" gnus-summary-hide-all-threads 1811 "l" gnus-summary-lower-thread
1514 "n" gnus-summary-next-thread 1812 "i" gnus-summary-raise-thread
1515 "p" gnus-summary-prev-thread 1813 "T" gnus-summary-toggle-threads
1516 "u" gnus-summary-up-thread 1814 "t" gnus-summary-rethread-current
1517 "o" gnus-summary-top-thread 1815 "^" gnus-summary-reparent-thread
1518 "d" gnus-summary-down-thread 1816 "s" gnus-summary-show-thread
1519 "#" gnus-uu-mark-thread 1817 "S" gnus-summary-show-all-threads
1520 "\M-#" gnus-uu-unmark-thread) 1818 "h" gnus-summary-hide-thread
1521 1819 "H" gnus-summary-hide-all-threads
1522 (gnus-define-keys (gnus-summary-buffer-map "Y" gnus-summary-mode-map) 1820 "n" gnus-summary-next-thread
1523 "g" gnus-summary-prepare 1821 "p" gnus-summary-prev-thread
1524 "c" gnus-summary-insert-cached-articles) 1822 "u" gnus-summary-up-thread
1525 1823 "o" gnus-summary-top-thread
1526 (gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map) 1824 "d" gnus-summary-down-thread
1527 "c" gnus-summary-catchup-and-exit 1825 "#" gnus-uu-mark-thread
1528 "C" gnus-summary-catchup-all-and-exit 1826 "\M-#" gnus-uu-unmark-thread)
1529 "E" gnus-summary-exit-no-update 1827
1530 "Q" gnus-summary-exit 1828 (gnus-define-keys (gnus-summary-buffer-map "Y" gnus-summary-mode-map)
1531 "Z" gnus-summary-exit 1829 "g" gnus-summary-prepare
1532 "n" gnus-summary-catchup-and-goto-next-group 1830 "c" gnus-summary-insert-cached-articles
1533 "R" gnus-summary-reselect-current-group 1831 "d" gnus-summary-insert-dormant-articles)
1534 "G" gnus-summary-rescan-group 1832
1535 "N" gnus-summary-next-group 1833 (gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map)
1536 "s" gnus-summary-save-newsrc 1834 "c" gnus-summary-catchup-and-exit
1537 "P" gnus-summary-prev-group) 1835 "C" gnus-summary-catchup-all-and-exit
1538 1836 "E" gnus-summary-exit-no-update
1539 (gnus-define-keys (gnus-summary-article-map "A" gnus-summary-mode-map) 1837 "Q" gnus-summary-exit
1540 " " gnus-summary-next-page 1838 "Z" gnus-summary-exit
1541 "n" gnus-summary-next-page 1839 "n" gnus-summary-catchup-and-goto-next-group
1542 "\177" gnus-summary-prev-page 1840 "R" gnus-summary-reselect-current-group
1543 [delete] gnus-summary-prev-page 1841 "G" gnus-summary-rescan-group
1544 "p" gnus-summary-prev-page 1842 "N" gnus-summary-next-group
1545 "\r" gnus-summary-scroll-up 1843 "s" gnus-summary-save-newsrc
1546 "\M-\r" gnus-summary-scroll-down 1844 "P" gnus-summary-prev-group)
1547 "<" gnus-summary-beginning-of-article 1845
1548 ">" gnus-summary-end-of-article 1846 (gnus-define-keys (gnus-summary-article-map "A" gnus-summary-mode-map)
1549 "b" gnus-summary-beginning-of-article 1847 " " gnus-summary-next-page
1550 "e" gnus-summary-end-of-article 1848 "n" gnus-summary-next-page
1551 "^" gnus-summary-refer-parent-article 1849 "\177" gnus-summary-prev-page
1552 "r" gnus-summary-refer-parent-article 1850 [delete] gnus-summary-prev-page
1553 "D" gnus-summary-enter-digest-group 1851 "p" gnus-summary-prev-page
1554 "R" gnus-summary-refer-references 1852 "\r" gnus-summary-scroll-up
1555 "T" gnus-summary-refer-thread 1853 "\M-\r" gnus-summary-scroll-down
1556 "g" gnus-summary-show-article 1854 "<" gnus-summary-beginning-of-article
1557 "s" gnus-summary-isearch-article 1855 ">" gnus-summary-end-of-article
1558 "P" gnus-summary-print-article 1856 "b" gnus-summary-beginning-of-article
1559 "t" gnus-article-babel) 1857 "e" gnus-summary-end-of-article
1560 1858 "^" gnus-summary-refer-parent-article
1561 (gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map) 1859 "r" gnus-summary-refer-parent-article
1562 "b" gnus-article-add-buttons 1860 "D" gnus-summary-enter-digest-group
1563 "B" gnus-article-add-buttons-to-head 1861 "R" gnus-summary-refer-references
1564 "o" gnus-article-treat-overstrike 1862 "T" gnus-summary-refer-thread
1565 "e" gnus-article-emphasize 1863 "g" gnus-summary-show-article
1566 "w" gnus-article-fill-cited-article 1864 "s" gnus-summary-isearch-article
1567 "Q" gnus-article-fill-long-lines 1865 "P" gnus-summary-print-article
1568 "C" gnus-article-capitalize-sentences 1866 "M" gnus-mailing-list-insinuate
1569 "c" gnus-article-remove-cr 1867 "t" gnus-article-babel)
1570 "q" gnus-article-de-quoted-unreadable 1868
1571 "6" gnus-article-de-base64-unreadable 1869 (gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map)
1572 "Z" gnus-article-decode-HZ 1870 "b" gnus-article-add-buttons
1573 "h" gnus-article-wash-html 1871 "B" gnus-article-add-buttons-to-head
1574 "f" gnus-article-display-x-face 1872 "o" gnus-article-treat-overstrike
1575 "l" gnus-summary-stop-page-breaking 1873 "e" gnus-article-emphasize
1576 "r" gnus-summary-caesar-message 1874 "w" gnus-article-fill-cited-article
1577 "t" gnus-summary-toggle-header 1875 "Q" gnus-article-fill-long-lines
1578 "v" gnus-summary-verbose-headers 1876 "C" gnus-article-capitalize-sentences
1579 "H" gnus-article-strip-headers-in-body 1877 "c" gnus-article-remove-cr
1580 "d" gnus-article-treat-dumbquotes) 1878 "q" gnus-article-de-quoted-unreadable
1581 1879 "6" gnus-article-de-base64-unreadable
1582 (gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map) 1880 "Z" gnus-article-decode-HZ
1583 "a" gnus-article-hide 1881 "h" gnus-article-wash-html
1584 "h" gnus-article-hide-headers 1882 "u" gnus-article-unsplit-urls
1585 "b" gnus-article-hide-boring-headers 1883 "s" gnus-summary-force-verify-and-decrypt
1586 "s" gnus-article-hide-signature 1884 "f" gnus-article-display-x-face
1587 "c" gnus-article-hide-citation 1885 "l" gnus-summary-stop-page-breaking
1588 "C" gnus-article-hide-citation-in-followups 1886 "r" gnus-summary-caesar-message
1589 "l" gnus-article-hide-list-identifiers 1887 "m" gnus-summary-morse-message
1590 "p" gnus-article-hide-pgp 1888 "t" gnus-summary-toggle-header
1591 "B" gnus-article-strip-banner 1889 "g" gnus-treat-smiley
1592 "P" gnus-article-hide-pem 1890 "v" gnus-summary-verbose-headers
1593 "\C-c" gnus-article-hide-citation-maybe) 1891 "a" gnus-article-strip-headers-in-body ;; mnemonic: wash archive
1594 1892 "p" gnus-article-verify-x-pgp-sig
1595 (gnus-define-keys (gnus-summary-wash-highlight-map "H" gnus-summary-wash-map) 1893 "d" gnus-article-treat-dumbquotes)
1596 "a" gnus-article-highlight 1894
1597 "h" gnus-article-highlight-headers 1895 (gnus-define-keys (gnus-summary-wash-deuglify-map "Y" gnus-summary-wash-map)
1598 "c" gnus-article-highlight-citation 1896 ;; mnemonic: deuglif*Y*
1599 "s" gnus-article-highlight-signature) 1897 "u" gnus-article-outlook-unwrap-lines
1600 1898 "a" gnus-article-outlook-repair-attribution
1601 (gnus-define-keys (gnus-summary-wash-mime-map "M" gnus-summary-wash-map) 1899 "c" gnus-article-outlook-rearrange-citation
1602 "w" gnus-article-decode-mime-words 1900 "f" gnus-article-outlook-deuglify-article) ;; mnemonic: full deuglify
1603 "c" gnus-article-decode-charset 1901
1604 "v" gnus-mime-view-all-parts 1902 (gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
1605 "b" gnus-article-view-part) 1903 "a" gnus-article-hide
1606 1904 "h" gnus-article-hide-headers
1607 (gnus-define-keys (gnus-summary-wash-time-map "T" gnus-summary-wash-map) 1905 "b" gnus-article-hide-boring-headers
1608 "z" gnus-article-date-ut 1906 "s" gnus-article-hide-signature
1609 "u" gnus-article-date-ut 1907 "c" gnus-article-hide-citation
1610 "l" gnus-article-date-local 1908 "C" gnus-article-hide-citation-in-followups
1611 "e" gnus-article-date-lapsed 1909 "l" gnus-article-hide-list-identifiers
1612 "o" gnus-article-date-original 1910 "B" gnus-article-strip-banner
1613 "i" gnus-article-date-iso8601 1911 "P" gnus-article-hide-pem
1614 "s" gnus-article-date-user) 1912 "\C-c" gnus-article-hide-citation-maybe)
1615 1913
1616 (gnus-define-keys (gnus-summary-wash-empty-map "E" gnus-summary-wash-map) 1914 (gnus-define-keys (gnus-summary-wash-highlight-map "H" gnus-summary-wash-map)
1617 "t" gnus-article-remove-trailing-blank-lines 1915 "a" gnus-article-highlight
1618 "l" gnus-article-strip-leading-blank-lines 1916 "h" gnus-article-highlight-headers
1619 "m" gnus-article-strip-multiple-blank-lines 1917 "c" gnus-article-highlight-citation
1620 "a" gnus-article-strip-blank-lines 1918 "s" gnus-article-highlight-signature)
1621 "A" gnus-article-strip-all-blank-lines 1919
1622 "s" gnus-article-strip-leading-space 1920 (gnus-define-keys (gnus-summary-wash-header-map "G" gnus-summary-wash-map)
1623 "e" gnus-article-strip-trailing-space) 1921 "f" gnus-article-treat-fold-headers
1624 1922 "u" gnus-article-treat-unfold-headers
1625 (gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map) 1923 "n" gnus-article-treat-fold-newsgroups)
1626 "v" gnus-version 1924
1627 "f" gnus-summary-fetch-faq 1925 (gnus-define-keys (gnus-summary-wash-display-map "D" gnus-summary-wash-map)
1628 "d" gnus-summary-describe-group 1926 "x" gnus-article-display-x-face
1629 "h" gnus-summary-describe-briefly 1927 "d" gnus-article-display-face
1630 "i" gnus-info-find-node) 1928 "s" gnus-treat-smiley
1631 1929 "D" gnus-article-remove-images
1632 (gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map) 1930 "f" gnus-treat-from-picon
1633 "e" gnus-summary-expire-articles 1931 "m" gnus-treat-mail-picon
1634 "\M-\C-e" gnus-summary-expire-articles-now 1932 "n" gnus-treat-newsgroups-picon)
1635 "\177" gnus-summary-delete-article 1933
1636 [delete] gnus-summary-delete-article 1934 (gnus-define-keys (gnus-summary-wash-mime-map "M" gnus-summary-wash-map)
1637 [backspace] gnus-summary-delete-article 1935 "w" gnus-article-decode-mime-words
1638 "m" gnus-summary-move-article 1936 "c" gnus-article-decode-charset
1639 "r" gnus-summary-respool-article 1937 "v" gnus-mime-view-all-parts
1640 "w" gnus-summary-edit-article 1938 "b" gnus-article-view-part)
1641 "c" gnus-summary-copy-article 1939
1642 "B" gnus-summary-crosspost-article 1940 (gnus-define-keys (gnus-summary-wash-time-map "T" gnus-summary-wash-map)
1643 "q" gnus-summary-respool-query 1941 "z" gnus-article-date-ut
1644 "t" gnus-summary-respool-trace 1942 "u" gnus-article-date-ut
1645 "i" gnus-summary-import-article 1943 "l" gnus-article-date-local
1646 "p" gnus-summary-article-posted-p) 1944 "p" gnus-article-date-english
1647 1945 "e" gnus-article-date-lapsed
1648 (gnus-define-keys (gnus-summary-save-map "O" gnus-summary-mode-map) 1946 "o" gnus-article-date-original
1649 "o" gnus-summary-save-article 1947 "i" gnus-article-date-iso8601
1650 "m" gnus-summary-save-article-mail 1948 "s" gnus-article-date-user)
1651 "F" gnus-summary-write-article-file 1949
1652 "r" gnus-summary-save-article-rmail 1950 (gnus-define-keys (gnus-summary-wash-empty-map "E" gnus-summary-wash-map)
1653 "f" gnus-summary-save-article-file 1951 "t" gnus-article-remove-trailing-blank-lines
1654 "b" gnus-summary-save-article-body-file 1952 "l" gnus-article-strip-leading-blank-lines
1655 "h" gnus-summary-save-article-folder 1953 "m" gnus-article-strip-multiple-blank-lines
1656 "v" gnus-summary-save-article-vm 1954 "a" gnus-article-strip-blank-lines
1657 "p" gnus-summary-pipe-output 1955 "A" gnus-article-strip-all-blank-lines
1658 "s" gnus-soup-add-article) 1956 "s" gnus-article-strip-leading-space
1659 1957 "e" gnus-article-strip-trailing-space
1660 (gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map) 1958 "w" gnus-article-remove-leading-whitespace)
1661 "b" gnus-summary-display-buttonized 1959
1662 "m" gnus-summary-repair-multipart 1960 (gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map)
1663 "v" gnus-article-view-part 1961 "v" gnus-version
1664 "o" gnus-article-save-part 1962 "f" gnus-summary-fetch-faq
1665 "c" gnus-article-copy-part 1963 "d" gnus-summary-describe-group
1666 "e" gnus-article-externalize-part 1964 "h" gnus-summary-describe-briefly
1667 "i" gnus-article-inline-part 1965 "i" gnus-info-find-node
1668 "|" gnus-article-pipe-part)) 1966 "c" gnus-group-fetch-charter
1967 "C" gnus-group-fetch-control)
1968
1969 (gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map)
1970 "e" gnus-summary-expire-articles
1971 "\M-\C-e" gnus-summary-expire-articles-now
1972 "\177" gnus-summary-delete-article
1973 [delete] gnus-summary-delete-article
1974 [backspace] gnus-summary-delete-article
1975 "m" gnus-summary-move-article
1976 "r" gnus-summary-respool-article
1977 "w" gnus-summary-edit-article
1978 "c" gnus-summary-copy-article
1979 "B" gnus-summary-crosspost-article
1980 "q" gnus-summary-respool-query
1981 "t" gnus-summary-respool-trace
1982 "i" gnus-summary-import-article
1983 "I" gnus-summary-create-article
1984 "p" gnus-summary-article-posted-p)
1985
1986 (gnus-define-keys (gnus-summary-save-map "O" gnus-summary-mode-map)
1987 "o" gnus-summary-save-article
1988 "m" gnus-summary-save-article-mail
1989 "F" gnus-summary-write-article-file
1990 "r" gnus-summary-save-article-rmail
1991 "f" gnus-summary-save-article-file
1992 "b" gnus-summary-save-article-body-file
1993 "h" gnus-summary-save-article-folder
1994 "v" gnus-summary-save-article-vm
1995 "p" gnus-summary-pipe-output
1996 "P" gnus-summary-muttprint
1997 "s" gnus-soup-add-article)
1998
1999 (gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map)
2000 "b" gnus-summary-display-buttonized
2001 "m" gnus-summary-repair-multipart
2002 "v" gnus-article-view-part
2003 "o" gnus-article-save-part
2004 "c" gnus-article-copy-part
2005 "C" gnus-article-view-part-as-charset
2006 "e" gnus-article-view-part-externally
2007 "E" gnus-article-encrypt-body
2008 "i" gnus-article-inline-part
2009 "|" gnus-article-pipe-part)
2010
2011 (gnus-define-keys (gnus-uu-mark-map "P" gnus-summary-mark-map)
2012 "p" gnus-summary-mark-as-processable
2013 "u" gnus-summary-unmark-as-processable
2014 "U" gnus-summary-unmark-all-processable
2015 "v" gnus-uu-mark-over
2016 "s" gnus-uu-mark-series
2017 "r" gnus-uu-mark-region
2018 "g" gnus-uu-unmark-region
2019 "R" gnus-uu-mark-by-regexp
2020 "G" gnus-uu-unmark-by-regexp
2021 "t" gnus-uu-mark-thread
2022 "T" gnus-uu-unmark-thread
2023 "a" gnus-uu-mark-all
2024 "b" gnus-uu-mark-buffer
2025 "S" gnus-uu-mark-sparse
2026 "k" gnus-summary-kill-process-mark
2027 "y" gnus-summary-yank-process-mark
2028 "w" gnus-summary-save-process-mark
2029 "i" gnus-uu-invert-processable)
2030
2031 (gnus-define-keys (gnus-uu-extract-map "X" gnus-summary-mode-map)
2032 ;;"x" gnus-uu-extract-any
2033 "m" gnus-summary-save-parts
2034 "u" gnus-uu-decode-uu
2035 "U" gnus-uu-decode-uu-and-save
2036 "s" gnus-uu-decode-unshar
2037 "S" gnus-uu-decode-unshar-and-save
2038 "o" gnus-uu-decode-save
2039 "O" gnus-uu-decode-save
2040 "b" gnus-uu-decode-binhex
2041 "B" gnus-uu-decode-binhex
2042 "p" gnus-uu-decode-postscript
2043 "P" gnus-uu-decode-postscript-and-save)
2044
2045 (gnus-define-keys
2046 (gnus-uu-extract-view-map "v" gnus-uu-extract-map)
2047 "u" gnus-uu-decode-uu-view
2048 "U" gnus-uu-decode-uu-and-save-view
2049 "s" gnus-uu-decode-unshar-view
2050 "S" gnus-uu-decode-unshar-and-save-view
2051 "o" gnus-uu-decode-save-view
2052 "O" gnus-uu-decode-save-view
2053 "b" gnus-uu-decode-binhex-view
2054 "B" gnus-uu-decode-binhex-view
2055 "p" gnus-uu-decode-postscript-view
2056 "P" gnus-uu-decode-postscript-and-save-view)
2057
2058 (defvar gnus-article-post-menu nil)
2059
2060 (defconst gnus-summary-menu-maxlen 20)
2061
2062 (defun gnus-summary-menu-split (menu)
2063 ;; If we have lots of elements, divide them into groups of 20
2064 ;; and make a pane (or submenu) for each one.
2065 (if (> (length menu) (/ (* gnus-summary-menu-maxlen 3) 2))
2066 (let ((menu menu) sublists next
2067 (i 1))
2068 (while menu
2069 ;; Pull off the next gnus-summary-menu-maxlen elements
2070 ;; and make them the next element of sublist.
2071 (setq next (nthcdr gnus-summary-menu-maxlen menu))
2072 (if next
2073 (setcdr (nthcdr (1- gnus-summary-menu-maxlen) menu)
2074 nil))
2075 (setq sublists (cons (cons (format "%s ... %s" (aref (car menu) 0)
2076 (aref (car (last menu)) 0)) menu)
2077 sublists))
2078 (setq i (1+ i))
2079 (setq menu next))
2080 (nreverse sublists))
2081 ;; Few elements--put them all in one pane.
2082 menu))
1669 2083
1670 (defun gnus-summary-make-menu-bar () 2084 (defun gnus-summary-make-menu-bar ()
1671 (gnus-turn-off-edit-menu 'summary) 2085 (gnus-turn-off-edit-menu 'summary)
1672 2086
1673 (unless (boundp 'gnus-summary-misc-menu) 2087 (unless (boundp 'gnus-summary-misc-menu)
1674 2088
1675 (easy-menu-define 2089 (easy-menu-define
1676 gnus-summary-kill-menu gnus-summary-mode-map "" 2090 gnus-summary-kill-menu gnus-summary-mode-map ""
1677 (cons 2091 (cons
1678 "Score" 2092 "Score"
1679 (nconc 2093 (nconc
1680 (list 2094 (list
1681 ["Enter score..." gnus-summary-score-entry t] 2095 ["Customize" gnus-score-customize t])
1682 ["Customize" gnus-score-customize t]) 2096 (gnus-make-score-map 'increase)
1683 (gnus-make-score-map 'increase) 2097 (gnus-make-score-map 'lower)
1684 (gnus-make-score-map 'lower) 2098 '(("Mark"
1685 '(("Mark" 2099 ["Kill below" gnus-summary-kill-below t]
1686 ["Kill below" gnus-summary-kill-below t] 2100 ["Mark above" gnus-summary-mark-above t]
1687 ["Mark above" gnus-summary-mark-above t] 2101 ["Tick above" gnus-summary-tick-above t]
1688 ["Tick above" gnus-summary-tick-above t] 2102 ["Clear above" gnus-summary-clear-above t])
1689 ["Clear above" gnus-summary-clear-above t]) 2103 ["Current score" gnus-summary-current-score t]
1690 ["Current score" gnus-summary-current-score t] 2104 ["Set score" gnus-summary-set-score t]
1691 ["Set score" gnus-summary-set-score t] 2105 ["Switch current score file..." gnus-score-change-score-file t]
1692 ["Switch current score file..." gnus-score-change-score-file t] 2106 ["Set mark below..." gnus-score-set-mark-below t]
1693 ["Set mark below..." gnus-score-set-mark-below t] 2107 ["Set expunge below..." gnus-score-set-expunge-below t]
1694 ["Set expunge below..." gnus-score-set-expunge-below t] 2108 ["Edit current score file" gnus-score-edit-current-scores t]
1695 ["Edit current score file" gnus-score-edit-current-scores t] 2109 ["Edit score file" gnus-score-edit-file t]
1696 ["Edit score file" gnus-score-edit-file t] 2110 ["Trace score" gnus-score-find-trace t]
1697 ["Trace score" gnus-score-find-trace t] 2111 ["Find words" gnus-score-find-favourite-words t]
1698 ["Find words" gnus-score-find-favourite-words t] 2112 ["Rescore buffer" gnus-summary-rescore t]
1699 ["Rescore buffer" gnus-summary-rescore t] 2113 ["Increase score..." gnus-summary-increase-score t]
1700 ["Increase score..." gnus-summary-increase-score t] 2114 ["Lower score..." gnus-summary-lower-score t]))))
1701 ["Lower score..." gnus-summary-lower-score t])))) 2115
1702 2116 ;; Define both the Article menu in the summary buffer and the
1703 ;; Define both the Article menu in the summary buffer and the equivalent 2117 ;; equivalent Commands menu in the article buffer here for
1704 ;; Commands menu in the article buffer here for consistency. 2118 ;; consistency.
1705 (let ((innards 2119 (let ((innards
1706 '(("Hide" 2120 `(("Hide"
1707 ["All" gnus-article-hide t] 2121 ["All" gnus-article-hide t]
1708 ["Headers" gnus-article-hide-headers t] 2122 ["Headers" gnus-article-hide-headers t]
1709 ["Signature" gnus-article-hide-signature t] 2123 ["Signature" gnus-article-hide-signature t]
1710 ["Citation" gnus-article-hide-citation t] 2124 ["Citation" gnus-article-hide-citation t]
1711 ["List identifiers" gnus-article-hide-list-identifiers t] 2125 ["List identifiers" gnus-article-hide-list-identifiers t]
1712 ["PGP" gnus-article-hide-pgp t]
1713 ["Banner" gnus-article-strip-banner t] 2126 ["Banner" gnus-article-strip-banner t]
1714 ["Boring headers" gnus-article-hide-boring-headers t]) 2127 ["Boring headers" gnus-article-hide-boring-headers t])
1715 ("Highlight" 2128 ("Highlight"
1716 ["All" gnus-article-highlight t] 2129 ["All" gnus-article-highlight t]
1717 ["Headers" gnus-article-highlight-headers t] 2130 ["Headers" gnus-article-highlight-headers t]
1718 ["Signature" gnus-article-highlight-signature t] 2131 ["Signature" gnus-article-highlight-signature t]
1719 ["Citation" gnus-article-highlight-citation t]) 2132 ["Citation" gnus-article-highlight-citation t])
1720 ("MIME" 2133 ("MIME"
1721 ["Words" gnus-article-decode-mime-words t] 2134 ["Words" gnus-article-decode-mime-words t]
1722 ["Charset" gnus-article-decode-charset t] 2135 ["Charset" gnus-article-decode-charset t]
1723 ["QP" gnus-article-de-quoted-unreadable t] 2136 ["QP" gnus-article-de-quoted-unreadable t]
1724 ["Base64" gnus-article-de-base64-unreadable t] 2137 ["Base64" gnus-article-de-base64-unreadable t]
1725 ["View all" gnus-mime-view-all-parts t]) 2138 ["View MIME buttons" gnus-summary-display-buttonized t]
1726 ("Date" 2139 ["View all" gnus-mime-view-all-parts t]
1727 ["Local" gnus-article-date-local t] 2140 ["Verify and Decrypt" gnus-summary-force-verify-and-decrypt t]
1728 ["ISO8601" gnus-article-date-iso8601 t] 2141 ["Encrypt body" gnus-article-encrypt-body
1729 ["UT" gnus-article-date-ut t] 2142 :active (not (gnus-group-read-only-p))
1730 ["Original" gnus-article-date-original t] 2143 ,@(if (featurep 'xemacs) nil
1731 ["Lapsed" gnus-article-date-lapsed t] 2144 '(:help "Encrypt the message body on disk"))]
1732 ["User-defined" gnus-article-date-user t]) 2145 ["Extract all parts..." gnus-summary-save-parts t]
1733 ("Washing" 2146 ("Multipart"
1734 ("Remove Blanks" 2147 ["Repair multipart" gnus-summary-repair-multipart t]
1735 ["Leading" gnus-article-strip-leading-blank-lines t] 2148 ["Pipe part..." gnus-article-pipe-part t]
1736 ["Multiple" gnus-article-strip-multiple-blank-lines t] 2149 ["Inline part" gnus-article-inline-part t]
1737 ["Trailing" gnus-article-remove-trailing-blank-lines t] 2150 ["Encrypt body" gnus-article-encrypt-body
1738 ["All of the above" gnus-article-strip-blank-lines t] 2151 :active (not (gnus-group-read-only-p))
1739 ["All" gnus-article-strip-all-blank-lines t] 2152 ,@(if (featurep 'xemacs) nil
1740 ["Leading space" gnus-article-strip-leading-space t] 2153 '(:help "Encrypt the message body on disk"))]
1741 ["Trailing space" gnus-article-strip-trailing-space t]) 2154 ["View part externally" gnus-article-view-part-externally t]
1742 ["Overstrike" gnus-article-treat-overstrike t] 2155 ["View part with charset..." gnus-article-view-part-as-charset t]
1743 ["Dumb quotes" gnus-article-treat-dumbquotes t] 2156 ["Copy part" gnus-article-copy-part t]
1744 ["Emphasis" gnus-article-emphasize t] 2157 ["Save part..." gnus-article-save-part t]
1745 ["Word wrap" gnus-article-fill-cited-article t] 2158 ["View part" gnus-article-view-part t]))
2159 ("Date"
2160 ["Local" gnus-article-date-local t]
2161 ["ISO8601" gnus-article-date-iso8601 t]
2162 ["UT" gnus-article-date-ut t]
2163 ["Original" gnus-article-date-original t]
2164 ["Lapsed" gnus-article-date-lapsed t]
2165 ["User-defined" gnus-article-date-user t])
2166 ("Display"
2167 ["Remove images" gnus-article-remove-images t]
2168 ["Toggle smiley" gnus-treat-smiley t]
2169 ["Show X-Face" gnus-article-display-x-face t]
2170 ["Show picons in From" gnus-treat-from-picon t]
2171 ["Show picons in mail headers" gnus-treat-mail-picon t]
2172 ["Show picons in news headers" gnus-treat-newsgroups-picon t]
2173 ("View as different encoding"
2174 ,@(gnus-summary-menu-split
2175 (mapcar
2176 (lambda (cs)
2177 ;; Since easymenu under Emacs doesn't allow
2178 ;; lambda forms for menu commands, we should
2179 ;; provide intern'ed function symbols.
2180 (let ((command (intern (format "\
2181 gnus-summary-show-article-from-menu-as-charset-%s" cs))))
2182 (fset command
2183 `(lambda ()
2184 (interactive)
2185 (let ((gnus-summary-show-article-charset-alist
2186 '((1 . ,cs))))
2187 (gnus-summary-show-article 1))))
2188 `[,(symbol-name cs) ,command t]))
2189 (sort (if (fboundp 'coding-system-list)
2190 (coding-system-list)
2191 (mapcar 'car mm-mime-mule-charset-alist))
2192 'string<)))))
2193 ("Washing"
2194 ("Remove Blanks"
2195 ["Leading" gnus-article-strip-leading-blank-lines t]
2196 ["Multiple" gnus-article-strip-multiple-blank-lines t]
2197 ["Trailing" gnus-article-remove-trailing-blank-lines t]
2198 ["All of the above" gnus-article-strip-blank-lines t]
2199 ["All" gnus-article-strip-all-blank-lines t]
2200 ["Leading space" gnus-article-strip-leading-space t]
2201 ["Trailing space" gnus-article-strip-trailing-space t]
2202 ["Leading space in headers"
2203 gnus-article-remove-leading-whitespace t])
2204 ["Overstrike" gnus-article-treat-overstrike t]
2205 ["Dumb quotes" gnus-article-treat-dumbquotes t]
2206 ["Emphasis" gnus-article-emphasize t]
2207 ["Word wrap" gnus-article-fill-cited-article t]
1746 ["Fill long lines" gnus-article-fill-long-lines t] 2208 ["Fill long lines" gnus-article-fill-long-lines t]
1747 ["Capitalize sentences" gnus-article-capitalize-sentences t] 2209 ["Capitalize sentences" gnus-article-capitalize-sentences t]
1748 ["CR" gnus-article-remove-cr t] 2210 ["Remove CR" gnus-article-remove-cr t]
1749 ["Show X-Face" gnus-article-display-x-face t] 2211 ["Quoted-Printable" gnus-article-de-quoted-unreadable t]
1750 ["Quoted-Printable" gnus-article-de-quoted-unreadable t] 2212 ["Base64" gnus-article-de-base64-unreadable t]
1751 ["Base64" gnus-article-de-base64-unreadable t] 2213 ["Rot 13" gnus-summary-caesar-message
1752 ["Rot 13" gnus-summary-caesar-message 2214 ,@(if (featurep 'xemacs) '(t)
1753 :help "\"Caesar rotate\" article by 13"] 2215 '(:help "\"Caesar rotate\" article by 13"))]
1754 ["Unix pipe" gnus-summary-pipe-message t] 2216 ["Morse decode" gnus-summary-morse-message t]
1755 ["Add buttons" gnus-article-add-buttons t] 2217 ["Unix pipe..." gnus-summary-pipe-message t]
1756 ["Add buttons to head" gnus-article-add-buttons-to-head t] 2218 ["Add buttons" gnus-article-add-buttons t]
1757 ["Stop page breaking" gnus-summary-stop-page-breaking t] 2219 ["Add buttons to head" gnus-article-add-buttons-to-head t]
1758 ["Verbose header" gnus-summary-verbose-headers t] 2220 ["Stop page breaking" gnus-summary-stop-page-breaking t]
1759 ["Toggle header" gnus-summary-toggle-header t] 2221 ["Verbose header" gnus-summary-verbose-headers t]
2222 ["Toggle header" gnus-summary-toggle-header t]
2223 ["Unfold headers" gnus-article-treat-unfold-headers t]
2224 ["Fold newsgroups" gnus-article-treat-fold-newsgroups t]
1760 ["Html" gnus-article-wash-html t] 2225 ["Html" gnus-article-wash-html t]
1761 ["HZ" gnus-article-decode-HZ t]) 2226 ["Unsplit URLs" gnus-article-unsplit-urls t]
1762 ("Output" 2227 ["Verify X-PGP-Sig" gnus-article-verify-x-pgp-sig t]
1763 ["Save in default format" gnus-summary-save-article 2228 ["Decode HZ" gnus-article-decode-HZ t]
1764 :help "Save article using default method"] 2229 ("(Outlook) Deuglify"
1765 ["Save in file" gnus-summary-save-article-file 2230 ["Unwrap lines" gnus-article-outlook-unwrap-lines t]
1766 :help "Save article in file"] 2231 ["Repair attribution" gnus-article-outlook-repair-attribution t]
1767 ["Save in Unix mail format" gnus-summary-save-article-mail t] 2232 ["Rearrange citation" gnus-article-outlook-rearrange-citation t]
1768 ["Save in MH folder" gnus-summary-save-article-folder t] 2233 ["Full (Outlook) deuglify"
1769 ["Save in VM folder" gnus-summary-save-article-vm t] 2234 gnus-article-outlook-deuglify-article t])
1770 ["Save in RMAIL mbox" gnus-summary-save-article-rmail t] 2235 )
1771 ["Save body in file" gnus-summary-save-article-body-file t] 2236 ("Output"
1772 ["Pipe through a filter" gnus-summary-pipe-output t] 2237 ["Save in default format..." gnus-summary-save-article
1773 ["Add to SOUP packet" gnus-soup-add-article t] 2238 ,@(if (featurep 'xemacs) '(t)
1774 ["Print" gnus-summary-print-article t]) 2239 '(:help "Save article using default method"))]
1775 ("Backend" 2240 ["Save in file..." gnus-summary-save-article-file
1776 ["Respool article..." gnus-summary-respool-article t] 2241 ,@(if (featurep 'xemacs) '(t)
1777 ["Move article..." gnus-summary-move-article 2242 '(:help "Save article in file"))]
1778 (gnus-check-backend-function 2243 ["Save in Unix mail format..." gnus-summary-save-article-mail t]
1779 'request-move-article gnus-newsgroup-name)] 2244 ["Save in MH folder..." gnus-summary-save-article-folder t]
1780 ["Copy article..." gnus-summary-copy-article t] 2245 ["Save in VM folder..." gnus-summary-save-article-vm t]
1781 ["Crosspost article..." gnus-summary-crosspost-article 2246 ["Save in RMAIL mbox..." gnus-summary-save-article-rmail t]
1782 (gnus-check-backend-function 2247 ["Save body in file..." gnus-summary-save-article-body-file t]
1783 'request-replace-article gnus-newsgroup-name)] 2248 ["Pipe through a filter..." gnus-summary-pipe-output t]
1784 ["Import file..." gnus-summary-import-article t] 2249 ["Add to SOUP packet" gnus-soup-add-article t]
1785 ["Check if posted" gnus-summary-article-posted-p t] 2250 ["Print with Muttprint..." gnus-summary-muttprint t]
1786 ["Edit article" gnus-summary-edit-article 2251 ["Print" gnus-summary-print-article
1787 (not (gnus-group-read-only-p))] 2252 ,@(if (featurep 'xemacs) '(t)
1788 ["Delete article" gnus-summary-delete-article 2253 '(:help "Generate and print a PostScript image"))])
1789 (gnus-check-backend-function 2254 ("Copy, move,... (Backend)"
1790 'request-expire-articles gnus-newsgroup-name)] 2255 ,@(if (featurep 'xemacs) nil
1791 ["Query respool" gnus-summary-respool-query t] 2256 '(:help "Copying, moving, expiring articles..."))
2257 ["Respool article..." gnus-summary-respool-article t]
2258 ["Move article..." gnus-summary-move-article
2259 (gnus-check-backend-function
2260 'request-move-article gnus-newsgroup-name)]
2261 ["Copy article..." gnus-summary-copy-article t]
2262 ["Crosspost article..." gnus-summary-crosspost-article
2263 (gnus-check-backend-function
2264 'request-replace-article gnus-newsgroup-name)]
2265 ["Import file..." gnus-summary-import-article
2266 (gnus-check-backend-function
2267 'request-accept-article gnus-newsgroup-name)]
2268 ["Create article..." gnus-summary-create-article
2269 (gnus-check-backend-function
2270 'request-accept-article gnus-newsgroup-name)]
2271 ["Check if posted" gnus-summary-article-posted-p t]
2272 ["Edit article" gnus-summary-edit-article
2273 (not (gnus-group-read-only-p))]
2274 ["Delete article" gnus-summary-delete-article
2275 (gnus-check-backend-function
2276 'request-expire-articles gnus-newsgroup-name)]
2277 ["Query respool" gnus-summary-respool-query t]
1792 ["Trace respool" gnus-summary-respool-trace t] 2278 ["Trace respool" gnus-summary-respool-trace t]
1793 ["Delete expirable articles" gnus-summary-expire-articles-now 2279 ["Delete expirable articles" gnus-summary-expire-articles-now
1794 (gnus-check-backend-function 2280 (gnus-check-backend-function
1795 'request-expire-articles gnus-newsgroup-name)]) 2281 'request-expire-articles gnus-newsgroup-name)])
1796 ("Extract" 2282 ("Extract"
1797 ["Uudecode" gnus-uu-decode-uu 2283 ["Uudecode" gnus-uu-decode-uu
1798 :help "Decode uuencoded article(s)"] 2284 ,@(if (featurep 'xemacs) '(t)
1799 ["Uudecode and save" gnus-uu-decode-uu-and-save t] 2285 '(:help "Decode uuencoded article(s)"))]
1800 ["Unshar" gnus-uu-decode-unshar t] 2286 ["Uudecode and save" gnus-uu-decode-uu-and-save t]
1801 ["Unshar and save" gnus-uu-decode-unshar-and-save t] 2287 ["Unshar" gnus-uu-decode-unshar t]
1802 ["Save" gnus-uu-decode-save t] 2288 ["Unshar and save" gnus-uu-decode-unshar-and-save t]
1803 ["Binhex" gnus-uu-decode-binhex t] 2289 ["Save" gnus-uu-decode-save t]
1804 ["Postscript" gnus-uu-decode-postscript t]) 2290 ["Binhex" gnus-uu-decode-binhex t]
1805 ("Cache" 2291 ["Postscript" gnus-uu-decode-postscript t]
1806 ["Enter article" gnus-cache-enter-article t] 2292 ["All MIME parts" gnus-summary-save-parts t])
1807 ["Remove article" gnus-cache-remove-article t]) 2293 ("Cache"
2294 ["Enter article" gnus-cache-enter-article t]
2295 ["Remove article" gnus-cache-remove-article t])
1808 ["Translate" gnus-article-babel t] 2296 ["Translate" gnus-article-babel t]
1809 ["Select article buffer" gnus-summary-select-article-buffer t] 2297 ["Select article buffer" gnus-summary-select-article-buffer t]
1810 ["Enter digest buffer" gnus-summary-enter-digest-group t] 2298 ["Enter digest buffer" gnus-summary-enter-digest-group t]
1811 ["Isearch article..." gnus-summary-isearch-article t] 2299 ["Isearch article..." gnus-summary-isearch-article t]
1812 ["Beginning of the article" gnus-summary-beginning-of-article t] 2300 ["Beginning of the article" gnus-summary-beginning-of-article t]
1813 ["End of the article" gnus-summary-end-of-article t] 2301 ["End of the article" gnus-summary-end-of-article t]
1814 ["Fetch parent of article" gnus-summary-refer-parent-article t] 2302 ["Fetch parent of article" gnus-summary-refer-parent-article t]
1815 ["Fetch referenced articles" gnus-summary-refer-references t] 2303 ["Fetch referenced articles" gnus-summary-refer-references t]
1816 ["Fetch current thread" gnus-summary-refer-thread t] 2304 ["Fetch current thread" gnus-summary-refer-thread t]
1817 ["Fetch article with id..." gnus-summary-refer-article t] 2305 ["Fetch article with id..." gnus-summary-refer-article t]
1818 ["Redisplay" gnus-summary-show-article t]))) 2306 ["Setup Mailing List Params" gnus-mailing-list-insinuate t]
2307 ["Redisplay" gnus-summary-show-article t]
2308 ["Raw article" gnus-summary-show-raw-article :keys "C-u g"])))
1819 (easy-menu-define 2309 (easy-menu-define
1820 gnus-summary-article-menu gnus-summary-mode-map "" 2310 gnus-summary-article-menu gnus-summary-mode-map ""
1821 (cons "Article" innards)) 2311 (cons "Article" innards))
1822 2312
1823 (if (not (keymapp gnus-summary-article-menu)) 2313 (if (not (keymapp gnus-summary-article-menu))
1824 (easy-menu-define 2314 (easy-menu-define
1825 gnus-article-commands-menu gnus-article-mode-map "" 2315 gnus-article-commands-menu gnus-article-mode-map ""
1826 (cons "Commands" innards)) 2316 (cons "Commands" innards))
1829 (copy-keymap gnus-summary-article-menu)) 2319 (copy-keymap gnus-summary-article-menu))
1830 (define-key gnus-article-mode-map [menu-bar commands] 2320 (define-key gnus-article-mode-map [menu-bar commands]
1831 (cons "Commands" gnus-article-commands-menu)))) 2321 (cons "Commands" gnus-article-commands-menu))))
1832 2322
1833 (easy-menu-define 2323 (easy-menu-define
1834 gnus-summary-thread-menu gnus-summary-mode-map "" 2324 gnus-summary-thread-menu gnus-summary-mode-map ""
1835 '("Threads" 2325 '("Threads"
1836 ["Toggle threading" gnus-summary-toggle-threads t] 2326 ["Find all messages in thread" gnus-summary-refer-thread t]
1837 ["Hide threads" gnus-summary-hide-all-threads t] 2327 ["Toggle threading" gnus-summary-toggle-threads t]
1838 ["Show threads" gnus-summary-show-all-threads t] 2328 ["Hide threads" gnus-summary-hide-all-threads t]
1839 ["Hide thread" gnus-summary-hide-thread t] 2329 ["Show threads" gnus-summary-show-all-threads t]
1840 ["Show thread" gnus-summary-show-thread t] 2330 ["Hide thread" gnus-summary-hide-thread t]
1841 ["Go to next thread" gnus-summary-next-thread t] 2331 ["Show thread" gnus-summary-show-thread t]
1842 ["Go to previous thread" gnus-summary-prev-thread t] 2332 ["Go to next thread" gnus-summary-next-thread t]
1843 ["Go down thread" gnus-summary-down-thread t] 2333 ["Go to previous thread" gnus-summary-prev-thread t]
1844 ["Go up thread" gnus-summary-up-thread t] 2334 ["Go down thread" gnus-summary-down-thread t]
1845 ["Top of thread" gnus-summary-top-thread t] 2335 ["Go up thread" gnus-summary-up-thread t]
1846 ["Mark thread as read" gnus-summary-kill-thread t] 2336 ["Top of thread" gnus-summary-top-thread t]
1847 ["Lower thread score" gnus-summary-lower-thread t] 2337 ["Mark thread as read" gnus-summary-kill-thread t]
1848 ["Raise thread score" gnus-summary-raise-thread t] 2338 ["Lower thread score" gnus-summary-lower-thread t]
1849 ["Rethread current" gnus-summary-rethread-current t])) 2339 ["Raise thread score" gnus-summary-raise-thread t]
2340 ["Rethread current" gnus-summary-rethread-current t]))
1850 2341
1851 (easy-menu-define 2342 (easy-menu-define
1852 gnus-summary-post-menu gnus-summary-mode-map "" 2343 gnus-summary-post-menu gnus-summary-mode-map ""
1853 '("Post" 2344 `("Post"
1854 ["Post an article" gnus-summary-post-news 2345 ["Send a message (mail or news)" gnus-summary-post-news
1855 :help "Post an article"] 2346 ,@(if (featurep 'xemacs) '(t)
1856 ["Followup" gnus-summary-followup 2347 '(:help "Compose a new message (mail or news)"))]
1857 :help "Post followup to this article"] 2348 ["Followup" gnus-summary-followup
1858 ["Followup and yank" gnus-summary-followup-with-original 2349 ,@(if (featurep 'xemacs) '(t)
1859 :help "Post followup to this article, quoting its contents"] 2350 '(:help "Post followup to this article"))]
1860 ["Supersede article" gnus-summary-supersede-article t] 2351 ["Followup and yank" gnus-summary-followup-with-original
1861 ["Cancel article" gnus-summary-cancel-article 2352 ,@(if (featurep 'xemacs) '(t)
1862 :help "Cancel an article you posted"] 2353 '(:help "Post followup to this article, quoting its contents"))]
1863 ["Reply" gnus-summary-reply t] 2354 ["Supersede article" gnus-summary-supersede-article t]
1864 ["Reply and yank" gnus-summary-reply-with-original t] 2355 ["Cancel article" gnus-summary-cancel-article
1865 ["Wide reply" gnus-summary-wide-reply t] 2356 ,@(if (featurep 'xemacs) '(t)
1866 ["Wide reply and yank" gnus-summary-wide-reply-with-original 2357 '(:help "Cancel an article you posted"))]
1867 :help "Mail a reply, quoting this article"] 2358 ["Reply" gnus-summary-reply t]
1868 ["Mail forward" gnus-summary-mail-forward t] 2359 ["Reply and yank" gnus-summary-reply-with-original t]
1869 ["Post forward" gnus-summary-post-forward t] 2360 ["Wide reply" gnus-summary-wide-reply t]
1870 ["Digest and mail" gnus-uu-digest-mail-forward t] 2361 ["Wide reply and yank" gnus-summary-wide-reply-with-original
1871 ["Digest and post" gnus-uu-digest-post-forward t] 2362 ,@(if (featurep 'xemacs) '(t)
1872 ["Resend message" gnus-summary-resend-message t] 2363 '(:help "Mail a reply, quoting this article"))]
1873 ["Send bounced mail" gnus-summary-resend-bounced-mail t] 2364 ["Very wide reply" gnus-summary-very-wide-reply t]
1874 ["Send a mail" gnus-summary-mail-other-window t] 2365 ["Very wide reply and yank" gnus-summary-very-wide-reply-with-original
1875 ["Uuencode and post" gnus-uu-post-news 2366 ,@(if (featurep 'xemacs) '(t)
1876 :help "Post a uuencoded article"] 2367 '(:help "Mail a very wide reply, quoting this article"))]
1877 ["Followup via news" gnus-summary-followup-to-mail t] 2368 ["Mail forward" gnus-summary-mail-forward t]
1878 ["Followup via news and yank" 2369 ["Post forward" gnus-summary-post-forward t]
1879 gnus-summary-followup-to-mail-with-original t] 2370 ["Digest and mail" gnus-uu-digest-mail-forward t]
1880 ;;("Draft" 2371 ["Digest and post" gnus-uu-digest-post-forward t]
1881 ;;["Send" gnus-summary-send-draft t] 2372 ["Resend message" gnus-summary-resend-message t]
1882 ;;["Send bounced" gnus-resend-bounced-mail t]) 2373 ["Resend message edit" gnus-summary-resend-message-edit t]
1883 )) 2374 ["Send bounced mail" gnus-summary-resend-bounced-mail t]
2375 ["Send a mail" gnus-summary-mail-other-window t]
2376 ["Create a local message" gnus-summary-news-other-window t]
2377 ["Uuencode and post" gnus-uu-post-news
2378 ,@(if (featurep 'xemacs) '(t)
2379 '(:help "Post a uuencoded article"))]
2380 ["Followup via news" gnus-summary-followup-to-mail t]
2381 ["Followup via news and yank"
2382 gnus-summary-followup-to-mail-with-original t]
2383 ;;("Draft"
2384 ;;["Send" gnus-summary-send-draft t]
2385 ;;["Send bounced" gnus-resend-bounced-mail t])
2386 ))
2387
2388 (cond
2389 ((not (keymapp gnus-summary-post-menu))
2390 (setq gnus-article-post-menu gnus-summary-post-menu))
2391 ((not gnus-article-post-menu)
2392 ;; Don't share post menu.
2393 (setq gnus-article-post-menu
2394 (copy-keymap gnus-summary-post-menu))))
2395 (define-key gnus-article-mode-map [menu-bar post]
2396 (cons "Post" gnus-article-post-menu))
1884 2397
1885 (easy-menu-define 2398 (easy-menu-define
1886 gnus-summary-misc-menu gnus-summary-mode-map "" 2399 gnus-summary-misc-menu gnus-summary-mode-map ""
1887 '("Misc" 2400 `("Gnus"
1888 ("Mark Read" 2401 ("Mark Read"
1889 ["Mark as read" gnus-summary-mark-as-read-forward t] 2402 ["Mark as read" gnus-summary-mark-as-read-forward t]
1890 ["Mark same subject and select" 2403 ["Mark same subject and select"
1891 gnus-summary-kill-same-subject-and-select t] 2404 gnus-summary-kill-same-subject-and-select t]
1892 ["Mark same subject" gnus-summary-kill-same-subject t] 2405 ["Mark same subject" gnus-summary-kill-same-subject t]
1893 ["Catchup" gnus-summary-catchup 2406 ["Catchup" gnus-summary-catchup
1894 :help "Mark unread articles in this group as read"] 2407 ,@(if (featurep 'xemacs) '(t)
1895 ["Catchup all" gnus-summary-catchup-all t] 2408 '(:help "Mark unread articles in this group as read"))]
1896 ["Catchup to here" gnus-summary-catchup-to-here t] 2409 ["Catchup all" gnus-summary-catchup-all t]
1897 ["Catchup region" gnus-summary-mark-region-as-read t] 2410 ["Catchup to here" gnus-summary-catchup-to-here t]
1898 ["Mark excluded" gnus-summary-limit-mark-excluded-as-read t]) 2411 ["Catchup from here" gnus-summary-catchup-from-here t]
1899 ("Mark Various" 2412 ["Catchup region" gnus-summary-mark-region-as-read
1900 ["Tick" gnus-summary-tick-article-forward t] 2413 (gnus-mark-active-p)]
1901 ["Mark as dormant" gnus-summary-mark-as-dormant t] 2414 ["Mark excluded" gnus-summary-limit-mark-excluded-as-read t])
1902 ["Remove marks" gnus-summary-clear-mark-forward t] 2415 ("Mark Various"
1903 ["Set expirable mark" gnus-summary-mark-as-expirable t] 2416 ["Tick" gnus-summary-tick-article-forward t]
1904 ["Set bookmark" gnus-summary-set-bookmark t] 2417 ["Mark as dormant" gnus-summary-mark-as-dormant t]
1905 ["Remove bookmark" gnus-summary-remove-bookmark t]) 2418 ["Remove marks" gnus-summary-clear-mark-forward t]
1906 ("Mark Limit" 2419 ["Set expirable mark" gnus-summary-mark-as-expirable t]
1907 ["Marks..." gnus-summary-limit-to-marks t] 2420 ["Set bookmark" gnus-summary-set-bookmark t]
1908 ["Subject..." gnus-summary-limit-to-subject t] 2421 ["Remove bookmark" gnus-summary-remove-bookmark t])
1909 ["Author..." gnus-summary-limit-to-author t] 2422 ("Limit to"
1910 ["Age..." gnus-summary-limit-to-age t] 2423 ["Marks..." gnus-summary-limit-to-marks t]
1911 ["Extra..." gnus-summary-limit-to-extra t] 2424 ["Subject..." gnus-summary-limit-to-subject t]
1912 ["Score" gnus-summary-limit-to-score t] 2425 ["Author..." gnus-summary-limit-to-author t]
1913 ["Unread" gnus-summary-limit-to-unread t] 2426 ["Age..." gnus-summary-limit-to-age t]
1914 ["Non-dormant" gnus-summary-limit-exclude-dormant t] 2427 ["Extra..." gnus-summary-limit-to-extra t]
1915 ["Articles" gnus-summary-limit-to-articles t] 2428 ["Score..." gnus-summary-limit-to-score t]
1916 ["Pop limit" gnus-summary-pop-limit t] 2429 ["Display Predicate" gnus-summary-limit-to-display-predicate t]
1917 ["Show dormant" gnus-summary-limit-include-dormant t] 2430 ["Unread" gnus-summary-limit-to-unread t]
1918 ["Hide childless dormant" 2431 ["Unseen" gnus-summary-limit-to-unseen t]
1919 gnus-summary-limit-exclude-childless-dormant t] 2432 ["Non-dormant" gnus-summary-limit-exclude-dormant t]
1920 ;;["Hide thread" gnus-summary-limit-exclude-thread t] 2433 ["Next articles" gnus-summary-limit-to-articles t]
1921 ["Hide marked" gnus-summary-limit-exclude-marks t] 2434 ["Pop limit" gnus-summary-pop-limit t]
1922 ["Show expunged" gnus-summary-show-all-expunged t]) 2435 ["Show dormant" gnus-summary-limit-include-dormant t]
1923 ("Process Mark" 2436 ["Hide childless dormant"
1924 ["Set mark" gnus-summary-mark-as-processable t] 2437 gnus-summary-limit-exclude-childless-dormant t]
1925 ["Remove mark" gnus-summary-unmark-as-processable t] 2438 ;;["Hide thread" gnus-summary-limit-exclude-thread t]
1926 ["Remove all marks" gnus-summary-unmark-all-processable t] 2439 ["Hide marked" gnus-summary-limit-exclude-marks t]
1927 ["Mark above" gnus-uu-mark-over t] 2440 ["Show expunged" gnus-summary-limit-include-expunged t])
1928 ["Mark series" gnus-uu-mark-series t] 2441 ("Process Mark"
1929 ["Mark region" gnus-uu-mark-region t] 2442 ["Set mark" gnus-summary-mark-as-processable t]
1930 ["Unmark region" gnus-uu-unmark-region t] 2443 ["Remove mark" gnus-summary-unmark-as-processable t]
1931 ["Mark by regexp..." gnus-uu-mark-by-regexp t] 2444 ["Remove all marks" gnus-summary-unmark-all-processable t]
1932 ["Unmark by regexp..." gnus-uu-unmark-by-regexp t] 2445 ["Mark above" gnus-uu-mark-over t]
1933 ["Mark all" gnus-uu-mark-all t] 2446 ["Mark series" gnus-uu-mark-series t]
1934 ["Mark buffer" gnus-uu-mark-buffer t] 2447 ["Mark region" gnus-uu-mark-region (gnus-mark-active-p)]
1935 ["Mark sparse" gnus-uu-mark-sparse t] 2448 ["Unmark region" gnus-uu-unmark-region (gnus-mark-active-p)]
1936 ["Mark thread" gnus-uu-mark-thread t] 2449 ["Mark by regexp..." gnus-uu-mark-by-regexp t]
1937 ["Unmark thread" gnus-uu-unmark-thread t] 2450 ["Unmark by regexp..." gnus-uu-unmark-by-regexp t]
1938 ("Process Mark Sets" 2451 ["Mark all" gnus-uu-mark-all t]
1939 ["Kill" gnus-summary-kill-process-mark t] 2452 ["Mark buffer" gnus-uu-mark-buffer t]
1940 ["Yank" gnus-summary-yank-process-mark 2453 ["Mark sparse" gnus-uu-mark-sparse t]
1941 gnus-newsgroup-process-stack] 2454 ["Mark thread" gnus-uu-mark-thread t]
1942 ["Save" gnus-summary-save-process-mark t])) 2455 ["Unmark thread" gnus-uu-unmark-thread t]
1943 ("Scroll article" 2456 ("Process Mark Sets"
1944 ["Page forward" gnus-summary-next-page 2457 ["Kill" gnus-summary-kill-process-mark t]
1945 :help "Show next page of article"] 2458 ["Yank" gnus-summary-yank-process-mark
1946 ["Page backward" gnus-summary-prev-page 2459 gnus-newsgroup-process-stack]
1947 :help "Show previous page of article"] 2460 ["Save" gnus-summary-save-process-mark t]
1948 ["Line forward" gnus-summary-scroll-up t]) 2461 ["Run command on marked..." gnus-summary-universal-argument t]))
1949 ("Move" 2462 ("Scroll article"
1950 ["Next unread article" gnus-summary-next-unread-article t] 2463 ["Page forward" gnus-summary-next-page
1951 ["Previous unread article" gnus-summary-prev-unread-article t] 2464 ,@(if (featurep 'xemacs) '(t)
1952 ["Next article" gnus-summary-next-article t] 2465 '(:help "Show next page of article"))]
1953 ["Previous article" gnus-summary-prev-article t] 2466 ["Page backward" gnus-summary-prev-page
1954 ["Next unread subject" gnus-summary-next-unread-subject t] 2467 ,@(if (featurep 'xemacs) '(t)
1955 ["Previous unread subject" gnus-summary-prev-unread-subject t] 2468 '(:help "Show previous page of article"))]
1956 ["Next article same subject" gnus-summary-next-same-subject t] 2469 ["Line forward" gnus-summary-scroll-up t])
1957 ["Previous article same subject" gnus-summary-prev-same-subject t] 2470 ("Move"
1958 ["First unread article" gnus-summary-first-unread-article t] 2471 ["Next unread article" gnus-summary-next-unread-article t]
1959 ["Best unread article" gnus-summary-best-unread-article t] 2472 ["Previous unread article" gnus-summary-prev-unread-article t]
1960 ["Go to subject number..." gnus-summary-goto-subject t] 2473 ["Next article" gnus-summary-next-article t]
1961 ["Go to article number..." gnus-summary-goto-article t] 2474 ["Previous article" gnus-summary-prev-article t]
1962 ["Go to the last article" gnus-summary-goto-last-article t] 2475 ["Next unread subject" gnus-summary-next-unread-subject t]
1963 ["Pop article off history" gnus-summary-pop-article t]) 2476 ["Previous unread subject" gnus-summary-prev-unread-subject t]
1964 ("Sort" 2477 ["Next article same subject" gnus-summary-next-same-subject t]
1965 ["Sort by number" gnus-summary-sort-by-number t] 2478 ["Previous article same subject" gnus-summary-prev-same-subject t]
1966 ["Sort by author" gnus-summary-sort-by-author t] 2479 ["First unread article" gnus-summary-first-unread-article t]
1967 ["Sort by subject" gnus-summary-sort-by-subject t] 2480 ["Best unread article" gnus-summary-best-unread-article t]
1968 ["Sort by date" gnus-summary-sort-by-date t] 2481 ["Go to subject number..." gnus-summary-goto-subject t]
1969 ["Sort by score" gnus-summary-sort-by-score t] 2482 ["Go to article number..." gnus-summary-goto-article t]
1970 ["Sort by lines" gnus-summary-sort-by-lines t] 2483 ["Go to the last article" gnus-summary-goto-last-article t]
1971 ["Sort by characters" gnus-summary-sort-by-chars t]) 2484 ["Pop article off history" gnus-summary-pop-article t])
1972 ("Help" 2485 ("Sort"
1973 ["Fetch group FAQ" gnus-summary-fetch-faq t] 2486 ["Sort by number" gnus-summary-sort-by-number t]
1974 ["Describe group" gnus-summary-describe-group t] 2487 ["Sort by author" gnus-summary-sort-by-author t]
1975 ["Read manual" gnus-info-find-node t]) 2488 ["Sort by subject" gnus-summary-sort-by-subject t]
1976 ("Modes" 2489 ["Sort by date" gnus-summary-sort-by-date t]
1977 ["Pick and read" gnus-pick-mode t] 2490 ["Sort by score" gnus-summary-sort-by-score t]
1978 ["Binary" gnus-binary-mode t]) 2491 ["Sort by lines" gnus-summary-sort-by-lines t]
1979 ("Regeneration" 2492 ["Sort by characters" gnus-summary-sort-by-chars t]
1980 ["Regenerate" gnus-summary-prepare t] 2493 ["Randomize" gnus-summary-sort-by-random t]
1981 ["Insert cached articles" gnus-summary-insert-cached-articles t] 2494 ["Original sort" gnus-summary-sort-by-original t])
1982 ["Toggle threading" gnus-summary-toggle-threads t]) 2495 ("Help"
1983 ["Filter articles..." gnus-summary-execute-command t] 2496 ["Fetch group FAQ" gnus-summary-fetch-faq t]
1984 ["Run command on subjects..." gnus-summary-universal-argument t] 2497 ["Describe group" gnus-summary-describe-group t]
1985 ["Search articles forward..." gnus-summary-search-article-forward t] 2498 ["Fetch charter" gnus-group-fetch-charter
1986 ["Search articles backward..." gnus-summary-search-article-backward t] 2499 ,@(if (featurep 'xemacs) nil
1987 ["Toggle line truncation" gnus-summary-toggle-truncation t] 2500 '(:help "Display the charter of the current group"))]
1988 ["Expand window" gnus-summary-expand-window t] 2501 ["Fetch control message" gnus-group-fetch-control
1989 ["Expire expirable articles" gnus-summary-expire-articles 2502 ,@(if (featurep 'xemacs) nil
1990 (gnus-check-backend-function 2503 '(:help "Display the archived control message for the current group"))]
1991 'request-expire-articles gnus-newsgroup-name)] 2504 ["Read manual" gnus-info-find-node t])
1992 ["Edit local kill file" gnus-summary-edit-local-kill t] 2505 ("Modes"
1993 ["Edit main kill file" gnus-summary-edit-global-kill t] 2506 ["Pick and read" gnus-pick-mode t]
1994 ["Edit group parameters" gnus-summary-edit-parameters t] 2507 ["Binary" gnus-binary-mode t])
1995 ["Customize group parameters" gnus-summary-customize-parameters t] 2508 ("Regeneration"
1996 ["Send a bug report" gnus-bug t] 2509 ["Regenerate" gnus-summary-prepare t]
1997 ("Exit" 2510 ["Insert cached articles" gnus-summary-insert-cached-articles t]
1998 ["Catchup and exit" gnus-summary-catchup-and-exit 2511 ["Insert dormant articles" gnus-summary-insert-dormant-articles t]
1999 :help "Mark unread articles in this group as read, then exit"] 2512 ["Toggle threading" gnus-summary-toggle-threads t])
2000 ["Catchup all and exit" gnus-summary-catchup-all-and-exit t] 2513 ["See old articles" gnus-summary-insert-old-articles t]
2001 ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t] 2514 ["See new articles" gnus-summary-insert-new-articles t]
2002 ["Exit group" gnus-summary-exit 2515 ["Filter articles..." gnus-summary-execute-command t]
2003 :help "Exit current group, return to group selection mode"] 2516 ["Run command on articles..." gnus-summary-universal-argument t]
2004 ["Exit group without updating" gnus-summary-exit-no-update t] 2517 ["Search articles forward..." gnus-summary-search-article-forward t]
2005 ["Exit and goto next group" gnus-summary-next-group t] 2518 ["Search articles backward..." gnus-summary-search-article-backward t]
2006 ["Exit and goto prev group" gnus-summary-prev-group t] 2519 ["Toggle line truncation" gnus-summary-toggle-truncation t]
2007 ["Reselect group" gnus-summary-reselect-current-group t] 2520 ["Expand window" gnus-summary-expand-window t]
2008 ["Rescan group" gnus-summary-rescan-group t] 2521 ["Expire expirable articles" gnus-summary-expire-articles
2009 ["Update dribble" gnus-summary-save-newsrc t]))) 2522 (gnus-check-backend-function
2523 'request-expire-articles gnus-newsgroup-name)]
2524 ["Edit local kill file" gnus-summary-edit-local-kill t]
2525 ["Edit main kill file" gnus-summary-edit-global-kill t]
2526 ["Edit group parameters" gnus-summary-edit-parameters t]
2527 ["Customize group parameters" gnus-summary-customize-parameters t]
2528 ["Send a bug report" gnus-bug t]
2529 ("Exit"
2530 ["Catchup and exit" gnus-summary-catchup-and-exit
2531 ,@(if (featurep 'xemacs) '(t)
2532 '(:help "Mark unread articles in this group as read, then exit"))]
2533 ["Catchup all and exit" gnus-summary-catchup-all-and-exit t]
2534 ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t]
2535 ["Exit group" gnus-summary-exit
2536 ,@(if (featurep 'xemacs) '(t)
2537 '(:help "Exit current group, return to group selection mode"))]
2538 ["Exit group without updating" gnus-summary-exit-no-update t]
2539 ["Exit and goto next group" gnus-summary-next-group t]
2540 ["Exit and goto prev group" gnus-summary-prev-group t]
2541 ["Reselect group" gnus-summary-reselect-current-group t]
2542 ["Rescan group" gnus-summary-rescan-group t]
2543 ["Update dribble" gnus-summary-save-newsrc t])))
2010 2544
2011 (gnus-run-hooks 'gnus-summary-menu-hook))) 2545 (gnus-run-hooks 'gnus-summary-menu-hook)))
2012 2546
2013 (defvar gnus-summary-tool-bar-map nil) 2547 (defvar gnus-summary-tool-bar-map nil)
2014 2548
2015 ;; Emacs 21 tool bar. Should be no-op otherwise. 2549 ;; Emacs 21 tool bar. Should be no-op otherwise.
2016 ;; NB: A new function tool-bar-local-item-from-menu is added in Emacs
2017 ;; 21.2.50+. Considering many users use Emacs 21, use
2018 ;; tool-bar-add-item-from-menu here.
2019 (defun gnus-summary-make-tool-bar () 2550 (defun gnus-summary-make-tool-bar ()
2020 (if (and 2551 (if (and (fboundp 'tool-bar-add-item-from-menu)
2021 (condition-case nil (require 'tool-bar) (error nil)) 2552 (default-value 'tool-bar-mode)
2022 (fboundp 'tool-bar-add-item-from-menu) 2553 (not gnus-summary-tool-bar-map))
2023 (default-value 'tool-bar-mode)
2024 (not gnus-summary-tool-bar-map))
2025 (setq gnus-summary-tool-bar-map 2554 (setq gnus-summary-tool-bar-map
2026 (let ((tool-bar-map (make-sparse-keymap))) 2555 (let ((tool-bar-map (make-sparse-keymap))
2556 (load-path (mm-image-load-path)))
2027 (tool-bar-add-item-from-menu 2557 (tool-bar-add-item-from-menu
2028 'gnus-summary-prev-unread "prev-ur" gnus-summary-mode-map) 2558 'gnus-summary-prev-unread "prev-ur" gnus-summary-mode-map)
2029 (tool-bar-add-item-from-menu 2559 (tool-bar-add-item-from-menu
2030 'gnus-summary-next-unread "next-ur" gnus-summary-mode-map) 2560 'gnus-summary-next-unread "next-ur" gnus-summary-mode-map)
2031 (tool-bar-add-item-from-menu 2561 (tool-bar-add-item-from-menu
2154 article, you can, for instance, type `\\[gnus-summary-next-page]'. To move forwards 2684 article, you can, for instance, type `\\[gnus-summary-next-page]'. To move forwards
2155 and backwards while displaying articles, type `\\[gnus-summary-next-unread-article]' and `\\[gnus-summary-prev-unread-article]', 2685 and backwards while displaying articles, type `\\[gnus-summary-next-unread-article]' and `\\[gnus-summary-prev-unread-article]',
2156 respectively. 2686 respectively.
2157 2687
2158 You can also post articles and send mail from this buffer. To 2688 You can also post articles and send mail from this buffer. To
2159 follow up an article, type `\\[gnus-summary-followup]'. To mail a reply to the author 2689 follow up an article, type `\\[gnus-summary-followup]'. To mail a reply to the author
2160 of an article, type `\\[gnus-summary-reply]'. 2690 of an article, type `\\[gnus-summary-reply]'.
2161 2691
2162 There are approx. one gazillion commands you can execute in this 2692 There are approx. one gazillion commands you can execute in this
2163 buffer; read the info pages for more information (`\\[gnus-info-find-node]'). 2693 buffer; read the info pages for more information (`\\[gnus-info-find-node]').
2164 2694
2169 (kill-all-local-variables) 2699 (kill-all-local-variables)
2170 (when (gnus-visual-p 'summary-menu 'menu) 2700 (when (gnus-visual-p 'summary-menu 'menu)
2171 (gnus-summary-make-menu-bar) 2701 (gnus-summary-make-menu-bar)
2172 (gnus-summary-make-tool-bar)) 2702 (gnus-summary-make-tool-bar))
2173 (gnus-summary-make-local-variables) 2703 (gnus-summary-make-local-variables)
2704 (let ((gnus-summary-local-variables gnus-newsgroup-variables))
2705 (gnus-summary-make-local-variables))
2174 (gnus-make-thread-indent-array) 2706 (gnus-make-thread-indent-array)
2175 (gnus-simplify-mode-line) 2707 (gnus-simplify-mode-line)
2176 (setq major-mode 'gnus-summary-mode) 2708 (setq major-mode 'gnus-summary-mode)
2177 (setq mode-name "Summary") 2709 (setq mode-name "Summary")
2178 (make-local-variable 'minor-mode-alist) 2710 (make-local-variable 'minor-mode-alist)
2188 (make-local-variable 'gnus-summary-line-format) 2720 (make-local-variable 'gnus-summary-line-format)
2189 (make-local-variable 'gnus-summary-line-format-spec) 2721 (make-local-variable 'gnus-summary-line-format-spec)
2190 (make-local-variable 'gnus-summary-dummy-line-format) 2722 (make-local-variable 'gnus-summary-dummy-line-format)
2191 (make-local-variable 'gnus-summary-dummy-line-format-spec) 2723 (make-local-variable 'gnus-summary-dummy-line-format-spec)
2192 (make-local-variable 'gnus-summary-mark-positions) 2724 (make-local-variable 'gnus-summary-mark-positions)
2193 (make-local-hook 'pre-command-hook) 2725 (gnus-make-local-hook 'pre-command-hook)
2194 (add-hook 'pre-command-hook 'gnus-set-global-variables nil t) 2726 (add-hook 'pre-command-hook 'gnus-set-global-variables nil t)
2195 (gnus-run-hooks 'gnus-summary-mode-hook) 2727 (gnus-run-mode-hooks 'gnus-summary-mode-hook)
2728 (turn-on-gnus-mailing-list-mode)
2196 (mm-enable-multibyte) 2729 (mm-enable-multibyte)
2197 (gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy) 2730 (gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy)
2198 (gnus-update-summary-mark-positions)) 2731 (gnus-update-summary-mark-positions))
2199 2732
2200 (defun gnus-summary-make-local-variables () 2733 (defun gnus-summary-make-local-variables ()
2288 after-article)) 2821 after-article))
2289 (let ((odata gnus-newsgroup-data)) 2822 (let ((odata gnus-newsgroup-data))
2290 (setq gnus-newsgroup-data (nconc list gnus-newsgroup-data)) 2823 (setq gnus-newsgroup-data (nconc list gnus-newsgroup-data))
2291 (when offset 2824 (when offset
2292 (gnus-data-update-list odata offset))) 2825 (gnus-data-update-list odata offset)))
2293 ;; Find the last element in the list to be spliced into the main 2826 ;; Find the last element in the list to be spliced into the main
2294 ;; list. 2827 ;; list.
2295 (while (cdr list) 2828 (while (cdr list)
2296 (setq list (cdr list))) 2829 (setq list (cdr list)))
2297 (if (not data) 2830 (if (not data)
2298 (progn 2831 (progn
2350 `(memq ,article gnus-newsgroup-ancient)) 2883 `(memq ,article gnus-newsgroup-ancient))
2351 2884
2352 (defun gnus-article-parent-p (number) 2885 (defun gnus-article-parent-p (number)
2353 "Say whether this article is a parent or not." 2886 "Say whether this article is a parent or not."
2354 (let ((data (gnus-data-find-list number))) 2887 (let ((data (gnus-data-find-list number)))
2355 (and (cdr data) ; There has to be an article after... 2888 (and (cdr data) ; There has to be an article after...
2356 (< (gnus-data-level (car data)) ; And it has to have a higher level. 2889 (< (gnus-data-level (car data)) ; And it has to have a higher level.
2357 (gnus-data-level (nth 1 data)))))) 2890 (gnus-data-level (nth 1 data))))))
2358 2891
2359 (defun gnus-article-children (number) 2892 (defun gnus-article-children (number)
2360 "Return a list of all children to NUMBER." 2893 "Return a list of all children to NUMBER."
2378 '(get-text-property (point) 'gnus-intangible)) 2911 '(get-text-property (point) 'gnus-intangible))
2379 2912
2380 (defun gnus-article-read-p (article) 2913 (defun gnus-article-read-p (article)
2381 "Say whether ARTICLE is read or not." 2914 "Say whether ARTICLE is read or not."
2382 (not (or (memq article gnus-newsgroup-marked) 2915 (not (or (memq article gnus-newsgroup-marked)
2916 (memq article gnus-newsgroup-spam-marked)
2383 (memq article gnus-newsgroup-unreads) 2917 (memq article gnus-newsgroup-unreads)
2384 (memq article gnus-newsgroup-unselected) 2918 (memq article gnus-newsgroup-unselected)
2385 (memq article gnus-newsgroup-dormant)))) 2919 (memq article gnus-newsgroup-dormant))))
2386 2920
2387 ;; Some summary mode macros. 2921 ;; Some summary mode macros.
2468 (defun gnus-read-mark-p (mark) 3002 (defun gnus-read-mark-p (mark)
2469 "Say whether MARK is one of the marks that mark as read. 3003 "Say whether MARK is one of the marks that mark as read.
2470 This is all marks except unread, ticked, dormant, and expirable." 3004 This is all marks except unread, ticked, dormant, and expirable."
2471 (not (or (= mark gnus-unread-mark) 3005 (not (or (= mark gnus-unread-mark)
2472 (= mark gnus-ticked-mark) 3006 (= mark gnus-ticked-mark)
3007 (= mark gnus-spam-mark)
2473 (= mark gnus-dormant-mark) 3008 (= mark gnus-dormant-mark)
2474 (= mark gnus-expirable-mark)))) 3009 (= mark gnus-expirable-mark))))
2475 3010
2476 (defmacro gnus-article-mark (number) 3011 (defmacro gnus-article-mark (number)
2477 "Return the MARK of article NUMBER. 3012 "Return the MARK of article NUMBER.
2479 time; i.e., when generating the summary lines. After that, 3014 time; i.e., when generating the summary lines. After that,
2480 `gnus-summary-article-mark' should be used to examine the 3015 `gnus-summary-article-mark' should be used to examine the
2481 marks of articles." 3016 marks of articles."
2482 `(cond 3017 `(cond
2483 ((memq ,number gnus-newsgroup-unsendable) gnus-unsendable-mark) 3018 ((memq ,number gnus-newsgroup-unsendable) gnus-unsendable-mark)
2484 ((memq ,number gnus-newsgroup-undownloaded) gnus-undownloaded-mark)
2485 ((memq ,number gnus-newsgroup-downloadable) gnus-downloadable-mark) 3019 ((memq ,number gnus-newsgroup-downloadable) gnus-downloadable-mark)
2486 ((memq ,number gnus-newsgroup-unreads) gnus-unread-mark) 3020 ((memq ,number gnus-newsgroup-unreads) gnus-unread-mark)
2487 ((memq ,number gnus-newsgroup-marked) gnus-ticked-mark) 3021 ((memq ,number gnus-newsgroup-marked) gnus-ticked-mark)
3022 ((memq ,number gnus-newsgroup-spam-marked) gnus-spam-mark)
2488 ((memq ,number gnus-newsgroup-dormant) gnus-dormant-mark) 3023 ((memq ,number gnus-newsgroup-dormant) gnus-dormant-mark)
2489 ((memq ,number gnus-newsgroup-expirable) gnus-expirable-mark) 3024 ((memq ,number gnus-newsgroup-expirable) gnus-expirable-mark)
2490 (t (or (cdr (assq ,number gnus-newsgroup-reads)) 3025 (t (or (cdr (assq ,number gnus-newsgroup-reads))
2491 gnus-ancient-mark)))) 3026 gnus-ancient-mark))))
2492 3027
2493 ;; Saving hidden threads. 3028 ;; Saving hidden threads.
2494
2495 (put 'gnus-save-hidden-threads 'lisp-indent-function 0)
2496 (put 'gnus-save-hidden-threads 'edebug-form-spec '(body))
2497 3029
2498 (defmacro gnus-save-hidden-threads (&rest forms) 3030 (defmacro gnus-save-hidden-threads (&rest forms)
2499 "Save hidden threads, eval FORMS, and restore the hidden threads." 3031 "Save hidden threads, eval FORMS, and restore the hidden threads."
2500 (let ((config (make-symbol "config"))) 3032 (let ((config (make-symbol "config")))
2501 `(let ((,config (gnus-hidden-threads-configuration))) 3033 `(let ((,config (gnus-hidden-threads-configuration)))
2502 (unwind-protect 3034 (unwind-protect
2503 (save-excursion 3035 (save-excursion
2504 ,@forms) 3036 ,@forms)
2505 (gnus-restore-hidden-threads-configuration ,config))))) 3037 (gnus-restore-hidden-threads-configuration ,config)))))
3038 (put 'gnus-save-hidden-threads 'lisp-indent-function 0)
3039 (put 'gnus-save-hidden-threads 'edebug-form-spec '(body))
2506 3040
2507 (defun gnus-data-compute-positions () 3041 (defun gnus-data-compute-positions ()
2508 "Compute the positions of all articles." 3042 "Compute the positions of all articles."
2509 (setq gnus-newsgroup-data-reverse nil) 3043 (setq gnus-newsgroup-data-reverse nil)
2510 (let ((data gnus-newsgroup-data)) 3044 (let ((data gnus-newsgroup-data))
2556 (make-display-table))) 3090 (make-display-table)))
2557 (i 32)) 3091 (i 32))
2558 ;; Nix out all the control chars... 3092 ;; Nix out all the control chars...
2559 (while (>= (setq i (1- i)) 0) 3093 (while (>= (setq i (1- i)) 0)
2560 (aset table i [??])) 3094 (aset table i [??]))
2561 ;; ... but not newline and cr, of course. (cr is necessary for the 3095 ;; ... but not newline and cr, of course. (cr is necessary for the
2562 ;; selective display). 3096 ;; selective display).
2563 (aset table ?\n nil) 3097 (aset table ?\n nil)
2564 (aset table ?\r nil) 3098 (aset table ?\r nil)
2565 ;; We keep TAB as well. 3099 ;; We keep TAB as well.
2566 (aset table ?\t nil) 3100 (aset table ?\t nil)
2570 ;; Only modify if the entry is nil. 3104 ;; Only modify if the entry is nil.
2571 (unless (aref table i) 3105 (unless (aref table i)
2572 (aset table i [??])))) 3106 (aset table i [??]))))
2573 (setq buffer-display-table table))) 3107 (setq buffer-display-table table)))
2574 3108
3109 (defun gnus-summary-set-article-display-arrow (pos)
3110 "Update the overlay arrow to point to line at position POS."
3111 (when (and gnus-summary-display-arrow
3112 (boundp 'overlay-arrow-position)
3113 (boundp 'overlay-arrow-string))
3114 (save-excursion
3115 (goto-char pos)
3116 (beginning-of-line)
3117 (unless overlay-arrow-position
3118 (setq overlay-arrow-position (make-marker)))
3119 (setq overlay-arrow-string "=>"
3120 overlay-arrow-position (set-marker overlay-arrow-position
3121 (point)
3122 (current-buffer))))))
3123
2575 (defun gnus-summary-setup-buffer (group) 3124 (defun gnus-summary-setup-buffer (group)
2576 "Initialize summary buffer." 3125 "Initialize summary buffer."
2577 (let ((buffer (concat "*Summary " group "*"))) 3126 (let ((buffer (gnus-summary-buffer-name group))
3127 (dead-name (concat "*Dead Summary "
3128 (gnus-group-decoded-name group) "*")))
3129 ;; If a dead summary buffer exists, we kill it.
3130 (when (gnus-buffer-live-p dead-name)
3131 (gnus-kill-buffer dead-name))
2578 (if (get-buffer buffer) 3132 (if (get-buffer buffer)
2579 (progn 3133 (progn
2580 (set-buffer buffer) 3134 (set-buffer buffer)
2581 (setq gnus-summary-buffer (current-buffer)) 3135 (setq gnus-summary-buffer (current-buffer))
2582 (not gnus-newsgroup-prepared)) 3136 (not gnus-newsgroup-prepared))
2588 (unless gnus-single-article-buffer 3142 (unless gnus-single-article-buffer
2589 (make-local-variable 'gnus-article-buffer) 3143 (make-local-variable 'gnus-article-buffer)
2590 (make-local-variable 'gnus-article-current) 3144 (make-local-variable 'gnus-article-current)
2591 (make-local-variable 'gnus-original-article-buffer)) 3145 (make-local-variable 'gnus-original-article-buffer))
2592 (setq gnus-newsgroup-name group) 3146 (setq gnus-newsgroup-name group)
3147 ;; Set any local variables in the group parameters.
3148 (gnus-summary-set-local-parameters gnus-newsgroup-name)
2593 t))) 3149 t)))
2594 3150
2595 (defun gnus-set-global-variables () 3151 (defun gnus-set-global-variables ()
2596 "Set the global equivalents of the buffer-local variables. 3152 "Set the global equivalents of the buffer-local variables.
2597 They are set to the latest values they had. These reflect the summary 3153 They are set to the latest values they had. These reflect the summary
2598 buffer that was in action when the last article was fetched." 3154 buffer that was in action when the last article was fetched."
2599 (when (eq major-mode 'gnus-summary-mode) 3155 (when (eq major-mode 'gnus-summary-mode)
2600 (setq gnus-summary-buffer (current-buffer)) 3156 (setq gnus-summary-buffer (current-buffer))
2601 (let ((name gnus-newsgroup-name) 3157 (let ((name gnus-newsgroup-name)
2602 (marked gnus-newsgroup-marked) 3158 (marked gnus-newsgroup-marked)
3159 (spam gnus-newsgroup-spam-marked)
2603 (unread gnus-newsgroup-unreads) 3160 (unread gnus-newsgroup-unreads)
2604 (headers gnus-current-headers) 3161 (headers gnus-current-headers)
2605 (data gnus-newsgroup-data) 3162 (data gnus-newsgroup-data)
2606 (summary gnus-summary-buffer) 3163 (summary gnus-summary-buffer)
2607 (article-buffer gnus-article-buffer) 3164 (article-buffer gnus-article-buffer)
2608 (original gnus-original-article-buffer) 3165 (original gnus-original-article-buffer)
2609 (gac gnus-article-current) 3166 (gac gnus-article-current)
2610 (reffed gnus-reffed-article-number) 3167 (reffed gnus-reffed-article-number)
2611 (score-file gnus-current-score-file) 3168 (score-file gnus-current-score-file)
2612 (default-charset gnus-newsgroup-charset)) 3169 (default-charset gnus-newsgroup-charset)
3170 vlist)
3171 (let ((locals gnus-newsgroup-variables))
3172 (while locals
3173 (if (consp (car locals))
3174 (push (eval (caar locals)) vlist)
3175 (push (eval (car locals)) vlist))
3176 (setq locals (cdr locals)))
3177 (setq vlist (nreverse vlist)))
2613 (save-excursion 3178 (save-excursion
2614 (set-buffer gnus-group-buffer) 3179 (set-buffer gnus-group-buffer)
2615 (setq gnus-newsgroup-name name 3180 (setq gnus-newsgroup-name name
2616 gnus-newsgroup-marked marked 3181 gnus-newsgroup-marked marked
3182 gnus-newsgroup-spam-marked spam
2617 gnus-newsgroup-unreads unread 3183 gnus-newsgroup-unreads unread
2618 gnus-current-headers headers 3184 gnus-current-headers headers
2619 gnus-newsgroup-data data 3185 gnus-newsgroup-data data
2620 gnus-article-current gac 3186 gnus-article-current gac
2621 gnus-summary-buffer summary 3187 gnus-summary-buffer summary
2622 gnus-article-buffer article-buffer 3188 gnus-article-buffer article-buffer
2623 gnus-original-article-buffer original 3189 gnus-original-article-buffer original
2624 gnus-reffed-article-number reffed 3190 gnus-reffed-article-number reffed
2625 gnus-current-score-file score-file 3191 gnus-current-score-file score-file
2626 gnus-newsgroup-charset default-charset) 3192 gnus-newsgroup-charset default-charset)
3193 (let ((locals gnus-newsgroup-variables))
3194 (while locals
3195 (if (consp (car locals))
3196 (set (caar locals) (pop vlist))
3197 (set (car locals) (pop vlist)))
3198 (setq locals (cdr locals))))
2627 ;; The article buffer also has local variables. 3199 ;; The article buffer also has local variables.
2628 (when (gnus-buffer-live-p gnus-article-buffer) 3200 (when (gnus-buffer-live-p gnus-article-buffer)
2629 (set-buffer gnus-article-buffer) 3201 (set-buffer gnus-article-buffer)
2630 (setq gnus-summary-buffer summary)))))) 3202 (setq gnus-summary-buffer summary))))))
2631 3203
2660 (defun gnus-update-summary-mark-positions () 3232 (defun gnus-update-summary-mark-positions ()
2661 "Compute where the summary marks are to go." 3233 "Compute where the summary marks are to go."
2662 (save-excursion 3234 (save-excursion
2663 (when (gnus-buffer-exists-p gnus-summary-buffer) 3235 (when (gnus-buffer-exists-p gnus-summary-buffer)
2664 (set-buffer gnus-summary-buffer)) 3236 (set-buffer gnus-summary-buffer))
2665 (let ((gnus-replied-mark 129) 3237 (let ((spec gnus-summary-line-format-spec)
2666 (gnus-score-below-mark 130) 3238 pos)
2667 (gnus-score-over-mark 130)
2668 (gnus-download-mark 131)
2669 (spec gnus-summary-line-format-spec)
2670 gnus-visual pos)
2671 (save-excursion 3239 (save-excursion
2672 (gnus-set-work-buffer) 3240 (gnus-set-work-buffer)
2673 (let ((gnus-summary-line-format-spec spec) 3241 (let ((gnus-tmp-unread ?Z)
2674 (gnus-newsgroup-downloadable '((0 . t)))) 3242 (gnus-replied-mark ?Z)
2675 (gnus-summary-insert-line 3243 (gnus-score-below-mark ?Z)
2676 [0 "" "" "" "" "" 0 0 "" nil] 0 nil 128 t nil "" nil 1) 3244 (gnus-score-over-mark ?Z)
3245 (gnus-undownloaded-mark ?Z)
3246 (gnus-summary-line-format-spec spec)
3247 (gnus-newsgroup-downloadable '(0))
3248 (header [0 "" "" "05 Apr 2001 23:33:09 +0400" "" "" 0 0 "" nil])
3249 case-fold-search ignores)
3250 ;; Here, all marks are bound to Z.
3251 (gnus-summary-insert-line header
3252 0 nil t gnus-tmp-unread t nil "" nil 1)
2677 (goto-char (point-min)) 3253 (goto-char (point-min))
2678 (setq pos (list (cons 'unread (and (search-forward "\200" nil t) 3254 ;; Memorize the positions of the same characters as dummy marks.
2679 (- (point) (point-min) 1))))) 3255 (while (re-search-forward "[A-D]" nil t)
3256 (push (point) ignores))
3257 (erase-buffer)
3258 ;; We use A-D as dummy marks in order to know column positions
3259 ;; where marks should be inserted.
3260 (setq gnus-tmp-unread ?A
3261 gnus-replied-mark ?B
3262 gnus-score-below-mark ?C
3263 gnus-score-over-mark ?C
3264 gnus-undownloaded-mark ?D)
3265 (gnus-summary-insert-line header
3266 0 nil t gnus-tmp-unread t nil "" nil 1)
3267 ;; Ignore characters which aren't dummy marks.
3268 (dolist (p ignores)
3269 (delete-region (goto-char (1- p)) p)
3270 (insert ?Z))
2680 (goto-char (point-min)) 3271 (goto-char (point-min))
2681 (push (cons 'replied (and (search-forward "\201" nil t) 3272 (setq pos (list (cons 'unread
3273 (and (search-forward "A" nil t)
3274 (- (point) (point-min) 1)))))
3275 (goto-char (point-min))
3276 (push (cons 'replied (and (search-forward "B" nil t)
2682 (- (point) (point-min) 1))) 3277 (- (point) (point-min) 1)))
2683 pos) 3278 pos)
2684 (goto-char (point-min)) 3279 (goto-char (point-min))
2685 (push (cons 'score (and (search-forward "\202" nil t) 3280 (push (cons 'score (and (search-forward "C" nil t)
2686 (- (point) (point-min) 1))) 3281 (- (point) (point-min) 1)))
2687 pos) 3282 pos)
2688 (goto-char (point-min)) 3283 (goto-char (point-min))
2689 (push (cons 'download 3284 (push (cons 'download (and (search-forward "D" nil t)
2690 (and (search-forward "\203" nil t) 3285 (- (point) (point-min) 1)))
2691 (- (point) (point-min) 1)))
2692 pos))) 3286 pos)))
2693 (setq gnus-summary-mark-positions pos)))) 3287 (setq gnus-summary-mark-positions pos))))
2694 3288
2695 (defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number) 3289 (defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number)
2696 "Insert a dummy root in the summary buffer." 3290 "Insert a dummy root in the summary buffer."
2697 (beginning-of-line) 3291 (beginning-of-line)
2698 (gnus-add-text-properties 3292 (gnus-add-text-properties
2699 (point) (progn (eval gnus-summary-dummy-line-format-spec) (point)) 3293 (point) (progn (eval gnus-summary-dummy-line-format-spec) (point))
2700 (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number))) 3294 (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number)))
2701 3295
2702 (defun gnus-summary-from-or-to-or-newsgroups (header) 3296 (defun gnus-summary-extract-address-component (from)
2703 (let ((to (cdr (assq 'To (mail-header-extra header)))) 3297 (or (car (funcall gnus-extract-address-components from))
2704 (newsgroups (cdr (assq 'Newsgroups (mail-header-extra header)))) 3298 from))
2705 (mail-parse-charset gnus-newsgroup-charset) 3299
3300 (defun gnus-summary-from-or-to-or-newsgroups (header gnus-tmp-from)
3301 (let ((mail-parse-charset gnus-newsgroup-charset)
3302 ; Is it really necessary to do this next part for each summary line?
3303 ; Luckily, doesn't seem to slow things down much.
2706 (mail-parse-ignored-charsets 3304 (mail-parse-ignored-charsets
2707 (save-excursion (set-buffer gnus-summary-buffer) 3305 (save-excursion (set-buffer gnus-summary-buffer)
2708 gnus-newsgroup-ignored-charsets))) 3306 gnus-newsgroup-ignored-charsets)))
2709 (cond 3307 (or
2710 ((and to 3308 (and gnus-ignored-from-addresses
2711 gnus-ignored-from-addresses 3309 (string-match gnus-ignored-from-addresses gnus-tmp-from)
2712 (string-match gnus-ignored-from-addresses 3310 (let ((extra-headers (mail-header-extra header))
2713 (mail-header-from header))) 3311 to
2714 (concat "-> " 3312 newsgroups)
2715 (or (car (funcall gnus-extract-address-components 3313 (cond
2716 (funcall 3314 ((setq to (cdr (assq 'To extra-headers)))
2717 gnus-decode-encoded-word-function to))) 3315 (concat "-> "
2718 (funcall gnus-decode-encoded-word-function to)))) 3316 (inline
2719 ((and newsgroups 3317 (gnus-summary-extract-address-component
2720 gnus-ignored-from-addresses 3318 (funcall gnus-decode-encoded-word-function to)))))
2721 (string-match gnus-ignored-from-addresses 3319 ((setq newsgroups (cdr (assq 'Newsgroups extra-headers)))
2722 (mail-header-from header))) 3320 (concat "=> " newsgroups)))))
2723 (concat "=> " newsgroups)) 3321 (inline (gnus-summary-extract-address-component gnus-tmp-from)))))
2724 (t
2725 (or (car (funcall gnus-extract-address-components
2726 (mail-header-from header)))
2727 (mail-header-from header))))))
2728 3322
2729 (defun gnus-summary-insert-line (gnus-tmp-header 3323 (defun gnus-summary-insert-line (gnus-tmp-header
2730 gnus-tmp-level gnus-tmp-current 3324 gnus-tmp-level gnus-tmp-current
2731 gnus-tmp-unread gnus-tmp-replied 3325 undownloaded gnus-tmp-unread gnus-tmp-replied
2732 gnus-tmp-expirable gnus-tmp-subject-or-nil 3326 gnus-tmp-expirable gnus-tmp-subject-or-nil
2733 &optional gnus-tmp-dummy gnus-tmp-score 3327 &optional gnus-tmp-dummy gnus-tmp-score
2734 gnus-tmp-process) 3328 gnus-tmp-process)
2735 (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level)) 3329 (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level))
2736 (gnus-tmp-lines (mail-header-lines gnus-tmp-header)) 3330 (gnus-tmp-lines (mail-header-lines gnus-tmp-header))
2737 (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0)) 3331 (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0))
2738 (gnus-tmp-score-char 3332 (gnus-tmp-score-char
2739 (if (or (null gnus-summary-default-score) 3333 (if (or (null gnus-summary-default-score)
2740 (<= (abs (- gnus-tmp-score gnus-summary-default-score)) 3334 (<= (abs (- gnus-tmp-score gnus-summary-default-score))
2741 gnus-summary-zcore-fuzz)) 3335 gnus-summary-zcore-fuzz))
2742 ? ;Whitespace 3336 ? ;Whitespace
2743 (if (< gnus-tmp-score gnus-summary-default-score) 3337 (if (< gnus-tmp-score gnus-summary-default-score)
2744 gnus-score-below-mark gnus-score-over-mark))) 3338 gnus-score-below-mark gnus-score-over-mark)))
3339 (gnus-tmp-number (mail-header-number gnus-tmp-header))
2745 (gnus-tmp-replied 3340 (gnus-tmp-replied
2746 (cond (gnus-tmp-process gnus-process-mark) 3341 (cond (gnus-tmp-process gnus-process-mark)
2747 ((memq gnus-tmp-current gnus-newsgroup-cached) 3342 ((memq gnus-tmp-current gnus-newsgroup-cached)
2748 gnus-cached-mark) 3343 gnus-cached-mark)
2749 (gnus-tmp-replied gnus-replied-mark) 3344 (gnus-tmp-replied gnus-replied-mark)
3345 ((memq gnus-tmp-current gnus-newsgroup-forwarded)
3346 gnus-forwarded-mark)
2750 ((memq gnus-tmp-current gnus-newsgroup-saved) 3347 ((memq gnus-tmp-current gnus-newsgroup-saved)
2751 gnus-saved-mark) 3348 gnus-saved-mark)
2752 (t gnus-unread-mark))) 3349 ((memq gnus-tmp-number gnus-newsgroup-recent)
3350 gnus-recent-mark)
3351 ((memq gnus-tmp-number gnus-newsgroup-unseen)
3352 gnus-unseen-mark)
3353 (t gnus-no-mark)))
3354 (gnus-tmp-downloaded
3355 (cond (undownloaded
3356 gnus-undownloaded-mark)
3357 (gnus-newsgroup-agentized
3358 gnus-downloaded-mark)
3359 (t
3360 gnus-no-mark)))
2753 (gnus-tmp-from (mail-header-from gnus-tmp-header)) 3361 (gnus-tmp-from (mail-header-from gnus-tmp-header))
2754 (gnus-tmp-name 3362 (gnus-tmp-name
2755 (cond 3363 (cond
2756 ((string-match "<[^>]+> *$" gnus-tmp-from) 3364 ((string-match "<[^>]+> *$" gnus-tmp-from)
2757 (let ((beg (match-beginning 0))) 3365 (let ((beg (match-beginning 0)))
2758 (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from) 3366 (or (and (string-match "^\".+\"" gnus-tmp-from)
2759 (substring gnus-tmp-from (1+ (match-beginning 0)) 3367 (substring gnus-tmp-from 1 (1- (match-end 0))))
2760 (1- (match-end 0))))
2761 (substring gnus-tmp-from 0 beg)))) 3368 (substring gnus-tmp-from 0 beg))))
2762 ((string-match "(.+)" gnus-tmp-from) 3369 ((string-match "(.+)" gnus-tmp-from)
2763 (substring gnus-tmp-from 3370 (substring gnus-tmp-from
2764 (1+ (match-beginning 0)) (1- (match-end 0)))) 3371 (1+ (match-beginning 0)) (1- (match-end 0))))
2765 (t gnus-tmp-from))) 3372 (t gnus-tmp-from)))
2766 (gnus-tmp-subject (mail-header-subject gnus-tmp-header)) 3373 (gnus-tmp-subject (mail-header-subject gnus-tmp-header))
2767 (gnus-tmp-number (mail-header-number gnus-tmp-header))
2768 (gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[)) 3374 (gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[))
2769 (gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\])) 3375 (gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\]))
2770 (buffer-read-only nil)) 3376 (buffer-read-only nil))
2771 (when (string= gnus-tmp-name "") 3377 (when (string= gnus-tmp-name "")
2772 (setq gnus-tmp-name gnus-tmp-from)) 3378 (setq gnus-tmp-name gnus-tmp-from))
2773 (unless (numberp gnus-tmp-lines) 3379 (unless (numberp gnus-tmp-lines)
2774 (setq gnus-tmp-lines 0)) 3380 (setq gnus-tmp-lines -1))
2775 (gnus-put-text-property 3381 (if (= gnus-tmp-lines -1)
3382 (setq gnus-tmp-lines "?")
3383 (setq gnus-tmp-lines (number-to-string gnus-tmp-lines)))
3384 (gnus-put-text-property
2776 (point) 3385 (point)
2777 (progn (eval gnus-summary-line-format-spec) (point)) 3386 (progn (eval gnus-summary-line-format-spec) (point))
2778 'gnus-number gnus-tmp-number) 3387 'gnus-number gnus-tmp-number)
2779 (when (gnus-visual-p 'summary-highlight 'highlight) 3388 (when (gnus-visual-p 'summary-highlight 'highlight)
2780 (forward-line -1) 3389 (forward-line -1)
2781 (gnus-run-hooks 'gnus-summary-update-hook) 3390 (gnus-run-hooks 'gnus-summary-update-hook)
2782 (forward-line 1)))) 3391 (forward-line 1))))
2783 3392
2802 (gnus-summary-mark-article-as-unread gnus-unread-mark))) 3411 (gnus-summary-mark-article-as-unread gnus-unread-mark)))
2803 (gnus-summary-update-mark 3412 (gnus-summary-update-mark
2804 (if (or (null gnus-summary-default-score) 3413 (if (or (null gnus-summary-default-score)
2805 (<= (abs (- score gnus-summary-default-score)) 3414 (<= (abs (- score gnus-summary-default-score))
2806 gnus-summary-zcore-fuzz)) 3415 gnus-summary-zcore-fuzz))
2807 ? ;Whitespace 3416 ? ;Whitespace
2808 (if (< score gnus-summary-default-score) 3417 (if (< score gnus-summary-default-score)
2809 gnus-score-below-mark gnus-score-over-mark)) 3418 gnus-score-below-mark gnus-score-over-mark))
2810 'score)) 3419 'score))
2811 ;; Do visual highlighting. 3420 ;; Do visual highlighting.
2812 (when (gnus-visual-p 'summary-highlight 'highlight) 3421 (when (gnus-visual-p 'summary-highlight 'highlight)
2817 (defun gnus-summary-number-of-articles-in-thread (thread &optional level char) 3426 (defun gnus-summary-number-of-articles-in-thread (thread &optional level char)
2818 "Return the number of articles in THREAD. 3427 "Return the number of articles in THREAD.
2819 This may be 0 in some cases -- if none of the articles in 3428 This may be 0 in some cases -- if none of the articles in
2820 the thread are to be displayed." 3429 the thread are to be displayed."
2821 (let* ((number 3430 (let* ((number
2822 ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>. 3431 ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
2823 (cond 3432 (cond
2824 ((not (listp thread)) 3433 ((not (listp thread))
2825 1) 3434 1)
2826 ((and (consp thread) (cdr thread)) 3435 ((and (consp thread) (cdr thread))
2827 (apply 3436 (apply
2840 (if char 3449 (if char
2841 (if (> number 1) gnus-not-empty-thread-mark 3450 (if (> number 1) gnus-not-empty-thread-mark
2842 gnus-empty-thread-mark) 3451 gnus-empty-thread-mark)
2843 number))) 3452 number)))
2844 3453
3454 (defsubst gnus-summary-line-message-size (head)
3455 "Return pretty-printed version of message size.
3456 This function is intended to be used in
3457 `gnus-summary-line-format-alist'."
3458 (let ((c (or (mail-header-chars head) -1)))
3459 (cond ((< c 0) "n/a") ; chars not available
3460 ((< c (* 1000 10)) (format "%1.1fk" (/ c 1024.0)))
3461 ((< c (* 1000 100)) (format "%dk" (/ c 1024.0)))
3462 ((< c (* 1000 10000)) (format "%1.1fM" (/ c (* 1024.0 1024))))
3463 (t (format "%dM" (/ c (* 1024.0 1024)))))))
3464
3465
2845 (defun gnus-summary-set-local-parameters (group) 3466 (defun gnus-summary-set-local-parameters (group)
2846 "Go through the local params of GROUP and set all variable specs in that list." 3467 "Go through the local params of GROUP and set all variable specs in that list."
2847 (let ((params (gnus-group-find-parameter group)) 3468 (let ((params (gnus-group-find-parameter group))
3469 (vars '(quit-config)) ; Ignore quit-config.
2848 elem) 3470 elem)
2849 (while params 3471 (while params
2850 (setq elem (car params) 3472 (setq elem (car params)
2851 params (cdr params)) 3473 params (cdr params))
2852 (and (consp elem) ; Has to be a cons. 3474 (and (consp elem) ; Has to be a cons.
2853 (consp (cdr elem)) ; The cdr has to be a list. 3475 (consp (cdr elem)) ; The cdr has to be a list.
2854 (symbolp (car elem)) ; Has to be a symbol in there. 3476 (symbolp (car elem)) ; Has to be a symbol in there.
2855 (not (memq (car elem) '(quit-config))) ; Ignore quit-config. 3477 (not (memq (car elem) vars))
2856 (ignore-errors ; So we set it. 3478 (ignore-errors ; So we set it.
3479 (push (car elem) vars)
2857 (make-local-variable (car elem)) 3480 (make-local-variable (car elem))
2858 (set (car elem) (eval (nth 1 elem)))))))) 3481 (set (car elem) (eval (nth 1 elem))))))))
2859 3482
2860 (defun gnus-summary-read-group (group &optional show-all no-article 3483 (defun gnus-summary-read-group (group &optional show-all no-article
2861 kill-buffer no-display backward 3484 kill-buffer no-display backward
2888 3511
2889 (defun gnus-summary-read-group-1 (group show-all no-article 3512 (defun gnus-summary-read-group-1 (group show-all no-article
2890 kill-buffer no-display 3513 kill-buffer no-display
2891 &optional select-articles) 3514 &optional select-articles)
2892 ;; Killed foreign groups can't be entered. 3515 ;; Killed foreign groups can't be entered.
2893 (when (and (not (gnus-group-native-p group)) 3516 ;; (when (and (not (gnus-group-native-p group))
2894 (not (gnus-gethash group gnus-newsrc-hashtb))) 3517 ;; (not (gnus-gethash group gnus-newsrc-hashtb)))
2895 (error "Dead non-native groups can't be entered")) 3518 ;; (error "Dead non-native groups can't be entered"))
2896 (gnus-message 5 "Retrieving newsgroup: %s..." group) 3519 (gnus-message 5 "Retrieving newsgroup: %s..."
3520 (gnus-group-decoded-name group))
2897 (let* ((new-group (gnus-summary-setup-buffer group)) 3521 (let* ((new-group (gnus-summary-setup-buffer group))
2898 (quit-config (gnus-group-quit-config group)) 3522 (quit-config (gnus-group-quit-config group))
2899 (did-select (and new-group (gnus-select-newsgroup 3523 (did-select (and new-group (gnus-select-newsgroup
2900 group show-all select-articles)))) 3524 group show-all select-articles))))
2901 (cond 3525 (cond
2921 (gnus-summary-update-info) 3545 (gnus-summary-update-info)
2922 (set-buffer gnus-group-buffer) 3546 (set-buffer gnus-group-buffer)
2923 (gnus-group-jump-to-group group) 3547 (gnus-group-jump-to-group group)
2924 (gnus-group-next-unread-group 1)) 3548 (gnus-group-next-unread-group 1))
2925 (gnus-handle-ephemeral-exit quit-config))) 3549 (gnus-handle-ephemeral-exit quit-config)))
2926 (gnus-message 3 "Can't select group") 3550 (let ((grpinfo (gnus-get-info group)))
3551 (if (null (gnus-info-read grpinfo))
3552 (gnus-message 3 "Group %s contains no messages"
3553 (gnus-group-decoded-name group))
3554 (gnus-message 3 "Can't select group")))
2927 nil) 3555 nil)
2928 ;; The user did a `C-g' while prompting for number of articles, 3556 ;; The user did a `C-g' while prompting for number of articles,
2929 ;; so we exit this group. 3557 ;; so we exit this group.
2930 ((eq did-select 'quit) 3558 ((eq did-select 'quit)
2931 (and (eq major-mode 'gnus-summary-mode) 3559 (and (eq major-mode 'gnus-summary-mode)
2949 (setq gnus-newsgroup-active 3577 (setq gnus-newsgroup-active
2950 (gnus-copy-sequence 3578 (gnus-copy-sequence
2951 (gnus-active gnus-newsgroup-name))) 3579 (gnus-active gnus-newsgroup-name)))
2952 ;; You can change the summary buffer in some way with this hook. 3580 ;; You can change the summary buffer in some way with this hook.
2953 (gnus-run-hooks 'gnus-select-group-hook) 3581 (gnus-run-hooks 'gnus-select-group-hook)
2954 ;; Set any local variables in the group parameters. 3582 (when (memq 'summary (gnus-update-format-specifications
2955 (gnus-summary-set-local-parameters gnus-newsgroup-name) 3583 nil 'summary 'summary-mode 'summary-dummy))
2956 (gnus-update-format-specifications 3584 ;; The format specification for the summary line was updated,
2957 nil 'summary 'summary-mode 'summary-dummy) 3585 ;; so we need to update the mark positions as well.
2958 (gnus-update-summary-mark-positions) 3586 (gnus-update-summary-mark-positions))
2959 ;; Do score processing. 3587 ;; Do score processing.
2960 (when gnus-use-scoring 3588 (when gnus-use-scoring
2961 (gnus-possibly-score-headers)) 3589 (gnus-possibly-score-headers))
2962 ;; Check whether to fill in the gaps in the threads. 3590 ;; Check whether to fill in the gaps in the threads.
2963 (when gnus-build-sparse-threads 3591 (when gnus-build-sparse-threads
3002 ;; Return nil from this function. 3630 ;; Return nil from this function.
3003 nil) 3631 nil)
3004 ;; Hide conversation thread subtrees. We cannot do this in 3632 ;; Hide conversation thread subtrees. We cannot do this in
3005 ;; gnus-summary-prepare-hook since kill processing may not 3633 ;; gnus-summary-prepare-hook since kill processing may not
3006 ;; work with hidden articles. 3634 ;; work with hidden articles.
3007 (and gnus-show-threads 3635 (gnus-summary-maybe-hide-threads)
3008 gnus-thread-hide-subtree
3009 (gnus-summary-hide-all-threads))
3010 (when kill-buffer 3636 (when kill-buffer
3011 (gnus-kill-or-deaden-summary kill-buffer)) 3637 (gnus-kill-or-deaden-summary kill-buffer))
3638 (gnus-summary-auto-select-subject)
3012 ;; Show first unread article if requested. 3639 ;; Show first unread article if requested.
3013 (if (and (not no-article) 3640 (if (and (not no-article)
3014 (not no-display) 3641 (not no-display)
3015 gnus-newsgroup-unreads 3642 gnus-newsgroup-unreads
3016 gnus-auto-select-first) 3643 gnus-auto-select-first)
3017 (progn 3644 (progn
3018 (gnus-configure-windows 'summary) 3645 (gnus-configure-windows 'summary)
3019 (cond 3646 (let ((art (gnus-summary-article-number)))
3020 ((eq gnus-auto-select-first 'best) 3647 (unless (and (not gnus-plugged)
3021 (gnus-summary-best-unread-article)) 3648 (or (memq art gnus-newsgroup-undownloaded)
3022 ((eq gnus-auto-select-first t) 3649 (memq art gnus-newsgroup-downloadable)))
3023 (gnus-summary-first-unread-article)) 3650 (gnus-summary-goto-article art))))
3024 ((gnus-functionp gnus-auto-select-first) 3651 ;; Don't select any articles.
3025 (funcall gnus-auto-select-first))))
3026 ;; Don't select any articles, just move point to the first
3027 ;; article in the group.
3028 (goto-char (point-min))
3029 (gnus-summary-position-point) 3652 (gnus-summary-position-point)
3030 (gnus-configure-windows 'summary 'force) 3653 (gnus-configure-windows 'summary 'force)
3031 (gnus-set-mode-line 'summary)) 3654 (gnus-set-mode-line 'summary))
3032 (when (get-buffer-window gnus-group-buffer t) 3655 (when (and gnus-auto-center-group
3656 (get-buffer-window gnus-group-buffer t))
3033 ;; Gotta use windows, because recenter does weird stuff if 3657 ;; Gotta use windows, because recenter does weird stuff if
3034 ;; the current buffer ain't the displayed window. 3658 ;; the current buffer ain't the displayed window.
3035 (let ((owin (selected-window))) 3659 (let ((owin (selected-window)))
3036 (select-window (get-buffer-window gnus-group-buffer t)) 3660 (select-window (get-buffer-window gnus-group-buffer t))
3037 (when (gnus-group-goto-group group) 3661 (when (gnus-group-goto-group group)
3038 (recenter)) 3662 (recenter))
3039 (select-window owin))) 3663 (select-window owin)))
3040 ;; Mark this buffer as "prepared". 3664 ;; Mark this buffer as "prepared".
3041 (setq gnus-newsgroup-prepared t) 3665 (setq gnus-newsgroup-prepared t)
3042 (gnus-run-hooks 'gnus-summary-prepared-hook) 3666 (gnus-run-hooks 'gnus-summary-prepared-hook)
3667 (unless (gnus-ephemeral-group-p group)
3668 (gnus-group-update-group group))
3043 t))))) 3669 t)))))
3670
3671 (defun gnus-summary-auto-select-subject ()
3672 "Select the subject line on initial group entry."
3673 (goto-char (point-min))
3674 (cond
3675 ((eq gnus-auto-select-subject 'best)
3676 (gnus-summary-best-unread-subject))
3677 ((eq gnus-auto-select-subject 'unread)
3678 (gnus-summary-first-unread-subject))
3679 ((eq gnus-auto-select-subject 'unseen)
3680 (gnus-summary-first-unseen-subject))
3681 ((eq gnus-auto-select-subject 'unseen-or-unread)
3682 (gnus-summary-first-unseen-or-unread-subject))
3683 ((eq gnus-auto-select-subject 'first)
3684 ;; Do nothing.
3685 )
3686 ((functionp gnus-auto-select-subject)
3687 (funcall gnus-auto-select-subject))))
3044 3688
3045 (defun gnus-summary-prepare () 3689 (defun gnus-summary-prepare ()
3046 "Generate the summary buffer." 3690 "Generate the summary buffer."
3047 (interactive) 3691 (interactive)
3048 (let ((buffer-read-only nil)) 3692 (let ((buffer-read-only nil))
3064 ;; Call hooks for modifying summary buffer. 3708 ;; Call hooks for modifying summary buffer.
3065 (goto-char (point-min)) 3709 (goto-char (point-min))
3066 (gnus-run-hooks 'gnus-summary-prepare-hook))) 3710 (gnus-run-hooks 'gnus-summary-prepare-hook)))
3067 3711
3068 (defsubst gnus-general-simplify-subject (subject) 3712 (defsubst gnus-general-simplify-subject (subject)
3069 "Simply subject by the same rules as gnus-gather-threads-by-subject." 3713 "Simplify subject by the same rules as `gnus-gather-threads-by-subject'."
3070 (setq subject 3714 (setq subject
3071 (cond 3715 (cond
3072 ;; Truncate the subject. 3716 ;; Truncate the subject.
3073 (gnus-simplify-subject-functions 3717 (gnus-simplify-subject-functions
3074 (gnus-map-function gnus-simplify-subject-functions subject)) 3718 (gnus-map-function gnus-simplify-subject-functions subject))
3084 (t 3728 (t
3085 (gnus-simplify-subject-re subject)))) 3729 (gnus-simplify-subject-re subject))))
3086 3730
3087 (if (and gnus-summary-gather-exclude-subject 3731 (if (and gnus-summary-gather-exclude-subject
3088 (string-match gnus-summary-gather-exclude-subject subject)) 3732 (string-match gnus-summary-gather-exclude-subject subject))
3089 nil ; This article shouldn't be gathered 3733 nil ; This article shouldn't be gathered
3090 subject)) 3734 subject))
3091 3735
3092 (defun gnus-summary-simplify-subject-query () 3736 (defun gnus-summary-simplify-subject-query ()
3093 "Query where the respool algorithm would put this article." 3737 "Query where the respool algorithm would put this article."
3094 (interactive) 3738 (interactive)
3120 (nconc (cdar hthread) (list (car threads)))) 3764 (nconc (cdar hthread) (list (car threads))))
3121 ;; Remove it from the list of threads. 3765 ;; Remove it from the list of threads.
3122 (setcdr prev (cdr threads)) 3766 (setcdr prev (cdr threads))
3123 (setq threads prev)) 3767 (setq threads prev))
3124 ;; Enter this thread into the hash table. 3768 ;; Enter this thread into the hash table.
3125 (gnus-sethash subject threads hashtb))) 3769 (gnus-sethash subject
3770 (if gnus-summary-make-false-root-always
3771 (progn
3772 ;; If you want a dummy root above all
3773 ;; threads...
3774 (setcar threads (list whole-subject
3775 (car threads)))
3776 threads)
3777 threads)
3778 hashtb)))
3126 (setq prev threads) 3779 (setq prev threads)
3127 (setq threads (cdr threads))) 3780 (setq threads (cdr threads)))
3128 result))) 3781 result)))
3129 3782
3130 (defun gnus-gather-threads-by-references (threads) 3783 (defun gnus-gather-threads-by-references (threads)
3135 (result threads) 3788 (result threads)
3136 ids references id gthread gid entered ref) 3789 ids references id gthread gid entered ref)
3137 (while threads 3790 (while threads
3138 (when (setq references (mail-header-references (caar threads))) 3791 (when (setq references (mail-header-references (caar threads)))
3139 (setq id (mail-header-id (caar threads)) 3792 (setq id (mail-header-id (caar threads))
3140 ids (gnus-split-references references) 3793 ids (inline (gnus-split-references references))
3141 entered nil) 3794 entered nil)
3142 (while (setq ref (pop ids)) 3795 (while (setq ref (pop ids))
3143 (setq ids (delete ref ids)) 3796 (setq ids (delete ref ids))
3144 (if (not (setq gid (gnus-gethash ref idhashtb))) 3797 (if (not (setq gid (gnus-gethash ref idhashtb)))
3145 (progn 3798 (progn
3219 (car (symbol-value refs)) thread)) 3872 (car (symbol-value refs)) thread))
3220 (cdr (symbol-value refs))))))) 3873 (cdr (symbol-value refs)))))))
3221 (setq threads nil) 3874 (setq threads nil)
3222 (throw 'infloop t)) 3875 (throw 'infloop t))
3223 (unless (car (symbol-value refs)) 3876 (unless (car (symbol-value refs))
3224 ;; These threads do not refer back to any other articles, 3877 ;; These threads do not refer back to any other
3225 ;; so they're roots. 3878 ;; articles, so they're roots.
3226 (setq threads (append (cdr (symbol-value refs)) threads)))) 3879 (setq threads (append (cdr (symbol-value refs)) threads))))
3227 gnus-newsgroup-dependencies))) 3880 gnus-newsgroup-dependencies)))
3228 threads)) 3881 threads))
3229 3882
3230 ;; Build the thread tree. 3883 ;; Build the thread tree.
3234 If FORCE-NEW is not nil, enter HEADER into the DEPENDENCIES table even 3887 If FORCE-NEW is not nil, enter HEADER into the DEPENDENCIES table even
3235 if it was already present. 3888 if it was already present.
3236 3889
3237 If `gnus-summary-ignore-duplicates' is nil then duplicate Message-IDs 3890 If `gnus-summary-ignore-duplicates' is nil then duplicate Message-IDs
3238 will not be entered in the DEPENDENCIES table. Otherwise duplicate 3891 will not be entered in the DEPENDENCIES table. Otherwise duplicate
3239 Message-IDs will be renamed be renamed to a unique Message-ID before 3892 Message-IDs will be renamed to a unique Message-ID before being
3240 being entered. 3893 entered.
3241 3894
3242 Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." 3895 Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise."
3243 (let* ((id (mail-header-id header)) 3896 (let* ((id (mail-header-id header))
3244 (id-dep (and id (intern id dependencies))) 3897 (id-dep (and id (intern id dependencies)))
3245 ref ref-dep ref-header) 3898 parent-id ref ref-dep ref-header replaced)
3246 ;; Enter this `header' in the `dependencies' table. 3899 ;; Enter this `header' in the `dependencies' table.
3247 (cond 3900 (cond
3248 ((not id-dep) 3901 ((not id-dep)
3249 (setq header nil)) 3902 (setq header nil))
3250 ;; The first two cases do the normal part: enter a new `header' 3903 ;; The first two cases do the normal part: enter a new `header'
3257 ;; From here the `header' was already present in the 3910 ;; From here the `header' was already present in the
3258 ;; `dependencies' table. 3911 ;; `dependencies' table.
3259 (force-new 3912 (force-new
3260 ;; Overrides an existing entry; 3913 ;; Overrides an existing entry;
3261 ;; just set the header part of the entry. 3914 ;; just set the header part of the entry.
3262 (setcar (symbol-value id-dep) header)) 3915 (setcar (symbol-value id-dep) header)
3916 (setq replaced t))
3263 3917
3264 ;; Renames the existing `header' to a unique Message-ID. 3918 ;; Renames the existing `header' to a unique Message-ID.
3265 ((not gnus-summary-ignore-duplicates) 3919 ((not gnus-summary-ignore-duplicates)
3266 ;; An article with this Message-ID has already been seen. 3920 ;; An article with this Message-ID has already been seen.
3267 ;; We rename the Message-ID. 3921 ;; We rename the Message-ID.
3280 (concat (or (mail-header-xref (car (symbol-value id-dep))) 3934 (concat (or (mail-header-xref (car (symbol-value id-dep)))
3281 "") 3935 "")
3282 (or (mail-header-xref header) ""))) 3936 (or (mail-header-xref header) "")))
3283 (setq header nil))) 3937 (setq header nil)))
3284 3938
3285 (when header 3939 (when (and header (not replaced))
3286 ;; First check if that we are not creating a References loop. 3940 ;; First check that we are not creating a References loop.
3287 (setq ref (gnus-parent-id (mail-header-references header))) 3941 (setq parent-id (gnus-parent-id (mail-header-references header)))
3942 (setq ref parent-id)
3288 (while (and ref 3943 (while (and ref
3289 (setq ref-dep (intern-soft ref dependencies)) 3944 (setq ref-dep (intern-soft ref dependencies))
3290 (boundp ref-dep) 3945 (boundp ref-dep)
3291 (setq ref-header (car (symbol-value ref-dep)))) 3946 (setq ref-header (car (symbol-value ref-dep))))
3292 (if (string= id ref) 3947 (if (string= id ref)
3293 ;; Yuk! This is a reference loop. Make the article be a 3948 ;; Yuk! This is a reference loop. Make the article be a
3294 ;; root article. 3949 ;; root article.
3295 (progn 3950 (progn
3296 (mail-header-set-references (car (symbol-value id-dep)) "none") 3951 (mail-header-set-references (car (symbol-value id-dep)) "none")
3297 (setq ref nil)) 3952 (setq ref nil)
3953 (setq parent-id nil))
3298 (setq ref (gnus-parent-id (mail-header-references ref-header))))) 3954 (setq ref (gnus-parent-id (mail-header-references ref-header)))))
3299 (setq ref (gnus-parent-id (mail-header-references header))) 3955 (setq ref-dep (intern (or parent-id "none") dependencies))
3300 (setq ref-dep (intern (or ref "none") dependencies))
3301 (if (boundp ref-dep) 3956 (if (boundp ref-dep)
3302 (setcdr (symbol-value ref-dep) 3957 (setcdr (symbol-value ref-dep)
3303 (nconc (cdr (symbol-value ref-dep)) 3958 (nconc (cdr (symbol-value ref-dep))
3304 (list (symbol-value id-dep)))) 3959 (list (symbol-value id-dep))))
3305 (set ref-dep (list nil (symbol-value id-dep))))) 3960 (set ref-dep (list nil (symbol-value id-dep)))))
3306 header)) 3961 header))
3962
3963 (defun gnus-extract-message-id-from-in-reply-to (string)
3964 (if (string-match "<[^>]+>" string)
3965 (substring string (match-beginning 0) (match-end 0))
3966 nil))
3307 3967
3308 (defun gnus-build-sparse-threads () 3968 (defun gnus-build-sparse-threads ()
3309 (let ((headers gnus-newsgroup-headers) 3969 (let ((headers gnus-newsgroup-headers)
3310 (mail-parse-charset gnus-newsgroup-charset) 3970 (mail-parse-charset gnus-newsgroup-charset)
3311 (gnus-summary-ignore-duplicates t) 3971 (gnus-summary-ignore-duplicates t)
3374 (while (and (setq id (gnus-build-get-header id)) 4034 (while (and (setq id (gnus-build-get-header id))
3375 (not (car (gnus-id-to-thread id))))) 4035 (not (car (gnus-id-to-thread id)))))
3376 (setq heads nil))))) 4036 (setq heads nil)))))
3377 gnus-newsgroup-dependencies))) 4037 gnus-newsgroup-dependencies)))
3378 4038
4039 (defsubst gnus-remove-odd-characters (string)
4040 "Translate STRING into something that doesn't contain weird characters."
4041 (mm-subst-char-in-string
4042 ?\r ?\-
4043 (mm-subst-char-in-string
4044 ?\n ?\- string)))
4045
3379 ;; This function has to be called with point after the article number 4046 ;; This function has to be called with point after the article number
3380 ;; on the beginning of the line. 4047 ;; on the beginning of the line.
3381 (defsubst gnus-nov-parse-line (number dependencies &optional force-new) 4048 (defsubst gnus-nov-parse-line (number dependencies &optional force-new)
3382 (let ((eol (gnus-point-at-eol)) 4049 (let ((eol (gnus-point-at-eol))
3383 (buffer (current-buffer)) 4050 (buffer (current-buffer))
3384 header) 4051 header references in-reply-to)
3385 4052
3386 ;; overview: [num subject from date id refs chars lines misc] 4053 ;; overview: [num subject from date id refs chars lines misc]
3387 (unwind-protect 4054 (unwind-protect
3388 (progn 4055 (let (x)
3389 (narrow-to-region (point) eol) 4056 (narrow-to-region (point) eol)
3390 (unless (eobp) 4057 (unless (eobp)
3391 (forward-char)) 4058 (forward-char))
3392 4059
3393 (setq header 4060 (setq header
3394 (make-full-mail-header 4061 (make-full-mail-header
3395 number ; number 4062 number ; number
3396 (funcall gnus-decode-encoded-word-function 4063 (condition-case () ; subject
3397 (nnheader-nov-field)) ; subject 4064 (gnus-remove-odd-characters
3398 (funcall gnus-decode-encoded-word-function 4065 (funcall gnus-decode-encoded-word-function
3399 (nnheader-nov-field)) ; from 4066 (setq x (nnheader-nov-field))))
4067 (error x))
4068 (condition-case () ; from
4069 (gnus-remove-odd-characters
4070 (funcall gnus-decode-encoded-word-function
4071 (setq x (nnheader-nov-field))))
4072 (error x))
3400 (nnheader-nov-field) ; date 4073 (nnheader-nov-field) ; date
3401 (nnheader-nov-read-message-id) ; id 4074 (nnheader-nov-read-message-id) ; id
3402 (nnheader-nov-field) ; refs 4075 (setq references (nnheader-nov-field)) ; refs
3403 (nnheader-nov-read-integer) ; chars 4076 (nnheader-nov-read-integer) ; chars
3404 (nnheader-nov-read-integer) ; lines 4077 (nnheader-nov-read-integer) ; lines
3405 (unless (eobp) 4078 (unless (eobp)
3406 (if (looking-at "Xref: ") 4079 (if (looking-at "Xref: ")
3407 (goto-char (match-end 0))) 4080 (goto-char (match-end 0)))
3408 (nnheader-nov-field)) ; Xref 4081 (nnheader-nov-field)) ; Xref
3409 (nnheader-nov-parse-extra)))) ; extra 4082 (nnheader-nov-parse-extra)))) ; extra
3410 4083
3411 (widen)) 4084 (widen))
4085
4086 (when (and (string= references "")
4087 (setq in-reply-to (mail-header-extra header))
4088 (setq in-reply-to (cdr (assq 'In-Reply-To in-reply-to))))
4089 (mail-header-set-references
4090 header (gnus-extract-message-id-from-in-reply-to in-reply-to)))
3412 4091
3413 (when gnus-alter-header-function 4092 (when gnus-alter-header-function
3414 (funcall gnus-alter-header-function header)) 4093 (funcall gnus-alter-header-function header))
3415 (gnus-dependencies-add-header header dependencies force-new))) 4094 (gnus-dependencies-add-header header dependencies force-new)))
3416 4095
3442 (let ((number (mail-header-number header))) 4121 (let ((number (mail-header-number header)))
3443 (push number gnus-newsgroup-limit) 4122 (push number gnus-newsgroup-limit)
3444 (push header gnus-newsgroup-headers) 4123 (push header gnus-newsgroup-headers)
3445 (if (memq number gnus-newsgroup-unselected) 4124 (if (memq number gnus-newsgroup-unselected)
3446 (progn 4125 (progn
3447 (push number gnus-newsgroup-unreads) 4126 (setq gnus-newsgroup-unreads
4127 (gnus-add-to-sorted-list gnus-newsgroup-unreads
4128 number))
3448 (setq gnus-newsgroup-unselected 4129 (setq gnus-newsgroup-unselected
3449 (delq number gnus-newsgroup-unselected))) 4130 (delq number gnus-newsgroup-unselected)))
3450 (push number gnus-newsgroup-ancient))))))) 4131 (push number gnus-newsgroup-ancient)))))))
3451 4132
3452 (defun gnus-build-all-threads () 4133 (defun gnus-build-all-threads ()
3468 (set-buffer gnus-summary-buffer) 4149 (set-buffer gnus-summary-buffer)
3469 (push header gnus-newsgroup-headers) 4150 (push header gnus-newsgroup-headers)
3470 (if (memq (setq article (mail-header-number header)) 4151 (if (memq (setq article (mail-header-number header))
3471 gnus-newsgroup-unselected) 4152 gnus-newsgroup-unselected)
3472 (progn 4153 (progn
3473 (push article gnus-newsgroup-unreads) 4154 (setq gnus-newsgroup-unreads
4155 (gnus-add-to-sorted-list
4156 gnus-newsgroup-unreads article))
3474 (setq gnus-newsgroup-unselected 4157 (setq gnus-newsgroup-unselected
3475 (delq article gnus-newsgroup-unselected))) 4158 (delq article gnus-newsgroup-unselected)))
3476 (push article gnus-newsgroup-ancient))) 4159 (push article gnus-newsgroup-ancient)))
3477 (forward-line 1))))))) 4160 (forward-line 1)))))))
3478 4161
3479 (defun gnus-summary-update-article-line (article header) 4162 (defun gnus-summary-update-article-line (article header)
3480 "Update the line for ARTICLE using HEADERS." 4163 "Update the line for ARTICLE using HEADER."
3481 (let* ((id (mail-header-id header)) 4164 (let* ((id (mail-header-id header))
3482 (thread (gnus-id-to-thread id))) 4165 (thread (gnus-id-to-thread id)))
3483 (unless thread 4166 (unless thread
3484 (error "Article in no thread")) 4167 (error "Article in no thread"))
3485 ;; Update the thread. 4168 ;; Update the thread.
3486 (setcar thread header) 4169 (setcar thread header)
3487 (gnus-summary-goto-subject article) 4170 (gnus-summary-goto-subject article)
3488 (let* ((datal (gnus-data-find-list article)) 4171 (let* ((datal (gnus-data-find-list article))
3489 (data (car datal)) 4172 (data (car datal))
3490 (length (when (cdr datal)
3491 (- (gnus-data-pos data)
3492 (gnus-data-pos (cadr datal)))))
3493 (buffer-read-only nil) 4173 (buffer-read-only nil)
3494 (level (gnus-summary-thread-level))) 4174 (level (gnus-summary-thread-level)))
3495 (gnus-delete-line) 4175 (gnus-delete-line)
3496 (gnus-summary-insert-line 4176 (let ((inserted (- (point)
3497 header level nil (gnus-article-mark article) 4177 (progn
3498 (memq article gnus-newsgroup-replied) 4178 (gnus-summary-insert-line
3499 (memq article gnus-newsgroup-expirable) 4179 header level nil
3500 ;; Only insert the Subject string when it's different 4180 (memq article gnus-newsgroup-undownloaded)
3501 ;; from the previous Subject string. 4181 (gnus-article-mark article)
3502 (if (and 4182 (memq article gnus-newsgroup-replied)
3503 gnus-show-threads 4183 (memq article gnus-newsgroup-expirable)
3504 (gnus-subject-equal 4184 ;; Only insert the Subject string when it's different
3505 (condition-case () 4185 ;; from the previous Subject string.
3506 (mail-header-subject 4186 (if (and
3507 (gnus-data-header 4187 gnus-show-threads
3508 (cadr 4188 (gnus-subject-equal
3509 (gnus-data-find-list 4189 (condition-case ()
3510 article 4190 (mail-header-subject
3511 (gnus-data-list t))))) 4191 (gnus-data-header
3512 ;; Error on the side of excessive subjects. 4192 (cadr
3513 (error "")) 4193 (gnus-data-find-list
3514 (mail-header-subject header))) 4194 article
3515 "" 4195 (gnus-data-list t)))))
3516 (mail-header-subject header)) 4196 ;; Error on the side of excessive subjects.
3517 nil (cdr (assq article gnus-newsgroup-scored)) 4197 (error ""))
3518 (memq article gnus-newsgroup-processable)) 4198 (mail-header-subject header)))
3519 (when length 4199 ""
3520 (gnus-data-update-list 4200 (mail-header-subject header))
3521 (cdr datal) (- length (- (gnus-data-pos data) (point)))))))) 4201 nil (cdr (assq article gnus-newsgroup-scored))
4202 (memq article gnus-newsgroup-processable))
4203 (point)))))
4204 (when (cdr datal)
4205 (gnus-data-update-list
4206 (cdr datal)
4207 (- (gnus-data-pos data) (gnus-data-pos (cadr datal)) inserted)))))))
3522 4208
3523 (defun gnus-summary-update-article (article &optional iheader) 4209 (defun gnus-summary-update-article (article &optional iheader)
3524 "Update ARTICLE in the summary buffer." 4210 "Update ARTICLE in the summary buffer."
3525 (set-buffer gnus-summary-buffer) 4211 (set-buffer gnus-summary-buffer)
3526 (let* ((header (gnus-summary-article-header article)) 4212 (let* ((header (gnus-summary-article-header article))
3754 (defun gnus-sort-threads (threads) 4440 (defun gnus-sort-threads (threads)
3755 "Sort THREADS." 4441 "Sort THREADS."
3756 (if (not gnus-thread-sort-functions) 4442 (if (not gnus-thread-sort-functions)
3757 threads 4443 threads
3758 (gnus-message 8 "Sorting threads...") 4444 (gnus-message 8 "Sorting threads...")
3759 (prog1 4445 (let ((max-lisp-eval-depth 5000))
3760 (gnus-sort-threads-1 4446 (prog1 (gnus-sort-threads-1
3761 threads 4447 threads
3762 (gnus-make-sort-function gnus-thread-sort-functions)) 4448 (gnus-make-sort-function gnus-thread-sort-functions))
3763 (gnus-message 8 "Sorting threads...done")))) 4449 (gnus-message 8 "Sorting threads...done")))))
3764 4450
3765 (defun gnus-sort-articles (articles) 4451 (defun gnus-sort-articles (articles)
3766 "Sort ARTICLES." 4452 "Sort ARTICLES."
3767 (when gnus-article-sort-functions 4453 (when gnus-article-sort-functions
3768 (gnus-message 7 "Sorting articles...") 4454 (gnus-message 7 "Sorting articles...")
3788 (mail-header-number h2))) 4474 (mail-header-number h2)))
3789 4475
3790 (defun gnus-thread-sort-by-number (h1 h2) 4476 (defun gnus-thread-sort-by-number (h1 h2)
3791 "Sort threads by root article number." 4477 "Sort threads by root article number."
3792 (gnus-article-sort-by-number 4478 (gnus-article-sort-by-number
4479 (gnus-thread-header h1) (gnus-thread-header h2)))
4480
4481 (defsubst gnus-article-sort-by-random (h1 h2)
4482 "Sort articles by article number."
4483 (zerop (random 2)))
4484
4485 (defun gnus-thread-sort-by-random (h1 h2)
4486 "Sort threads by root article number."
4487 (gnus-article-sort-by-random
3793 (gnus-thread-header h1) (gnus-thread-header h2))) 4488 (gnus-thread-header h1) (gnus-thread-header h2)))
3794 4489
3795 (defsubst gnus-article-sort-by-lines (h1 h2) 4490 (defsubst gnus-article-sort-by-lines (h1 h2)
3796 "Sort articles by article Lines header." 4491 "Sort articles by article Lines header."
3797 (< (mail-header-lines h1) 4492 (< (mail-header-lines h1)
3871 Unscored articles will be counted as having a score of zero." 4566 Unscored articles will be counted as having a score of zero."
3872 (> (gnus-thread-total-score h1) (gnus-thread-total-score h2))) 4567 (> (gnus-thread-total-score h1) (gnus-thread-total-score h2)))
3873 4568
3874 (defun gnus-thread-total-score (thread) 4569 (defun gnus-thread-total-score (thread)
3875 ;; This function find the total score of THREAD. 4570 ;; This function find the total score of THREAD.
3876 (cond ((null thread) 4571 (cond
3877 0) 4572 ((null thread)
3878 ((consp thread) 4573 0)
3879 (if (stringp (car thread)) 4574 ((consp thread)
3880 (apply gnus-thread-score-function 0 4575 (if (stringp (car thread))
3881 (mapcar 'gnus-thread-total-score-1 (cdr thread))) 4576 (apply gnus-thread-score-function 0
3882 (gnus-thread-total-score-1 thread))) 4577 (mapcar 'gnus-thread-total-score-1 (cdr thread)))
3883 (t 4578 (gnus-thread-total-score-1 thread)))
3884 (gnus-thread-total-score-1 (list thread))))) 4579 (t
4580 (gnus-thread-total-score-1 (list thread)))))
4581
4582 (defun gnus-thread-sort-by-most-recent-number (h1 h2)
4583 "Sort threads such that the thread with the most recently arrived article comes first."
4584 (> (gnus-thread-highest-number h1) (gnus-thread-highest-number h2)))
4585
4586 (defun gnus-thread-highest-number (thread)
4587 "Return the highest article number in THREAD."
4588 (apply 'max (mapcar (lambda (header)
4589 (mail-header-number header))
4590 (message-flatten-list thread))))
4591
4592 (defun gnus-thread-sort-by-most-recent-date (h1 h2)
4593 "Sort threads such that the thread with the most recently dated article comes first."
4594 (> (gnus-thread-latest-date h1) (gnus-thread-latest-date h2)))
4595
4596 (defun gnus-thread-latest-date (thread)
4597 "Return the highest article date in THREAD."
4598 (let ((previous-time 0))
4599 (apply 'max
4600 (mapcar
4601 (lambda (header)
4602 (setq previous-time
4603 (condition-case ()
4604 (time-to-seconds (mail-header-parse-date
4605 (mail-header-date header)))
4606 (error previous-time))))
4607 (sort
4608 (message-flatten-list thread)
4609 (lambda (h1 h2)
4610 (< (mail-header-number h1)
4611 (mail-header-number h2))))))))
3885 4612
3886 (defun gnus-thread-total-score-1 (root) 4613 (defun gnus-thread-total-score-1 (root)
3887 ;; This function find the total score of the thread below ROOT. 4614 ;; This function find the total score of the thread below ROOT.
3888 (setq root (car root)) 4615 (setq root (car root))
3889 (apply gnus-thread-score-function 4616 (apply gnus-thread-score-function
3907 (defun gnus-extra-header (type &optional header) 4634 (defun gnus-extra-header (type &optional header)
3908 "Return the extra header of TYPE." 4635 "Return the extra header of TYPE."
3909 (or (cdr (assq type (mail-header-extra (or header gnus-tmp-header)))) 4636 (or (cdr (assq type (mail-header-extra (or header gnus-tmp-header))))
3910 "")) 4637 ""))
3911 4638
4639 (defvar gnus-tmp-thread-tree-header-string "")
4640
4641 (defcustom gnus-sum-thread-tree-root "> "
4642 "With %B spec, used for the root of a thread.
4643 If nil, use subject instead."
4644 :version "22.1"
4645 :type '(radio (const :format "%v " nil) string)
4646 :group 'gnus-thread)
4647 (defcustom gnus-sum-thread-tree-false-root "> "
4648 "With %B spec, used for a false root of a thread.
4649 If nil, use subject instead."
4650 :version "22.1"
4651 :type '(radio (const :format "%v " nil) string)
4652 :group 'gnus-thread)
4653 (defcustom gnus-sum-thread-tree-single-indent ""
4654 "With %B spec, used for a thread with just one message.
4655 If nil, use subject instead."
4656 :version "22.1"
4657 :type '(radio (const :format "%v " nil) string)
4658 :group 'gnus-thread)
4659 (defcustom gnus-sum-thread-tree-vertical "| "
4660 "With %B spec, used for drawing a vertical line."
4661 :version "22.1"
4662 :type 'string
4663 :group 'gnus-thread)
4664 (defcustom gnus-sum-thread-tree-indent " "
4665 "With %B spec, used for indenting."
4666 :version "22.1"
4667 :type 'string
4668 :group 'gnus-thread)
4669 (defcustom gnus-sum-thread-tree-leaf-with-other "+-> "
4670 "With %B spec, used for a leaf with brothers."
4671 :version "22.1"
4672 :type 'string
4673 :group 'gnus-thread)
4674 (defcustom gnus-sum-thread-tree-single-leaf "\\-> "
4675 "With %B spec, used for a leaf without brothers."
4676 :version "22.1"
4677 :type 'string
4678 :group 'gnus-thread)
4679
3912 (defun gnus-summary-prepare-threads (threads) 4680 (defun gnus-summary-prepare-threads (threads)
3913 "Prepare summary buffer from THREADS and indentation LEVEL. 4681 "Prepare summary buffer from THREADS and indentation LEVEL.
3914 THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])' 4682 THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])'
3915 or a straight list of headers." 4683 or a straight list of headers."
3916 (gnus-message 7 "Generating summary...") 4684 (gnus-message 7 "Generating summary...")
3919 (beginning-of-line) 4687 (beginning-of-line)
3920 4688
3921 (let ((gnus-tmp-level 0) 4689 (let ((gnus-tmp-level 0)
3922 (default-score (or gnus-summary-default-score 0)) 4690 (default-score (or gnus-summary-default-score 0))
3923 (gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight)) 4691 (gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight))
4692 (building-line-count gnus-summary-display-while-building)
4693 (building-count (integerp gnus-summary-display-while-building))
3924 thread number subject stack state gnus-tmp-gathered beg-match 4694 thread number subject stack state gnus-tmp-gathered beg-match
3925 new-roots gnus-tmp-new-adopts thread-end 4695 new-roots gnus-tmp-new-adopts thread-end simp-subject
3926 gnus-tmp-header gnus-tmp-unread 4696 gnus-tmp-header gnus-tmp-unread gnus-tmp-downloaded
3927 gnus-tmp-replied gnus-tmp-subject-or-nil 4697 gnus-tmp-replied gnus-tmp-subject-or-nil
3928 gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score 4698 gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score
3929 gnus-tmp-score-char gnus-tmp-from gnus-tmp-name 4699 gnus-tmp-score-char gnus-tmp-from gnus-tmp-name
3930 gnus-tmp-number gnus-tmp-opening-bracket gnus-tmp-closing-bracket) 4700 gnus-tmp-number gnus-tmp-opening-bracket gnus-tmp-closing-bracket
3931 4701 tree-stack)
3932 (setq gnus-tmp-prev-subject nil) 4702
4703 (setq gnus-tmp-prev-subject nil
4704 gnus-tmp-thread-tree-header-string "")
3933 4705
3934 (if (vectorp (car threads)) 4706 (if (vectorp (car threads))
3935 ;; If this is a straight (sic) list of headers, then a 4707 ;; If this is a straight (sic) list of headers, then a
3936 ;; threaded summary display isn't required, so we just create 4708 ;; threaded summary display isn't required, so we just create
3937 ;; an unthreaded one. 4709 ;; an unthreaded one.
3938 (gnus-summary-prepare-unthreaded threads) 4710 (gnus-summary-prepare-unthreaded threads)
3939 4711
3940 ;; Do the threaded display. 4712 ;; Do the threaded display.
3941 4713
4714 (if gnus-summary-display-while-building
4715 (switch-to-buffer (buffer-name)))
3942 (while (or threads stack gnus-tmp-new-adopts new-roots) 4716 (while (or threads stack gnus-tmp-new-adopts new-roots)
3943 4717
3944 (if (and (= gnus-tmp-level 0) 4718 (if (and (= gnus-tmp-level 0)
3945 (or (not stack) 4719 (or (not stack)
3946 (= (caar stack) 0)) 4720 (= (caar stack) 0))
3963 gnus-tmp-header (caar thread)) 4737 gnus-tmp-header (caar thread))
3964 ;; There were no current threads, so we pop something off 4738 ;; There were no current threads, so we pop something off
3965 ;; the stack. 4739 ;; the stack.
3966 (setq state (car stack) 4740 (setq state (car stack)
3967 gnus-tmp-level (car state) 4741 gnus-tmp-level (car state)
3968 thread (cdr state) 4742 tree-stack (cadr state)
4743 thread (caddr state)
3969 stack (cdr stack) 4744 stack (cdr stack)
3970 gnus-tmp-header (caar thread)))) 4745 gnus-tmp-header (caar thread))))
3971 4746
3972 (setq gnus-tmp-false-parent nil) 4747 (setq gnus-tmp-false-parent nil)
3973 (setq gnus-tmp-root-expunged nil) 4748 (setq gnus-tmp-root-expunged nil)
4007 ;; We do not make a root for the gathered 4782 ;; We do not make a root for the gathered
4008 ;; sub-threads at all. 4783 ;; sub-threads at all.
4009 (setq gnus-tmp-level -1))) 4784 (setq gnus-tmp-level -1)))
4010 4785
4011 (setq number (mail-header-number gnus-tmp-header) 4786 (setq number (mail-header-number gnus-tmp-header)
4012 subject (mail-header-subject gnus-tmp-header)) 4787 subject (mail-header-subject gnus-tmp-header)
4788 simp-subject (gnus-simplify-subject-fully subject))
4013 4789
4014 (cond 4790 (cond
4015 ;; If the thread has changed subject, we might want to make 4791 ;; If the thread has changed subject, we might want to make
4016 ;; this subthread into a root. 4792 ;; this subthread into a root.
4017 ((and (null gnus-thread-ignore-subject) 4793 ((and (null gnus-thread-ignore-subject)
4018 (not (zerop gnus-tmp-level)) 4794 (not (zerop gnus-tmp-level))
4019 gnus-tmp-prev-subject 4795 gnus-tmp-prev-subject
4020 (not (inline 4796 (not (string= gnus-tmp-prev-subject simp-subject)))
4021 (gnus-subject-equal gnus-tmp-prev-subject subject))))
4022 (setq new-roots (nconc new-roots (list (car thread))) 4797 (setq new-roots (nconc new-roots (list (car thread)))
4023 thread-end t 4798 thread-end t
4024 gnus-tmp-header nil)) 4799 gnus-tmp-header nil))
4025 ;; If the article lies outside the current limit, 4800 ;; If the article lies outside the current limit,
4026 ;; then we do not display it. 4801 ;; then we do not display it.
4047 (not (gnus-summary-article-sparse-p number)) 4822 (not (gnus-summary-article-sparse-p number))
4048 (not (gnus-summary-article-ancient-p number))) 4823 (not (gnus-summary-article-ancient-p number)))
4049 (setq gnus-newsgroup-unreads 4824 (setq gnus-newsgroup-unreads
4050 (delq number gnus-newsgroup-unreads)) 4825 (delq number gnus-newsgroup-unreads))
4051 (if gnus-newsgroup-auto-expire 4826 (if gnus-newsgroup-auto-expire
4052 (push number gnus-newsgroup-expirable) 4827 (setq gnus-newsgroup-expirable
4828 (gnus-add-to-sorted-list
4829 gnus-newsgroup-expirable number))
4053 (push (cons number gnus-low-score-mark) 4830 (push (cons number gnus-low-score-mark)
4054 gnus-newsgroup-reads)))) 4831 gnus-newsgroup-reads))))
4055 4832
4056 (when gnus-tmp-header 4833 (when gnus-tmp-header
4057 ;; We may have an old dummy line to output before this 4834 ;; We may have an old dummy line to output before this
4075 (setq 4852 (setq
4076 gnus-tmp-subject-or-nil 4853 gnus-tmp-subject-or-nil
4077 (cond 4854 (cond
4078 ((and gnus-thread-ignore-subject 4855 ((and gnus-thread-ignore-subject
4079 gnus-tmp-prev-subject 4856 gnus-tmp-prev-subject
4080 (not (inline (gnus-subject-equal 4857 (not (string= gnus-tmp-prev-subject simp-subject)))
4081 gnus-tmp-prev-subject subject))))
4082 subject) 4858 subject)
4083 ((zerop gnus-tmp-level) 4859 ((zerop gnus-tmp-level)
4084 (if (and (eq gnus-summary-make-false-root 'empty) 4860 (if (and (eq gnus-summary-make-false-root 'empty)
4085 (memq number gnus-tmp-gathered) 4861 (memq number gnus-tmp-gathered)
4086 gnus-tmp-prev-subject 4862 gnus-tmp-prev-subject
4087 (inline (gnus-subject-equal 4863 (string= gnus-tmp-prev-subject simp-subject))
4088 gnus-tmp-prev-subject subject)))
4089 gnus-summary-same-subject 4864 gnus-summary-same-subject
4090 subject)) 4865 subject))
4091 (t gnus-summary-same-subject))) 4866 (t gnus-summary-same-subject)))
4092 (if (and (eq gnus-summary-make-false-root 'adopt) 4867 (if (and (eq gnus-summary-make-false-root 'adopt)
4093 (= gnus-tmp-level 1) 4868 (= gnus-tmp-level 1)
4104 gnus-summary-default-score 0) 4879 gnus-summary-default-score 0)
4105 gnus-tmp-score-char 4880 gnus-tmp-score-char
4106 (if (or (null gnus-summary-default-score) 4881 (if (or (null gnus-summary-default-score)
4107 (<= (abs (- gnus-tmp-score gnus-summary-default-score)) 4882 (<= (abs (- gnus-tmp-score gnus-summary-default-score))
4108 gnus-summary-zcore-fuzz)) 4883 gnus-summary-zcore-fuzz))
4109 ? ;Whitespace 4884 ? ;Whitespace
4110 (if (< gnus-tmp-score gnus-summary-default-score) 4885 (if (< gnus-tmp-score gnus-summary-default-score)
4111 gnus-score-below-mark gnus-score-over-mark)) 4886 gnus-score-below-mark gnus-score-over-mark))
4112 gnus-tmp-replied 4887 gnus-tmp-replied
4113 (cond ((memq number gnus-newsgroup-processable) 4888 (cond ((memq number gnus-newsgroup-processable)
4114 gnus-process-mark) 4889 gnus-process-mark)
4115 ((memq number gnus-newsgroup-cached) 4890 ((memq number gnus-newsgroup-cached)
4116 gnus-cached-mark) 4891 gnus-cached-mark)
4117 ((memq number gnus-newsgroup-replied) 4892 ((memq number gnus-newsgroup-replied)
4118 gnus-replied-mark) 4893 gnus-replied-mark)
4894 ((memq number gnus-newsgroup-forwarded)
4895 gnus-forwarded-mark)
4119 ((memq number gnus-newsgroup-saved) 4896 ((memq number gnus-newsgroup-saved)
4120 gnus-saved-mark) 4897 gnus-saved-mark)
4121 (t gnus-unread-mark)) 4898 ((memq number gnus-newsgroup-recent)
4899 gnus-recent-mark)
4900 ((memq number gnus-newsgroup-unseen)
4901 gnus-unseen-mark)
4902 (t gnus-no-mark))
4903 gnus-tmp-downloaded
4904 (cond ((memq number gnus-newsgroup-undownloaded)
4905 gnus-undownloaded-mark)
4906 (gnus-newsgroup-agentized
4907 gnus-downloaded-mark)
4908 (t
4909 gnus-no-mark))
4122 gnus-tmp-from (mail-header-from gnus-tmp-header) 4910 gnus-tmp-from (mail-header-from gnus-tmp-header)
4123 gnus-tmp-name 4911 gnus-tmp-name
4124 (cond 4912 (cond
4125 ((string-match "<[^>]+> *$" gnus-tmp-from) 4913 ((string-match "<[^>]+> *$" gnus-tmp-from)
4126 (setq beg-match (match-beginning 0)) 4914 (setq beg-match (match-beginning 0))
4127 (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from) 4915 (or (and (string-match "^\".+\"" gnus-tmp-from)
4128 (substring gnus-tmp-from (1+ (match-beginning 0)) 4916 (substring gnus-tmp-from 1 (1- (match-end 0))))
4129 (1- (match-end 0))))
4130 (substring gnus-tmp-from 0 beg-match))) 4917 (substring gnus-tmp-from 0 beg-match)))
4131 ((string-match "(.+)" gnus-tmp-from) 4918 ((string-match "(.+)" gnus-tmp-from)
4132 (substring gnus-tmp-from 4919 (substring gnus-tmp-from
4133 (1+ (match-beginning 0)) (1- (match-end 0)))) 4920 (1+ (match-beginning 0)) (1- (match-end 0))))
4134 (t gnus-tmp-from))) 4921 (t gnus-tmp-from))
4922
4923 ;; Do the %B string
4924 gnus-tmp-thread-tree-header-string
4925 (cond
4926 ((not gnus-show-threads) "")
4927 ((zerop gnus-tmp-level)
4928 (cond ((cdar thread)
4929 (or gnus-sum-thread-tree-root subject))
4930 (gnus-tmp-new-adopts
4931 (or gnus-sum-thread-tree-false-root subject))
4932 (t
4933 (or gnus-sum-thread-tree-single-indent subject))))
4934 (t
4935 (concat (apply 'concat
4936 (mapcar (lambda (item)
4937 (if (= item 1)
4938 gnus-sum-thread-tree-vertical
4939 gnus-sum-thread-tree-indent))
4940 (cdr (reverse tree-stack))))
4941 (if (nth 1 thread)
4942 gnus-sum-thread-tree-leaf-with-other
4943 gnus-sum-thread-tree-single-leaf)))))
4135 (when (string= gnus-tmp-name "") 4944 (when (string= gnus-tmp-name "")
4136 (setq gnus-tmp-name gnus-tmp-from)) 4945 (setq gnus-tmp-name gnus-tmp-from))
4137 (unless (numberp gnus-tmp-lines) 4946 (unless (numberp gnus-tmp-lines)
4138 (setq gnus-tmp-lines 0)) 4947 (setq gnus-tmp-lines -1))
4139 (gnus-put-text-property 4948 (if (= gnus-tmp-lines -1)
4949 (setq gnus-tmp-lines "?")
4950 (setq gnus-tmp-lines (number-to-string gnus-tmp-lines)))
4951 (gnus-put-text-property
4140 (point) 4952 (point)
4141 (progn (eval gnus-summary-line-format-spec) (point)) 4953 (progn (eval gnus-summary-line-format-spec) (point))
4142 'gnus-number number) 4954 'gnus-number number)
4143 (when gnus-visual-p 4955 (when gnus-visual-p
4144 (forward-line -1) 4956 (forward-line -1)
4145 (gnus-run-hooks 'gnus-summary-update-hook) 4957 (gnus-run-hooks 'gnus-summary-update-hook)
4146 (forward-line 1)) 4958 (forward-line 1))
4147 4959
4148 (setq gnus-tmp-prev-subject subject))) 4960 (setq gnus-tmp-prev-subject simp-subject)))
4149 4961
4150 (when (nth 1 thread) 4962 (when (nth 1 thread)
4151 (push (cons (max 0 gnus-tmp-level) (nthcdr 1 thread)) stack)) 4963 (push (list (max 0 gnus-tmp-level)
4964 (copy-sequence tree-stack)
4965 (nthcdr 1 thread))
4966 stack))
4967 (push (if (nth 1 thread) 1 0) tree-stack)
4152 (incf gnus-tmp-level) 4968 (incf gnus-tmp-level)
4153 (setq threads (if thread-end nil (cdar thread))) 4969 (setq threads (if thread-end nil (cdar thread)))
4970 (if gnus-summary-display-while-building
4971 (if building-count
4972 (progn
4973 ;; use a set frequency
4974 (setq building-line-count (1- building-line-count))
4975 (when (= building-line-count 0)
4976 (sit-for 0)
4977 (setq building-line-count
4978 gnus-summary-display-while-building)))
4979 ;; always
4980 (sit-for 0)))
4154 (unless threads 4981 (unless threads
4155 (setq gnus-tmp-level 0))))) 4982 (setq gnus-tmp-level 0)))))
4156 (gnus-message 7 "Generating summary...done")) 4983 (gnus-message 7 "Generating summary...done"))
4157 4984
4158 (defun gnus-summary-prepare-unthreaded (headers) 4985 (defun gnus-summary-prepare-unthreaded (headers)
4182 (setq mark (gnus-article-mark number)) 5009 (setq mark (gnus-article-mark number))
4183 (push (gnus-data-make number mark (1+ (point)) header 0) 5010 (push (gnus-data-make number mark (1+ (point)) header 0)
4184 gnus-newsgroup-data) 5011 gnus-newsgroup-data)
4185 (gnus-summary-insert-line 5012 (gnus-summary-insert-line
4186 header 0 number 5013 header 0 number
5014 (memq number gnus-newsgroup-undownloaded)
4187 mark (memq number gnus-newsgroup-replied) 5015 mark (memq number gnus-newsgroup-replied)
4188 (memq number gnus-newsgroup-expirable) 5016 (memq number gnus-newsgroup-expirable)
4189 (mail-header-subject header) nil 5017 (mail-header-subject header) nil
4190 (cdr (assq number gnus-newsgroup-scored)) 5018 (cdr (assq number gnus-newsgroup-scored))
4191 (memq number gnus-newsgroup-processable)))))) 5019 (memq number gnus-newsgroup-processable))))))
4192 5020
4193 (defun gnus-summary-remove-list-identifiers () 5021 (defun gnus-summary-remove-list-identifiers ()
4194 "Remove list identifiers in `gnus-list-identifiers' from articles in the current group." 5022 "Remove list identifiers in `gnus-list-identifiers' from articles in the current group."
4195 (let ((regexp (if (stringp gnus-list-identifiers) 5023 (let ((regexp (if (consp gnus-list-identifiers)
4196 gnus-list-identifiers 5024 (mapconcat 'identity gnus-list-identifiers " *\\|")
4197 (mapconcat 'identity gnus-list-identifiers " *\\|")))) 5025 gnus-list-identifiers))
4198 (dolist (header gnus-newsgroup-headers) 5026 changed subject)
4199 (when (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp 5027 (when regexp
4200 " *\\)\\)+\\(Re: +\\)?\\)") 5028 (dolist (header gnus-newsgroup-headers)
4201 (mail-header-subject header)) 5029 (setq subject (mail-header-subject header)
4202 (mail-header-set-subject 5030 changed nil)
4203 header (concat (substring (mail-header-subject header) 5031 (while (string-match
4204 0 (match-beginning 1)) 5032 (concat "^\\(R[Ee]: +\\)*\\(" regexp " *\\)")
4205 (or 5033 subject)
4206 (match-string 3 (mail-header-subject header)) 5034 (setq subject
4207 (match-string 5 (mail-header-subject header))) 5035 (concat (substring subject 0 (match-beginning 2))
4208 (substring (mail-header-subject header) 5036 (substring subject (match-end 0)))
4209 (match-end 1)))))))) 5037 changed t))
5038 (when (and changed
5039 (string-match
5040 "^\\(\\(R[Ee]: +\\)+\\)R[Ee]: +" subject))
5041 (setq subject
5042 (concat (substring subject 0 (match-beginning 1))
5043 (substring subject (match-end 1)))))
5044 (when changed
5045 (mail-header-set-subject header subject))))))
5046
5047 (defun gnus-fetch-headers (articles)
5048 "Fetch headers of ARTICLES."
5049 (let ((name (gnus-group-decoded-name gnus-newsgroup-name)))
5050 (gnus-message 5 "Fetching headers for %s..." name)
5051 (prog1
5052 (if (eq 'nov
5053 (setq gnus-headers-retrieved-by
5054 (gnus-retrieve-headers
5055 articles gnus-newsgroup-name
5056 ;; We might want to fetch old headers, but
5057 ;; not if there is only 1 article.
5058 (and (or (and
5059 (not (eq gnus-fetch-old-headers 'some))
5060 (not (numberp gnus-fetch-old-headers)))
5061 (> (length articles) 1))
5062 gnus-fetch-old-headers))))
5063 (gnus-get-newsgroup-headers-xover
5064 articles nil nil gnus-newsgroup-name t)
5065 (gnus-get-newsgroup-headers))
5066 (gnus-message 5 "Fetching headers for %s...done" name))))
4210 5067
4211 (defun gnus-select-newsgroup (group &optional read-all select-articles) 5068 (defun gnus-select-newsgroup (group &optional read-all select-articles)
4212 "Select newsgroup GROUP. 5069 "Select newsgroup GROUP.
4213 If READ-ALL is non-nil, all articles in the group are selected. 5070 If READ-ALL is non-nil, all articles in the group are selected.
4214 If SELECT-ARTICLES, only select those articles from GROUP." 5071 If SELECT-ARTICLES, only select those articles from GROUP."
4215 (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) 5072 (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
4216 ;;!!! Dirty hack; should be removed. 5073 ;;!!! Dirty hack; should be removed.
4217 (gnus-summary-ignore-duplicates 5074 (gnus-summary-ignore-duplicates
4218 (if (eq (car (gnus-find-method-for-group group)) 'nnvirtual) 5075 (if (eq (car (gnus-find-method-for-group group)) 'nnvirtual)
4219 t 5076 t
4220 gnus-summary-ignore-duplicates)) 5077 gnus-summary-ignore-duplicates))
4221 (info (nth 2 entry)) 5078 (info (nth 2 entry))
4222 articles fetched-articles cached) 5079 articles fetched-articles cached)
4223 5080
4228 5085
4229 (or (and entry (not (eq (car entry) t))) ; Either it's active... 5086 (or (and entry (not (eq (car entry) t))) ; Either it's active...
4230 (gnus-activate-group group) ; Or we can activate it... 5087 (gnus-activate-group group) ; Or we can activate it...
4231 (progn ; Or we bug out. 5088 (progn ; Or we bug out.
4232 (when (equal major-mode 'gnus-summary-mode) 5089 (when (equal major-mode 'gnus-summary-mode)
4233 (kill-buffer (current-buffer))) 5090 (gnus-kill-buffer (current-buffer)))
4234 (error "Couldn't request group %s: %s" 5091 (error "Couldn't activate group %s: %s"
4235 group (gnus-status-message group)))) 5092 group (gnus-status-message group))))
4236 5093
4237 (unless (gnus-request-group group t) 5094 (unless (gnus-request-group group t)
4238 (when (equal major-mode 'gnus-summary-mode) 5095 (when (equal major-mode 'gnus-summary-mode)
4239 (kill-buffer (current-buffer))) 5096 (gnus-kill-buffer (current-buffer)))
4240 (error "Couldn't request group %s: %s" 5097 (error "Couldn't request group %s: %s"
4241 group (gnus-status-message group))) 5098 group (gnus-status-message group)))
4242 5099
4243 (setq gnus-newsgroup-name group) 5100 (when gnus-agent
4244 (setq gnus-newsgroup-unselected nil) 5101 (gnus-agent-possibly-alter-active group (gnus-active group) info)
4245 (setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group)) 5102
5103 (setq gnus-summary-use-undownloaded-faces
5104 (gnus-agent-find-parameter
5105 group
5106 'agent-enable-undownloaded-faces)))
5107
5108 (setq gnus-newsgroup-name group
5109 gnus-newsgroup-unselected nil
5110 gnus-newsgroup-unreads (gnus-list-of-unread-articles group))
5111
5112 (let ((display (gnus-group-find-parameter group 'display)))
5113 (setq gnus-newsgroup-display
5114 (cond
5115 ((not (zerop (or (car-safe read-all) 0)))
5116 ;; The user entered the group with C-u SPC/RET, let's show
5117 ;; all articles.
5118 'gnus-not-ignore)
5119 ((eq display 'all)
5120 'gnus-not-ignore)
5121 ((arrayp display)
5122 (gnus-summary-display-make-predicate (mapcar 'identity display)))
5123 ((numberp display)
5124 ;; The following is probably the "correct" solution, but
5125 ;; it makes Gnus fetch all headers and then limit the
5126 ;; articles (which is slow), so instead we hack the
5127 ;; select-articles parameter instead. -- Simon Josefsson
5128 ;; <jas@kth.se>
5129 ;;
5130 ;; (gnus-byte-compile
5131 ;; `(lambda () (> number ,(- (cdr (gnus-active group))
5132 ;; display)))))
5133 (setq select-articles
5134 (gnus-uncompress-range
5135 (cons (let ((tmp (- (cdr (gnus-active group)) display)))
5136 (if (> tmp 0)
5137 tmp
5138 1))
5139 (cdr (gnus-active group)))))
5140 nil)
5141 (t
5142 nil))))
5143
4246 (gnus-summary-setup-default-charset) 5144 (gnus-summary-setup-default-charset)
5145
5146 ;; Kludge to avoid having cached articles nixed out in virtual groups.
5147 (when (gnus-virtual-group-p group)
5148 (setq cached gnus-newsgroup-cached))
5149
5150 (setq gnus-newsgroup-unreads
5151 (gnus-sorted-ndifference
5152 (gnus-sorted-ndifference gnus-newsgroup-unreads
5153 gnus-newsgroup-marked)
5154 gnus-newsgroup-dormant))
5155
5156 (setq gnus-newsgroup-processable nil)
5157
5158 (gnus-update-read-articles group gnus-newsgroup-unreads)
4247 5159
4248 ;; Adjust and set lists of article marks. 5160 ;; Adjust and set lists of article marks.
4249 (when info 5161 (when info
4250 (gnus-adjust-marked-articles info)) 5162 (gnus-adjust-marked-articles info))
4251
4252 ;; Kludge to avoid having cached articles nixed out in virtual groups.
4253 (when (gnus-virtual-group-p group)
4254 (setq cached gnus-newsgroup-cached))
4255
4256 (setq gnus-newsgroup-unreads
4257 (gnus-set-difference
4258 (gnus-set-difference gnus-newsgroup-unreads gnus-newsgroup-marked)
4259 gnus-newsgroup-dormant))
4260
4261 (setq gnus-newsgroup-processable nil)
4262
4263 (gnus-update-read-articles group gnus-newsgroup-unreads)
4264
4265 (if (setq articles select-articles) 5163 (if (setq articles select-articles)
4266 (setq gnus-newsgroup-unselected 5164 (setq gnus-newsgroup-unselected
4267 (gnus-sorted-intersection 5165 (gnus-sorted-difference gnus-newsgroup-unreads articles))
4268 gnus-newsgroup-unreads
4269 (gnus-sorted-complement gnus-newsgroup-unreads articles)))
4270 (setq articles (gnus-articles-to-read group read-all))) 5166 (setq articles (gnus-articles-to-read group read-all)))
4271 5167
4272 (cond 5168 (cond
4273 ((null articles) 5169 ((null articles)
4274 ;;(gnus-message 3 "Couldn't select newsgroup -- no articles to display") 5170 ;;(gnus-message 3 "Couldn't select newsgroup -- no articles to display")
4278 ;; Init the dependencies hash table. 5174 ;; Init the dependencies hash table.
4279 (setq gnus-newsgroup-dependencies 5175 (setq gnus-newsgroup-dependencies
4280 (gnus-make-hashtable (length articles))) 5176 (gnus-make-hashtable (length articles)))
4281 (gnus-set-global-variables) 5177 (gnus-set-global-variables)
4282 ;; Retrieve the headers and read them in. 5178 ;; Retrieve the headers and read them in.
4283 (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name) 5179
4284 (setq gnus-newsgroup-headers 5180 (setq gnus-newsgroup-headers (gnus-fetch-headers articles))
4285 (if (eq 'nov
4286 (setq gnus-headers-retrieved-by
4287 (gnus-retrieve-headers
4288 articles gnus-newsgroup-name
4289 ;; We might want to fetch old headers, but
4290 ;; not if there is only 1 article.
4291 (and (or (and
4292 (not (eq gnus-fetch-old-headers 'some))
4293 (not (numberp gnus-fetch-old-headers)))
4294 (> (length articles) 1))
4295 gnus-fetch-old-headers))))
4296 (gnus-get-newsgroup-headers-xover
4297 articles nil nil gnus-newsgroup-name t)
4298 (gnus-get-newsgroup-headers)))
4299 (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name)
4300 5181
4301 ;; Kludge to avoid having cached articles nixed out in virtual groups. 5182 ;; Kludge to avoid having cached articles nixed out in virtual groups.
4302 (when cached 5183 (when cached
4303 (setq gnus-newsgroup-cached cached)) 5184 (setq gnus-newsgroup-cached cached))
4304 5185
4307 (gnus-dup-suppress-articles)) 5188 (gnus-dup-suppress-articles))
4308 5189
4309 ;; Set the initial limit. 5190 ;; Set the initial limit.
4310 (setq gnus-newsgroup-limit (copy-sequence articles)) 5191 (setq gnus-newsgroup-limit (copy-sequence articles))
4311 ;; Remove canceled articles from the list of unread articles. 5192 ;; Remove canceled articles from the list of unread articles.
5193 (setq fetched-articles
5194 (mapcar (lambda (headers) (mail-header-number headers))
5195 gnus-newsgroup-headers))
5196 (setq gnus-newsgroup-articles fetched-articles)
4312 (setq gnus-newsgroup-unreads 5197 (setq gnus-newsgroup-unreads
4313 (gnus-set-sorted-intersection 5198 (gnus-sorted-nintersection
4314 gnus-newsgroup-unreads 5199 gnus-newsgroup-unreads fetched-articles))
4315 (setq fetched-articles 5200 (gnus-compute-unseen-list)
4316 (mapcar (lambda (headers) (mail-header-number headers)) 5201
4317 gnus-newsgroup-headers))))
4318 ;; Removed marked articles that do not exist. 5202 ;; Removed marked articles that do not exist.
4319 (gnus-update-missing-marks 5203 (gnus-update-missing-marks
4320 (gnus-sorted-complement fetched-articles articles)) 5204 (gnus-sorted-difference articles fetched-articles))
4321 ;; We might want to build some more threads first. 5205 ;; We might want to build some more threads first.
4322 (when (and gnus-fetch-old-headers 5206 (when (and gnus-fetch-old-headers
4323 (eq gnus-headers-retrieved-by 'nov)) 5207 (eq gnus-headers-retrieved-by 'nov))
4324 (if (eq gnus-fetch-old-headers 'invisible) 5208 (if (eq gnus-fetch-old-headers 'invisible)
4325 (gnus-build-all-threads) 5209 (gnus-build-all-threads)
4344 (mail-header-number 5228 (mail-header-number
4345 (gnus-last-element gnus-newsgroup-headers)))) 5229 (gnus-last-element gnus-newsgroup-headers))))
4346 ;; GROUP is successfully selected. 5230 ;; GROUP is successfully selected.
4347 (or gnus-newsgroup-headers t))))) 5231 (or gnus-newsgroup-headers t)))))
4348 5232
5233 (defun gnus-compute-unseen-list ()
5234 ;; The `seen' marks are treated specially.
5235 (if (not gnus-newsgroup-seen)
5236 (setq gnus-newsgroup-unseen gnus-newsgroup-articles)
5237 (setq gnus-newsgroup-unseen
5238 (gnus-inverse-list-range-intersection
5239 gnus-newsgroup-articles gnus-newsgroup-seen))))
5240
5241 (defun gnus-summary-display-make-predicate (display)
5242 (require 'gnus-agent)
5243 (when (= (length display) 1)
5244 (setq display (car display)))
5245 (unless gnus-summary-display-cache
5246 (dolist (elem (append '((unread . unread)
5247 (read . read)
5248 (unseen . unseen))
5249 gnus-article-mark-lists))
5250 (push (cons (cdr elem)
5251 (gnus-byte-compile
5252 `(lambda () (gnus-article-marked-p ',(cdr elem)))))
5253 gnus-summary-display-cache)))
5254 (let ((gnus-category-predicate-alist gnus-summary-display-cache)
5255 (gnus-category-predicate-cache gnus-summary-display-cache))
5256 (gnus-get-predicate display)))
5257
5258 ;; Uses the dynamically bound `number' variable.
5259 (eval-when-compile
5260 (defvar number))
5261 (defun gnus-article-marked-p (type &optional article)
5262 (let ((article (or article number)))
5263 (cond
5264 ((eq type 'tick)
5265 (memq article gnus-newsgroup-marked))
5266 ((eq type 'spam)
5267 (memq article gnus-newsgroup-spam-marked))
5268 ((eq type 'unsend)
5269 (memq article gnus-newsgroup-unsendable))
5270 ((eq type 'undownload)
5271 (memq article gnus-newsgroup-undownloaded))
5272 ((eq type 'download)
5273 (memq article gnus-newsgroup-downloadable))
5274 ((eq type 'unread)
5275 (memq article gnus-newsgroup-unreads))
5276 ((eq type 'read)
5277 (memq article gnus-newsgroup-reads))
5278 ((eq type 'dormant)
5279 (memq article gnus-newsgroup-dormant) )
5280 ((eq type 'expire)
5281 (memq article gnus-newsgroup-expirable))
5282 ((eq type 'reply)
5283 (memq article gnus-newsgroup-replied))
5284 ((eq type 'killed)
5285 (memq article gnus-newsgroup-killed))
5286 ((eq type 'bookmark)
5287 (assq article gnus-newsgroup-bookmarks))
5288 ((eq type 'score)
5289 (assq article gnus-newsgroup-scored))
5290 ((eq type 'save)
5291 (memq article gnus-newsgroup-saved))
5292 ((eq type 'cache)
5293 (memq article gnus-newsgroup-cached))
5294 ((eq type 'forward)
5295 (memq article gnus-newsgroup-forwarded))
5296 ((eq type 'seen)
5297 (not (memq article gnus-newsgroup-unseen)))
5298 ((eq type 'recent)
5299 (memq article gnus-newsgroup-recent))
5300 (t t))))
5301
4349 (defun gnus-articles-to-read (group &optional read-all) 5302 (defun gnus-articles-to-read (group &optional read-all)
4350 "Find out what articles the user wants to read." 5303 "Find out what articles the user wants to read."
4351 (let* ((articles 5304 (let* ((display (gnus-group-find-parameter group 'display))
5305 (articles
4352 ;; Select all articles if `read-all' is non-nil, or if there 5306 ;; Select all articles if `read-all' is non-nil, or if there
4353 ;; are no unread articles. 5307 ;; are no unread articles.
4354 (if (or read-all 5308 (if (or read-all
4355 (and (zerop (length gnus-newsgroup-marked)) 5309 (and (zerop (length gnus-newsgroup-marked))
4356 (zerop (length gnus-newsgroup-unreads))) 5310 (zerop (length gnus-newsgroup-unreads)))
4357 (eq (gnus-group-find-parameter group 'display) 5311 ;; Fetch all if the predicate is non-nil.
4358 'all)) 5312 gnus-newsgroup-display)
5313 ;; We want to select the headers for all the articles in
5314 ;; the group, so we select either all the active
5315 ;; articles in the group, or (if that's nil), the
5316 ;; articles in the cache.
4359 (or 5317 (or
4360 (gnus-uncompress-range (gnus-active group)) 5318 (gnus-uncompress-range (gnus-active group))
4361 (gnus-cache-articles-in-group group)) 5319 (gnus-cache-articles-in-group group))
4362 (sort (append gnus-newsgroup-dormant gnus-newsgroup-marked 5320 ;; Select only the "normal" subset of articles.
4363 (copy-sequence gnus-newsgroup-unreads)) 5321 (gnus-sorted-nunion
4364 '<))) 5322 (gnus-sorted-union gnus-newsgroup-dormant gnus-newsgroup-marked)
5323 gnus-newsgroup-unreads)))
4365 (scored-list (gnus-killed-articles gnus-newsgroup-killed articles)) 5324 (scored-list (gnus-killed-articles gnus-newsgroup-killed articles))
4366 (scored (length scored-list)) 5325 (scored (length scored-list))
4367 (number (length articles)) 5326 (number (length articles))
4368 (marked (+ (length gnus-newsgroup-marked) 5327 (marked (+ (length gnus-newsgroup-marked)
4369 (length gnus-newsgroup-dormant))) 5328 (length gnus-newsgroup-dormant)))
4370 (select 5329 (select
4371 (cond 5330 (cond
4372 ((numberp read-all) 5331 ((numberp read-all)
4373 read-all) 5332 read-all)
5333 ((numberp gnus-newsgroup-display)
5334 gnus-newsgroup-display)
4374 (t 5335 (t
4375 (condition-case () 5336 (condition-case ()
4376 (cond 5337 (cond
4377 ((and (or (<= scored marked) (= scored number)) 5338 ((and (or (<= scored marked) (= scored number))
4378 (numberp gnus-large-newsgroup) 5339 (numberp gnus-large-newsgroup)
4379 (> number gnus-large-newsgroup)) 5340 (> number gnus-large-newsgroup))
4380 (let ((input 5341 (let* ((cursor-in-echo-area nil)
4381 (read-string 5342 (initial (gnus-parameter-large-newsgroup-initial
4382 (format 5343 gnus-newsgroup-name))
4383 "How many articles from %s (default %d): " 5344 (input
4384 (gnus-limit-string gnus-newsgroup-name 35) 5345 (read-string
4385 number)))) 5346 (format
5347 "How many articles from %s (%s %d): "
5348 (gnus-limit-string
5349 (gnus-group-decoded-name gnus-newsgroup-name)
5350 35)
5351 (if initial "max" "default")
5352 number)
5353 (if initial
5354 (cons (number-to-string initial)
5355 0)))))
4386 (if (string-match "^[ \t]*$" input) number input))) 5356 (if (string-match "^[ \t]*$" input) number input)))
4387 ((and (> scored marked) (< scored number) 5357 ((and (> scored marked) (< scored number)
4388 (> (- scored number) 20)) 5358 (> (- scored number) 20))
4389 (let ((input 5359 (let ((input
4390 (read-string 5360 (read-string
4391 (format "%s %s (%d scored, %d total): " 5361 (format "%s %s (%d scored, %d total): "
4392 "How many articles from" 5362 "How many articles from"
4393 group scored number)))) 5363 (gnus-group-decoded-name group)
5364 scored number))))
4394 (if (string-match "^[ \t]*$" input) 5365 (if (string-match "^[ \t]*$" input)
4395 number input))) 5366 number input)))
4396 (t number)) 5367 (t number))
4397 (quit 5368 (quit
4398 (message "Quit getting the articles to read") 5369 (message "Quit getting the articles to read")
4411 ;; Select the N oldest articles. 5382 ;; Select the N oldest articles.
4412 (setcdr (nthcdr (1- (abs select)) articles) nil) 5383 (setcdr (nthcdr (1- (abs select)) articles) nil)
4413 ;; Select the N most recent articles. 5384 ;; Select the N most recent articles.
4414 (setq articles (nthcdr (- number select) articles)))) 5385 (setq articles (nthcdr (- number select) articles))))
4415 (setq gnus-newsgroup-unselected 5386 (setq gnus-newsgroup-unselected
4416 (gnus-sorted-intersection 5387 (gnus-sorted-difference gnus-newsgroup-unreads articles))
4417 gnus-newsgroup-unreads
4418 (gnus-sorted-complement gnus-newsgroup-unreads articles)))
4419 (when gnus-alter-articles-to-read-function 5388 (when gnus-alter-articles-to-read-function
4420 (setq gnus-newsgroup-unreads 5389 (setq articles
4421 (sort 5390 (sort
4422 (funcall gnus-alter-articles-to-read-function 5391 (funcall gnus-alter-articles-to-read-function
4423 gnus-newsgroup-name gnus-newsgroup-unreads) 5392 gnus-newsgroup-name articles)
4424 '<))) 5393 '<)))
4425 articles))) 5394 articles)))
4426 5395
4427 (defun gnus-killed-articles (killed articles) 5396 (defun gnus-killed-articles (killed articles)
4428 (let (out) 5397 (let (out)
4441 (push (car marks) out) 5410 (push (car marks) out)
4442 (push (cons (caar marks) (gnus-uncompress-range (cdar marks))) out)) 5411 (push (cons (caar marks) (gnus-uncompress-range (cdar marks))) out))
4443 (setq marks (cdr marks))) 5412 (setq marks (cdr marks)))
4444 out)) 5413 out))
4445 5414
5415 (defun gnus-article-mark-to-type (mark)
5416 "Return the type of MARK."
5417 (or (cadr (assq mark gnus-article-special-mark-lists))
5418 'list))
5419
5420 (defun gnus-article-unpropagatable-p (mark)
5421 "Return whether MARK should be propagated to back end."
5422 (memq mark gnus-article-unpropagated-mark-lists))
5423
4446 (defun gnus-adjust-marked-articles (info) 5424 (defun gnus-adjust-marked-articles (info)
4447 "Set all article lists and remove all marks that are no longer valid." 5425 "Set all article lists and remove all marks that are no longer valid."
4448 (let* ((marked-lists (gnus-info-marks info)) 5426 (let* ((marked-lists (gnus-info-marks info))
4449 (active (gnus-active (gnus-info-group info))) 5427 (active (gnus-active (gnus-info-group info)))
4450 (min (car active)) 5428 (min (car active))
4451 (max (cdr active)) 5429 (max (cdr active))
4452 (types gnus-article-mark-lists) 5430 (types gnus-article-mark-lists)
4453 (uncompressed '(score bookmark killed)) 5431 marks var articles article mark mark-type
4454 marks var articles article mark) 5432 bgn end)
4455 5433
4456 (while marked-lists 5434 (dolist (marks marked-lists)
4457 (setq marks (pop marked-lists)) 5435 (setq mark (car marks)
4458 (set (setq var (intern (format "gnus-newsgroup-%s" 5436 mark-type (gnus-article-mark-to-type mark)
4459 (car (rassq (setq mark (car marks)) 5437 var (intern (format "gnus-newsgroup-%s" (car (rassq mark types)))))
4460 types))))) 5438
4461 (if (memq (car marks) uncompressed) (cdr marks) 5439 ;; We set the variable according to the type of the marks list,
4462 (gnus-uncompress-range (cdr marks)))) 5440 ;; and then adjust the marks to a subset of the active articles.
4463
4464 (setq articles (symbol-value var))
4465
4466 ;; All articles have to be subsets of the active articles.
4467 (cond 5441 (cond
4468 ;; Adjust "simple" lists. 5442 ;; Adjust "simple" lists - compressed yet unsorted
4469 ((memq mark '(tick dormant expire reply save)) 5443 ((eq mark-type 'list)
4470 (while articles 5444 ;; Simultaneously uncompress and clip to active range
4471 (when (or (< (setq article (pop articles)) min) (> article max)) 5445 ;; See gnus-uncompress-range for a description of possible marks
4472 (set var (delq article (symbol-value var)))))) 5446 (let (l lh)
5447 (if (not (cadr marks))
5448 (set var nil)
5449 (setq articles (if (numberp (cddr marks))
5450 (list (cdr marks))
5451 (cdr marks))
5452 lh (cons nil nil)
5453 l lh)
5454
5455 (while (setq article (pop articles))
5456 (cond ((consp article)
5457 (setq bgn (max (car article) min)
5458 end (min (cdr article) max))
5459 (while (<= bgn end)
5460 (setq l (setcdr l (cons bgn nil))
5461 bgn (1+ bgn))))
5462 ((and (<= min article)
5463 (>= max article))
5464 (setq l (setcdr l (cons article nil))))))
5465 (set var (cdr lh)))))
4473 ;; Adjust assocs. 5466 ;; Adjust assocs.
4474 ((memq mark uncompressed) 5467 ((eq mark-type 'tuple)
5468 (set var (setq articles (cdr marks)))
4475 (when (not (listp (cdr (symbol-value var)))) 5469 (when (not (listp (cdr (symbol-value var))))
4476 (set var (list (symbol-value var)))) 5470 (set var (list (symbol-value var))))
4477 (when (not (listp (cdr articles))) 5471 (when (not (listp (cdr articles)))
4478 (setq articles (list articles))) 5472 (setq articles (list articles)))
4479 (while articles 5473 (while articles
4480 (when (or (not (consp (setq article (pop articles)))) 5474 (when (or (not (consp (setq article (pop articles))))
4481 (< (car article) min) 5475 (< (car article) min)
4482 (> (car article) max)) 5476 (> (car article) max))
4483 (set var (delq article (symbol-value var)))))))))) 5477 (set var (delq article (symbol-value var))))))
5478 ;; Adjust ranges (sloppily).
5479 ((eq mark-type 'range)
5480 (cond
5481 ((eq mark 'seen)
5482 ;; Fix the record for `seen' if it looks like (seen NUM1 . NUM2).
5483 ;; It should be (seen (NUM1 . NUM2)).
5484 (when (numberp (cddr marks))
5485 (setcdr marks (list (cdr marks))))
5486 (setq articles (cdr marks))
5487 (while (and articles
5488 (or (and (consp (car articles))
5489 (> min (cdar articles)))
5490 (and (numberp (car articles))
5491 (> min (car articles)))))
5492 (pop articles))
5493 (set var articles))))))))
4484 5494
4485 (defun gnus-update-missing-marks (missing) 5495 (defun gnus-update-missing-marks (missing)
4486 "Go through the list of MISSING articles and remove them from the mark lists." 5496 "Go through the list of MISSING articles and remove them from the mark lists."
4487 (when missing 5497 (when missing
4488 (let ((types gnus-article-mark-lists) 5498 (let (var m)
4489 var m)
4490 ;; Go through all types. 5499 ;; Go through all types.
4491 (while types 5500 (dolist (elem gnus-article-mark-lists)
4492 (setq var (intern (format "gnus-newsgroup-%s" (car (pop types))))) 5501 (when (eq (gnus-article-mark-to-type (cdr elem)) 'list)
4493 (when (symbol-value var) 5502 (setq var (intern (format "gnus-newsgroup-%s" (car elem))))
4494 ;; This list has articles. So we delete all missing articles 5503 (when (symbol-value var)
4495 ;; from it. 5504 ;; This list has articles. So we delete all missing
4496 (setq m missing) 5505 ;; articles from it.
4497 (while m 5506 (setq m missing)
4498 (set var (delq (pop m) (symbol-value var))))))))) 5507 (while m
5508 (set var (delq (pop m) (symbol-value var))))))))))
4499 5509
4500 (defun gnus-update-marks () 5510 (defun gnus-update-marks ()
4501 "Enter the various lists of marked articles into the newsgroup info list." 5511 "Enter the various lists of marked articles into the newsgroup info list."
4502 (let ((types gnus-article-mark-lists) 5512 (let ((types gnus-article-mark-lists)
4503 (info (gnus-get-info gnus-newsgroup-name)) 5513 (info (gnus-get-info gnus-newsgroup-name))
4504 (uncompressed '(score bookmark killed))
4505 type list newmarked symbol delta-marks) 5514 type list newmarked symbol delta-marks)
4506 (when info 5515 (when info
4507 ;; Add all marks lists to the list of marks lists. 5516 ;; Add all marks lists to the list of marks lists.
4508 (while (setq type (pop types)) 5517 (while (setq type (pop types))
4509 (setq list (symbol-value 5518 (setq list (symbol-value
4510 (setq symbol 5519 (setq symbol
4511 (intern (format "gnus-newsgroup-%s" 5520 (intern (format "gnus-newsgroup-%s" (car type))))))
4512 (car type))))))
4513 5521
4514 (when list 5522 (when list
4515 ;; Get rid of the entries of the articles that have the 5523 ;; Get rid of the entries of the articles that have the
4516 ;; default score. 5524 ;; default score.
4517 (when (and (eq (cdr type) 'score) 5525 (when (and (eq (cdr type) 'score)
4526 (setcdr prev (cdr arts)) 5534 (setcdr prev (cdr arts))
4527 (setq prev arts)) 5535 (setq prev arts))
4528 (setq arts (cdr arts))) 5536 (setq arts (cdr arts)))
4529 (setq list (cdr all))))) 5537 (setq list (cdr all)))))
4530 5538
4531 (unless (memq (cdr type) uncompressed) 5539 (when (eq (cdr type) 'seen)
5540 (setq list (gnus-range-add list gnus-newsgroup-unseen)))
5541
5542 (when (eq (gnus-article-mark-to-type (cdr type)) 'list)
4532 (setq list (gnus-compress-sequence (set symbol (sort list '<)) t))) 5543 (setq list (gnus-compress-sequence (set symbol (sort list '<)) t)))
4533 5544
4534 (when (gnus-check-backend-function 5545 (when (and (gnus-check-backend-function
4535 'request-set-mark gnus-newsgroup-name) 5546 'request-set-mark gnus-newsgroup-name)
4536 ;; propagate flags to server, with the following exceptions: 5547 (not (gnus-article-unpropagatable-p (cdr type))))
4537 ;; uncompressed:s are not proper flags (they are cons cells) 5548 (let* ((old (cdr (assq (cdr type) (gnus-info-marks info))))
4538 ;; cache is a internal gnus flag 5549 (del (gnus-remove-from-range (gnus-copy-sequence old) list))
4539 ;; download are local to one gnus installation (well) 5550 (add (gnus-remove-from-range
4540 ;; unsend are for nndraft groups only 5551 (gnus-copy-sequence list) old)))
4541 ;; xxx: generality of this? this suits nnimap anyway 5552 (when add
4542 (unless (memq (cdr type) (append '(cache download unsend) 5553 (push (list add 'add (list (cdr type))) delta-marks))
4543 uncompressed)) 5554 (when del
4544 (let* ((old (cdr (assq (cdr type) (gnus-info-marks info)))) 5555 (push (list del 'del (list (cdr type))) delta-marks))))
4545 (del (gnus-remove-from-range (gnus-copy-sequence old) list))
4546 (add (gnus-remove-from-range
4547 (gnus-copy-sequence list) old)))
4548 (when add
4549 (push (list add 'add (list (cdr type))) delta-marks))
4550 (when del
4551 (push (list del 'del (list (cdr type))) delta-marks)))))
4552 5556
4553 (when list 5557 (when list
4554 (push (cons (cdr type) list) newmarked))) 5558 (push (cons (cdr type) list) newmarked)))
4555 5559
4556 (when delta-marks 5560 (when delta-marks
4582 (let (mode-string) 5586 (let (mode-string)
4583 (save-excursion 5587 (save-excursion
4584 ;; We evaluate this in the summary buffer since these 5588 ;; We evaluate this in the summary buffer since these
4585 ;; variables are buffer-local to that buffer. 5589 ;; variables are buffer-local to that buffer.
4586 (set-buffer gnus-summary-buffer) 5590 (set-buffer gnus-summary-buffer)
4587 ;; We bind all these variables that are used in the `eval' form 5591 ;; We bind all these variables that are used in the `eval' form
4588 ;; below. 5592 ;; below.
4589 (let* ((mformat (symbol-value 5593 (let* ((mformat (symbol-value
4590 (intern 5594 (intern
4591 (format "gnus-%s-mode-line-format-spec" where)))) 5595 (format "gnus-%s-mode-line-format-spec" where))))
4592 (gnus-tmp-group-name (gnus-group-name-decode 5596 (gnus-tmp-group-name (gnus-group-decoded-name
4593 gnus-newsgroup-name 5597 gnus-newsgroup-name))
4594 (gnus-group-name-charset
4595 nil
4596 gnus-newsgroup-name)))
4597 (gnus-tmp-article-number (or gnus-current-article 0)) 5598 (gnus-tmp-article-number (or gnus-current-article 0))
4598 (gnus-tmp-unread gnus-newsgroup-unreads) 5599 (gnus-tmp-unread gnus-newsgroup-unreads)
4599 (gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads)) 5600 (gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads))
4600 (gnus-tmp-unselected (length gnus-newsgroup-unselected)) 5601 (gnus-tmp-unselected (length gnus-newsgroup-unselected))
4601 (gnus-tmp-unread-and-unselected 5602 (gnus-tmp-unread-and-unselected
4612 (vectorp gnus-current-headers)) 5613 (vectorp gnus-current-headers))
4613 (gnus-mode-string-quote 5614 (gnus-mode-string-quote
4614 (mail-header-subject gnus-current-headers)) 5615 (mail-header-subject gnus-current-headers))
4615 "")) 5616 ""))
4616 bufname-length max-len 5617 bufname-length max-len
4617 gnus-tmp-header);; passed as argument to any user-format-funcs 5618 gnus-tmp-header) ;; passed as argument to any user-format-funcs
4618 (setq mode-string (eval mformat)) 5619 (setq mode-string (eval mformat))
4619 (setq bufname-length (if (string-match "%b" mode-string) 5620 (setq bufname-length (if (string-match "%b" mode-string)
4620 (- (length 5621 (- (length
4621 (buffer-name 5622 (buffer-name
4622 (if (eq where 'summary) 5623 (if (eq where 'summary)
4659 (setq group (if prefix 5660 (setq group (if prefix
4660 (concat prefix (substring xrefs (match-beginning 1) 5661 (concat prefix (substring xrefs (match-beginning 1)
4661 (match-end 1))) 5662 (match-end 1)))
4662 (substring xrefs (match-beginning 1) (match-end 1)))) 5663 (substring xrefs (match-beginning 1) (match-end 1))))
4663 (setq number 5664 (setq number
4664 (string-to-int (substring xrefs (match-beginning 2) 5665 (string-to-number (substring xrefs (match-beginning 2)
4665 (match-end 2)))) 5666 (match-end 2))))
4666 (if (setq entry (gnus-gethash group xref-hashtb)) 5667 (if (setq entry (gnus-gethash group xref-hashtb))
4667 (setcdr entry (cons number (cdr entry))) 5668 (setcdr entry (cons number (cdr entry)))
4668 (gnus-sethash group (cons number nil) xref-hashtb))))) 5669 (gnus-sethash group (cons number nil) xref-hashtb)))))
4669 (and start xref-hashtb))) 5670 (and start xref-hashtb)))
4753 (gnus-undo-register 5754 (gnus-undo-register
4754 `(progn 5755 `(progn
4755 (gnus-info-set-marks ',info ',(gnus-info-marks info) t) 5756 (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
4756 (gnus-info-set-read ',info ',(gnus-info-read info)) 5757 (gnus-info-set-read ',info ',(gnus-info-read info))
4757 (gnus-get-unread-articles-in-group ',info (gnus-active ,group)) 5758 (gnus-get-unread-articles-in-group ',info (gnus-active ,group))
5759 (gnus-request-set-mark ,group (list (list ',range 'del '(read))))
4758 (gnus-group-update-group ,group t)))) 5760 (gnus-group-update-group ,group t))))
4759 ;; Add the read articles to the range. 5761 ;; Add the read articles to the range.
4760 (gnus-info-set-read info range) 5762 (gnus-info-set-read info range)
5763 (gnus-request-set-mark group (list (list range 'add '(read))))
4761 ;; Then we have to re-compute how many unread 5764 ;; Then we have to re-compute how many unread
4762 ;; articles there are in this group. 5765 ;; articles there are in this group.
4763 (when active 5766 (when active
4764 (cond 5767 (cond
4765 ((not range) 5768 ((not range)
4775 (setq range (cdr range))) 5778 (setq range (cdr range)))
4776 (setq num (- (cdr active) num)))) 5779 (setq num (- (cdr active) num))))
4777 ;; Update the number of unread articles. 5780 ;; Update the number of unread articles.
4778 (setcar entry num) 5781 (setcar entry num)
4779 ;; Update the group buffer. 5782 ;; Update the group buffer.
4780 (gnus-group-update-group group t))))) 5783 (unless (gnus-ephemeral-group-p group)
5784 (gnus-group-update-group group t))))))
4781 5785
4782 (defvar gnus-newsgroup-none-id 0) 5786 (defvar gnus-newsgroup-none-id 0)
4783 5787
4784 (defun gnus-get-newsgroup-headers (&optional dependencies force-new) 5788 (defun gnus-get-newsgroup-headers (&optional dependencies force-new)
4785 (let ((cur nntp-server-buffer) 5789 (let ((cur nntp-server-buffer)
4797 (save-excursion 5801 (save-excursion
4798 (set-buffer nntp-server-buffer) 5802 (set-buffer nntp-server-buffer)
4799 ;; Translate all TAB characters into SPACE characters. 5803 ;; Translate all TAB characters into SPACE characters.
4800 (subst-char-in-region (point-min) (point-max) ?\t ? t) 5804 (subst-char-in-region (point-min) (point-max) ?\t ? t)
4801 (subst-char-in-region (point-min) (point-max) ?\r ? t) 5805 (subst-char-in-region (point-min) (point-max) ?\r ? t)
5806 (ietf-drums-unfold-fws)
4802 (gnus-run-hooks 'gnus-parse-headers-hook) 5807 (gnus-run-hooks 'gnus-parse-headers-hook)
4803 (let ((case-fold-search t) 5808 (let ((case-fold-search t)
4804 in-reply-to header p lines chars) 5809 in-reply-to header p lines chars)
4805 (goto-char (point-min)) 5810 (goto-char (point-min))
4806 ;; Search to the beginning of the next header. Error messages 5811 ;; Search to the beginning of the next header. Error messages
4827 (- (point) 2)) 5832 (- (point) 2))
4828 (point)))) 5833 (point))))
4829 ;; Subject. 5834 ;; Subject.
4830 (progn 5835 (progn
4831 (goto-char p) 5836 (goto-char p)
4832 (if (search-forward "\nsubject: " nil t) 5837 (if (search-forward "\nsubject:" nil t)
4833 (funcall gnus-decode-encoded-word-function 5838 (funcall gnus-decode-encoded-word-function
4834 (nnheader-header-value)) 5839 (nnheader-header-value))
4835 "(none)")) 5840 "(none)"))
4836 ;; From. 5841 ;; From.
4837 (progn 5842 (progn
4838 (goto-char p) 5843 (goto-char p)
4839 (if (or (search-forward "\nfrom: " nil t) 5844 (if (search-forward "\nfrom:" nil t)
4840 (search-forward "\nfrom:" nil t))
4841 (funcall gnus-decode-encoded-word-function 5845 (funcall gnus-decode-encoded-word-function
4842 (nnheader-header-value)) 5846 (nnheader-header-value))
4843 "(nobody)")) 5847 "(nobody)"))
4844 ;; Date. 5848 ;; Date.
4845 (progn 5849 (progn
4846 (goto-char p) 5850 (goto-char p)
4847 (if (search-forward "\ndate: " nil t) 5851 (if (search-forward "\ndate:" nil t)
4848 (nnheader-header-value) "")) 5852 (nnheader-header-value) ""))
4849 ;; Message-ID. 5853 ;; Message-ID.
4850 (progn 5854 (progn
4851 (goto-char p) 5855 (goto-char p)
4852 (setq id (if (re-search-forward 5856 (setq id (if (re-search-forward
4859 ;; to make subsequent routines simpler. 5863 ;; to make subsequent routines simpler.
4860 (nnheader-generate-fake-message-id)))) 5864 (nnheader-generate-fake-message-id))))
4861 ;; References. 5865 ;; References.
4862 (progn 5866 (progn
4863 (goto-char p) 5867 (goto-char p)
4864 (if (search-forward "\nreferences: " nil t) 5868 (if (search-forward "\nreferences:" nil t)
4865 (progn 5869 (progn
4866 (setq end (point)) 5870 (setq end (point))
4867 (prog1 5871 (prog1
4868 (nnheader-header-value) 5872 (nnheader-header-value)
4869 (setq ref 5873 (setq ref
4876 (search-backward "<" end t) 5880 (search-backward "<" end t)
4877 (point)))))) 5881 (point))))))
4878 ;; Get the references from the in-reply-to header if there 5882 ;; Get the references from the in-reply-to header if there
4879 ;; were no references and the in-reply-to header looks 5883 ;; were no references and the in-reply-to header looks
4880 ;; promising. 5884 ;; promising.
4881 (if (and (search-forward "\nin-reply-to: " nil t) 5885 (if (and (search-forward "\nin-reply-to:" nil t)
4882 (setq in-reply-to (nnheader-header-value)) 5886 (setq in-reply-to (nnheader-header-value))
4883 (string-match "<[^>]+>" in-reply-to)) 5887 (string-match "<[^>]+>" in-reply-to))
4884 (let (ref2) 5888 (let (ref2)
4885 (setq ref (substring in-reply-to (match-beginning 0) 5889 (setq ref (substring in-reply-to (match-beginning 0)
4886 (match-end 0))) 5890 (match-end 0)))
4894 ;; Chars. 5898 ;; Chars.
4895 (progn 5899 (progn
4896 (goto-char p) 5900 (goto-char p)
4897 (if (search-forward "\nchars: " nil t) 5901 (if (search-forward "\nchars: " nil t)
4898 (if (numberp (setq chars (ignore-errors (read cur)))) 5902 (if (numberp (setq chars (ignore-errors (read cur))))
4899 chars 0) 5903 chars -1)
4900 0)) 5904 -1))
4901 ;; Lines. 5905 ;; Lines.
4902 (progn 5906 (progn
4903 (goto-char p) 5907 (goto-char p)
4904 (if (search-forward "\nlines: " nil t) 5908 (if (search-forward "\nlines: " nil t)
4905 (if (numberp (setq lines (ignore-errors (read cur)))) 5909 (if (numberp (setq lines (ignore-errors (read cur))))
4906 lines 0) 5910 lines -1)
4907 0)) 5911 -1))
4908 ;; Xref. 5912 ;; Xref.
4909 (progn 5913 (progn
4910 (goto-char p) 5914 (goto-char p)
4911 (and (search-forward "\nxref: " nil t) 5915 (and (search-forward "\nxref:" nil t)
4912 (nnheader-header-value))) 5916 (nnheader-header-value)))
4913 ;; Extra. 5917 ;; Extra.
4914 (when gnus-extra-headers 5918 (when gnus-extra-headers
4915 (let ((extra gnus-extra-headers) 5919 (let ((extra gnus-extra-headers)
4916 out) 5920 out)
4917 (while extra 5921 (while extra
4918 (goto-char p) 5922 (goto-char p)
4919 (when (search-forward 5923 (when (search-forward
4920 (concat "\n" (symbol-name (car extra)) ": ") nil t) 5924 (concat "\n" (symbol-name (car extra)) ":") nil t)
4921 (push (cons (car extra) (nnheader-header-value)) 5925 (push (cons (car extra) (nnheader-header-value))
4922 out)) 5926 out))
4923 (pop extra)) 5927 (pop extra))
4924 out)))) 5928 out))))
4925 (when (equal id ref) 5929 (when (equal id ref)
4950 (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs)) 5954 (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
4951 (let ((mail-parse-charset gnus-newsgroup-charset) 5955 (let ((mail-parse-charset gnus-newsgroup-charset)
4952 (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets) 5956 (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)
4953 (cur nntp-server-buffer) 5957 (cur nntp-server-buffer)
4954 (dependencies (or dependencies gnus-newsgroup-dependencies)) 5958 (dependencies (or dependencies gnus-newsgroup-dependencies))
5959 (allp (cond
5960 ((eq gnus-read-all-available-headers t)
5961 t)
5962 ((stringp gnus-read-all-available-headers)
5963 (string-match gnus-read-all-available-headers group))
5964 (t
5965 nil)))
4955 number headers header) 5966 number headers header)
4956 (save-excursion 5967 (save-excursion
4957 (set-buffer nntp-server-buffer) 5968 (set-buffer nntp-server-buffer)
4958 (subst-char-in-region (point-min) (point-max) ?\r ? t) 5969 (subst-char-in-region (point-min) (point-max) ?\r ? t)
4959 ;; Allow the user to mangle the headers before parsing them. 5970 ;; Allow the user to mangle the headers before parsing them.
4960 (gnus-run-hooks 'gnus-parse-headers-hook) 5971 (gnus-run-hooks 'gnus-parse-headers-hook)
4961 (goto-char (point-min)) 5972 (goto-char (point-min))
4962 (while (not (eobp)) 5973 (gnus-parse-without-error
4963 (condition-case () 5974 (while (and (or sequence allp)
4964 (while (and sequence (not (eobp))) 5975 (not (eobp)))
4965 (setq number (read cur)) 5976 (setq number (read cur))
4966 (while (and sequence 5977 (when (not allp)
4967 (< (car sequence) number)) 5978 (while (and sequence
4968 (setq sequence (cdr sequence))) 5979 (< (car sequence) number))
4969 (and sequence 5980 (setq sequence (cdr sequence))))
4970 (eq number (car sequence)) 5981 (when (and (or allp
4971 (progn 5982 (and sequence
4972 (setq sequence (cdr sequence)) 5983 (eq number (car sequence))))
4973 (setq header (inline 5984 (progn
4974 (gnus-nov-parse-line 5985 (setq sequence (cdr sequence))
4975 number dependencies force-new)))) 5986 (setq header (inline
4976 (push header headers)) 5987 (gnus-nov-parse-line
4977 (forward-line 1)) 5988 number dependencies force-new)))))
4978 (error 5989 (push header headers))
4979 (gnus-error 4 "Strange nov line (%d)" 5990 (forward-line 1)))
4980 (count-lines (point-min) (point)))))
4981 (forward-line 1))
4982 ;; A common bug in inn is that if you have posted an article and 5991 ;; A common bug in inn is that if you have posted an article and
4983 ;; then retrieves the active file, it will answer correctly -- 5992 ;; then retrieves the active file, it will answer correctly --
4984 ;; the new article is included. However, a NOV entry for the 5993 ;; the new article is included. However, a NOV entry for the
4985 ;; article may not have been generated yet, so this may fail. 5994 ;; article may not have been generated yet, so this may fail.
4986 ;; We work around this problem by retrieving the last few 5995 ;; We work around this problem by retrieving the last few
4990 ;; We (probably) got all the headers. 5999 ;; We (probably) got all the headers.
4991 (nreverse headers) 6000 (nreverse headers)
4992 (let ((gnus-nov-is-evil t)) 6001 (let ((gnus-nov-is-evil t))
4993 (nconc 6002 (nconc
4994 (nreverse headers) 6003 (nreverse headers)
4995 (when (gnus-retrieve-headers sequence group) 6004 (when (eq (gnus-retrieve-headers sequence group) 'headers)
4996 (gnus-get-newsgroup-headers)))))))) 6005 (gnus-get-newsgroup-headers))))))))
4997 6006
4998 (defun gnus-article-get-xrefs () 6007 (defun gnus-article-get-xrefs ()
4999 "Fill in the Xref value in `gnus-current-headers', if necessary. 6008 "Fill in the Xref value in `gnus-current-headers', if necessary.
5000 This is meant to be called in `gnus-article-internal-prepare-hook'." 6009 This is meant to be called in `gnus-article-internal-prepare-hook'."
5012 (when (or (and (not (eobp)) 6021 (when (or (and (not (eobp))
5013 (eq (downcase (char-after)) ?x) 6022 (eq (downcase (char-after)) ?x)
5014 (looking-at "Xref:")) 6023 (looking-at "Xref:"))
5015 (search-forward "\nXref:" nil t)) 6024 (search-forward "\nXref:" nil t))
5016 (goto-char (1+ (match-end 0))) 6025 (goto-char (1+ (match-end 0)))
5017 (setq xref (buffer-substring (point) 6026 (setq xref (buffer-substring (point) (gnus-point-at-eol)))
5018 (progn (end-of-line) (point))))
5019 (mail-header-set-xref headers xref))))))) 6027 (mail-header-set-xref headers xref)))))))
5020 6028
5021 (defun gnus-summary-insert-subject (id &optional old-header use-old-header) 6029 (defun gnus-summary-insert-subject (id &optional old-header use-old-header)
5022 "Find article ID and insert the summary line for that article. 6030 "Find article ID and insert the summary line for that article.
5023 OLD-HEADER can either be a header or a line number to insert 6031 OLD-HEADER can either be a header or a line number to insert
5045 number 6053 number
5046 (- (gnus-point-at-bol) 6054 (- (gnus-point-at-bol)
5047 (prog1 6055 (prog1
5048 (1+ (gnus-point-at-eol)) 6056 (1+ (gnus-point-at-eol))
5049 (gnus-delete-line)))))) 6057 (gnus-delete-line))))))
6058 ;; Remove list identifiers from subject.
6059 (when gnus-list-identifiers
6060 (let ((gnus-newsgroup-headers (list header)))
6061 (gnus-summary-remove-list-identifiers)))
5050 (when old-header 6062 (when old-header
5051 (mail-header-set-number header (mail-header-number old-header))) 6063 (mail-header-set-number header (mail-header-number old-header)))
5052 (setq gnus-newsgroup-sparse 6064 (setq gnus-newsgroup-sparse
5053 (delq (setq number (mail-header-number header)) 6065 (delq (setq number (mail-header-number header))
5054 gnus-newsgroup-sparse)) 6066 gnus-newsgroup-sparse))
5100 (message "region active") 6112 (message "region active")
5101 ;; Work on the region between point and mark. 6113 ;; Work on the region between point and mark.
5102 (let ((max (max (point) (mark))) 6114 (let ((max (max (point) (mark)))
5103 articles article) 6115 articles article)
5104 (save-excursion 6116 (save-excursion
5105 (goto-char (min (min (point) (mark)))) 6117 (goto-char (min (point) (mark)))
5106 (while 6118 (while
5107 (and 6119 (and
5108 (push (setq article (gnus-summary-article-number)) articles) 6120 (push (setq article (gnus-summary-article-number)) articles)
5109 (gnus-summary-find-next nil article) 6121 (gnus-summary-find-next nil article)
5110 (< (point) max))) 6122 (< (point) max)))
5175 (save-excursion 6187 (save-excursion
5176 (set-buffer gnus-group-buffer) 6188 (set-buffer gnus-group-buffer)
5177 (save-excursion 6189 (save-excursion
5178 (gnus-group-best-unread-group exclude-group)))) 6190 (gnus-group-best-unread-group exclude-group))))
5179 6191
5180 (defun gnus-summary-find-next (&optional unread article backward undownloaded) 6192 (defun gnus-summary-find-next (&optional unread article backward)
5181 (if backward (gnus-summary-find-prev) 6193 (if backward
6194 (gnus-summary-find-prev unread article)
5182 (let* ((dummy (gnus-summary-article-intangible-p)) 6195 (let* ((dummy (gnus-summary-article-intangible-p))
5183 (article (or article (gnus-summary-article-number))) 6196 (article (or article (gnus-summary-article-number)))
5184 (arts (gnus-data-find-list article)) 6197 (data (gnus-data-find-list article))
5185 result) 6198 result)
5186 (when (and (not dummy) 6199 (when (and (not dummy)
5187 (or (not gnus-summary-check-current) 6200 (or (not gnus-summary-check-current)
5188 (not unread) 6201 (not unread)
5189 (not (gnus-data-unread-p (car arts))))) 6202 (not (gnus-data-unread-p (car data)))))
5190 (setq arts (cdr arts))) 6203 (setq data (cdr data)))
5191 (when (setq result 6204 (when (setq result
5192 (if unread 6205 (if unread
5193 (progn 6206 (progn
5194 (while arts 6207 (while data
5195 (when (or (and undownloaded 6208 (unless (memq (gnus-data-number (car data))
5196 (eq gnus-undownloaded-mark 6209 (cond
5197 (gnus-data-mark (car arts)))) 6210 ((eq gnus-auto-goto-ignores
5198 (gnus-data-unread-p (car arts))) 6211 'always-undownloaded)
5199 (setq result (car arts) 6212 gnus-newsgroup-undownloaded)
5200 arts nil)) 6213 (gnus-plugged
5201 (setq arts (cdr arts))) 6214 nil)
6215 ((eq gnus-auto-goto-ignores
6216 'unfetched)
6217 gnus-newsgroup-unfetched)
6218 ((eq gnus-auto-goto-ignores
6219 'undownloaded)
6220 gnus-newsgroup-undownloaded)))
6221 (when (gnus-data-unread-p (car data))
6222 (setq result (car data)
6223 data nil)))
6224 (setq data (cdr data)))
5202 result) 6225 result)
5203 (car arts))) 6226 (car data)))
5204 (goto-char (gnus-data-pos result)) 6227 (goto-char (gnus-data-pos result))
5205 (gnus-data-number result))))) 6228 (gnus-data-number result)))))
5206 6229
5207 (defun gnus-summary-find-prev (&optional unread article) 6230 (defun gnus-summary-find-prev (&optional unread article)
5208 (let* ((eobp (eobp)) 6231 (let* ((eobp (eobp))
5209 (article (or article (gnus-summary-article-number))) 6232 (article (or article (gnus-summary-article-number)))
5210 (arts (gnus-data-find-list article (gnus-data-list 'rev))) 6233 (data (gnus-data-find-list article (gnus-data-list 'rev)))
5211 result) 6234 result)
5212 (when (and (not eobp) 6235 (when (and (not eobp)
5213 (or (not gnus-summary-check-current) 6236 (or (not gnus-summary-check-current)
5214 (not unread) 6237 (not unread)
5215 (not (gnus-data-unread-p (car arts))))) 6238 (not (gnus-data-unread-p (car data)))))
5216 (setq arts (cdr arts))) 6239 (setq data (cdr data)))
5217 (when (setq result 6240 (when (setq result
5218 (if unread 6241 (if unread
5219 (progn 6242 (progn
5220 (while arts 6243 (while data
5221 (when (gnus-data-unread-p (car arts)) 6244 (unless (memq (gnus-data-number (car data))
5222 (setq result (car arts) 6245 (cond
5223 arts nil)) 6246 ((eq gnus-auto-goto-ignores
5224 (setq arts (cdr arts))) 6247 'always-undownloaded)
6248 gnus-newsgroup-undownloaded)
6249 (gnus-plugged
6250 nil)
6251 ((eq gnus-auto-goto-ignores
6252 'unfetched)
6253 gnus-newsgroup-unfetched)
6254 ((eq gnus-auto-goto-ignores
6255 'undownloaded)
6256 gnus-newsgroup-undownloaded)))
6257 (when (gnus-data-unread-p (car data))
6258 (setq result (car data)
6259 data nil)))
6260 (setq data (cdr data)))
5225 result) 6261 result)
5226 (car arts))) 6262 (car data)))
5227 (goto-char (gnus-data-pos result)) 6263 (goto-char (gnus-data-pos result))
5228 (gnus-data-number result)))) 6264 (gnus-data-number result))))
5229 6265
5230 (defun gnus-summary-find-subject (subject &optional unread backward article) 6266 (defun gnus-summary-find-subject (subject &optional unread backward article)
5231 (let* ((simp-subject (gnus-simplify-subject-fully subject)) 6267 (let* ((simp-subject (gnus-simplify-subject-fully subject))
5272 If `gnus-auto-center-summary' is nil, or the article buffer isn't 6308 If `gnus-auto-center-summary' is nil, or the article buffer isn't
5273 displayed, no centering will be performed." 6309 displayed, no centering will be performed."
5274 ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle). 6310 ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
5275 ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu. 6311 ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu.
5276 (interactive) 6312 (interactive)
5277 (let* ((top (cond ((< (window-height) 4) 0) 6313 ;; The user has to want it.
5278 ((< (window-height) 7) 1) 6314 (when gnus-auto-center-summary
5279 (t (if (numberp gnus-auto-center-summary) 6315 (let* ((top (cond ((< (window-height) 4) 0)
5280 gnus-auto-center-summary 6316 ((< (window-height) 7) 1)
5281 2)))) 6317 (t (if (numberp gnus-auto-center-summary)
5282 (height (1- (window-height))) 6318 gnus-auto-center-summary
5283 (bottom (save-excursion (goto-char (point-max)) 6319 2))))
5284 (forward-line (- height)) 6320 (height (1- (window-height)))
5285 (point))) 6321 (bottom (save-excursion (goto-char (point-max))
5286 (window (get-buffer-window (current-buffer)))) 6322 (forward-line (- height))
5287 ;; The user has to want it. 6323 (point)))
5288 (when gnus-auto-center-summary 6324 (window (get-buffer-window (current-buffer))))
5289 (when (get-buffer-window gnus-article-buffer) 6325 (when (get-buffer-window gnus-article-buffer)
5290 ;; Only do recentering when the article buffer is displayed, 6326 ;; Only do recentering when the article buffer is displayed,
5291 ;; Set the window start to either `bottom', which is the biggest 6327 ;; Set the window start to either `bottom', which is the biggest
5292 ;; possible valid number, or the second line from the top, 6328 ;; possible valid number, or the second line from the top,
5293 ;; whichever is the least. 6329 ;; whichever is the least.
5357 1) 6393 1)
5358 (setq first (car active))) 6394 (setq first (car active)))
5359 (while read 6395 (while read
5360 (when first 6396 (when first
5361 (while (< first nlast) 6397 (while (< first nlast)
5362 (push first unread) 6398 (setq unread (cons first unread)
5363 (setq first (1+ first)))) 6399 first (1+ first))))
5364 (setq first (1+ (if (atom (car read)) (car read) (cdar read)))) 6400 (setq first (1+ (if (atom (car read)) (car read) (cdar read))))
5365 (setq nlast (if (atom (cadr read)) (cadr read) (caadr read))) 6401 (setq nlast (if (atom (cadr read)) (cadr read) (caadr read)))
5366 (setq read (cdr read))))) 6402 (setq read (cdr read)))))
5367 ;; And add the last unread articles. 6403 ;; And add the last unread articles.
5368 (while (<= first last) 6404 (while (<= first last)
5369 (push first unread) 6405 (setq unread (cons first unread)
5370 (setq first (1+ first))) 6406 first (1+ first)))
5371 ;; Return the list of unread articles. 6407 ;; Return the list of unread articles.
5372 (delq 0 (nreverse unread)))) 6408 (delq 0 (nreverse unread))))
5373 6409
5374 (defun gnus-list-of-read-articles (group) 6410 (defun gnus-list-of-read-articles (group)
5375 "Return a list of unread, unticked and non-dormant articles." 6411 "Return a list of unread, unticked and non-dormant articles."
5376 (let* ((info (gnus-get-info group)) 6412 (let* ((info (gnus-get-info group))
5377 (marked (gnus-info-marks info)) 6413 (marked (gnus-info-marks info))
5378 (active (gnus-active group))) 6414 (active (gnus-active group)))
5379 (and info active 6415 (and info active
5380 (gnus-set-difference 6416 (gnus-list-range-difference
5381 (gnus-sorted-complement 6417 (gnus-list-range-difference
5382 (gnus-uncompress-range active) 6418 (gnus-sorted-complement
5383 (gnus-list-of-unread-articles group)) 6419 (gnus-uncompress-range active)
5384 (append 6420 (gnus-list-of-unread-articles group))
5385 (gnus-uncompress-range (cdr (assq 'dormant marked))) 6421 (cdr (assq 'dormant marked)))
5386 (gnus-uncompress-range (cdr (assq 'tick marked)))))))) 6422 (cdr (assq 'tick marked))))))
6423
6424 ;; This function returns a sequence of article numbers based on the
6425 ;; difference between the ranges of read articles in this group and
6426 ;; the range of active articles.
6427 (defun gnus-sequence-of-unread-articles (group)
6428 (let* ((read (gnus-info-read (gnus-get-info group)))
6429 (active (or (gnus-active group) (gnus-activate-group group)))
6430 (last (cdr active))
6431 first nlast unread)
6432 ;; If none are read, then all are unread.
6433 (if (not read)
6434 (setq first (car active))
6435 ;; If the range of read articles is a single range, then the
6436 ;; first unread article is the article after the last read
6437 ;; article. Sounds logical, doesn't it?
6438 (if (and (not (listp (cdr read)))
6439 (or (< (car read) (car active))
6440 (progn (setq read (list read))
6441 nil)))
6442 (setq first (max (car active) (1+ (cdr read))))
6443 ;; `read' is a list of ranges.
6444 (when (/= (setq nlast (or (and (numberp (car read)) (car read))
6445 (caar read)))
6446 1)
6447 (setq first (car active)))
6448 (while read
6449 (when first
6450 (push (cons first nlast) unread))
6451 (setq first (1+ (if (atom (car read)) (car read) (cdar read))))
6452 (setq nlast (if (atom (cadr read)) (cadr read) (caadr read)))
6453 (setq read (cdr read)))))
6454 ;; And add the last unread articles.
6455 (cond ((< first last)
6456 (push (cons first last) unread))
6457 ((= first last)
6458 (push first unread)))
6459 ;; Return the sequence of unread articles.
6460 (delq 0 (nreverse unread))))
5387 6461
5388 ;; Various summary commands 6462 ;; Various summary commands
5389 6463
5390 (defun gnus-summary-select-article-buffer () 6464 (defun gnus-summary-select-article-buffer ()
5391 "Reconfigure windows to show article buffer." 6465 "Reconfigure windows to show article buffer."
5417 (gnus-summary-remove-process-mark article))))) 6491 (gnus-summary-remove-process-mark article)))))
5418 (gnus-summary-position-point)) 6492 (gnus-summary-position-point))
5419 6493
5420 (defun gnus-summary-toggle-truncation (&optional arg) 6494 (defun gnus-summary-toggle-truncation (&optional arg)
5421 "Toggle truncation of summary lines. 6495 "Toggle truncation of summary lines.
5422 With arg, turn line truncation on if arg is positive." 6496 With ARG, turn line truncation on if ARG is positive."
5423 (interactive "P") 6497 (interactive "P")
5424 (setq truncate-lines 6498 (setq truncate-lines
5425 (if (null arg) (not truncate-lines) 6499 (if (null arg) (not truncate-lines)
5426 (> (prefix-numeric-value arg) 0))) 6500 (> (prefix-numeric-value arg) 0)))
5427 (redraw-display)) 6501 (redraw-display))
6502
6503 (defun gnus-summary-find-for-reselect ()
6504 "Return the number of an article to stay on across a reselect.
6505 The current article is considered, then following articles, then previous
6506 articles. An article is sought which is not cancelled and isn't a temporary
6507 insertion from another group. If there's no such then return a dummy 0."
6508 (let (found)
6509 (dolist (rev '(nil t))
6510 (unless found ; don't demand the reverse list if we don't need it
6511 (let ((data (gnus-data-find-list
6512 (gnus-summary-article-number) (gnus-data-list rev))))
6513 (while (and data (not found))
6514 (if (and (< 0 (gnus-data-number (car data)))
6515 (not (eq gnus-canceled-mark (gnus-data-mark (car data)))))
6516 (setq found (gnus-data-number (car data))))
6517 (setq data (cdr data))))))
6518 (or found 0)))
5428 6519
5429 (defun gnus-summary-reselect-current-group (&optional all rescan) 6520 (defun gnus-summary-reselect-current-group (&optional all rescan)
5430 "Exit and then reselect the current newsgroup. 6521 "Exit and then reselect the current newsgroup.
5431 The prefix argument ALL means to select all articles." 6522 The prefix argument ALL means to select all articles."
5432 (interactive "P") 6523 (interactive "P")
5433 (when (gnus-ephemeral-group-p gnus-newsgroup-name) 6524 (when (gnus-ephemeral-group-p gnus-newsgroup-name)
5434 (error "Ephemeral groups can't be reselected")) 6525 (error "Ephemeral groups can't be reselected"))
5435 (let ((current-subject (gnus-summary-article-number)) 6526 (let ((current-subject (gnus-summary-find-for-reselect))
5436 (group gnus-newsgroup-name)) 6527 (group gnus-newsgroup-name))
5437 (setq gnus-newsgroup-begin nil) 6528 (setq gnus-newsgroup-begin nil)
5438 (gnus-summary-exit) 6529 (gnus-summary-exit nil 'leave-hidden)
5439 ;; We have to adjust the point of group mode buffer because 6530 ;; We have to adjust the point of group mode buffer because
5440 ;; point was moved to the next unread newsgroup by exiting. 6531 ;; point was moved to the next unread newsgroup by exiting.
5441 (gnus-summary-jump-to-group group) 6532 (gnus-summary-jump-to-group group)
5442 (when rescan 6533 (when rescan
5443 (save-excursion 6534 (save-excursion
5455 (let ((group gnus-newsgroup-name)) 6546 (let ((group gnus-newsgroup-name))
5456 (when group 6547 (when group
5457 (when gnus-newsgroup-kill-headers 6548 (when gnus-newsgroup-kill-headers
5458 (setq gnus-newsgroup-killed 6549 (setq gnus-newsgroup-killed
5459 (gnus-compress-sequence 6550 (gnus-compress-sequence
5460 (nconc 6551 (gnus-sorted-union
5461 (gnus-set-sorted-intersection 6552 (gnus-list-range-intersection
5462 (gnus-uncompress-range gnus-newsgroup-killed) 6553 gnus-newsgroup-unselected gnus-newsgroup-killed)
5463 (setq gnus-newsgroup-unselected 6554 gnus-newsgroup-unreads)
5464 (sort gnus-newsgroup-unselected '<)))
5465 (setq gnus-newsgroup-unreads
5466 (sort gnus-newsgroup-unreads '<)))
5467 t))) 6555 t)))
5468 (unless (listp (cdr gnus-newsgroup-killed)) 6556 (unless (listp (cdr gnus-newsgroup-killed))
5469 (setq gnus-newsgroup-killed (list gnus-newsgroup-killed))) 6557 (setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
5470 (let ((headers gnus-newsgroup-headers)) 6558 (let ((headers gnus-newsgroup-headers))
5471 ;; Set the new ranges of read articles. 6559 ;; Set the new ranges of read articles.
5472 (save-excursion 6560 (save-excursion
5473 (set-buffer gnus-group-buffer) 6561 (set-buffer gnus-group-buffer)
5474 (gnus-undo-force-boundary)) 6562 (gnus-undo-force-boundary))
5475 (gnus-update-read-articles 6563 (gnus-update-read-articles
5476 group (append gnus-newsgroup-unreads gnus-newsgroup-unselected)) 6564 group (gnus-sorted-union
6565 gnus-newsgroup-unreads gnus-newsgroup-unselected))
5477 ;; Set the current article marks. 6566 ;; Set the current article marks.
5478 (let ((gnus-newsgroup-scored 6567 (let ((gnus-newsgroup-scored
5479 (if (and (not gnus-save-score) 6568 (if (and (not gnus-save-score)
5480 (not non-destructive)) 6569 (not non-destructive))
5481 nil 6570 nil
5498 (gnus-summary-update-info t) 6587 (gnus-summary-update-info t)
5499 (if force 6588 (if force
5500 (gnus-save-newsrc-file) 6589 (gnus-save-newsrc-file)
5501 (gnus-dribble-save))) 6590 (gnus-dribble-save)))
5502 6591
5503 (defun gnus-summary-exit (&optional temporary) 6592 (defun gnus-summary-exit (&optional temporary leave-hidden)
5504 "Exit reading current newsgroup, and then return to group selection mode. 6593 "Exit reading current newsgroup, and then return to group selection mode.
5505 `gnus-exit-group-hook' is called with no arguments if that value is non-nil." 6594 `gnus-exit-group-hook' is called with no arguments if that value is non-nil."
5506 (interactive) 6595 (interactive)
5507 (gnus-set-global-variables) 6596 (gnus-set-global-variables)
5508 (when (gnus-buffer-live-p gnus-article-buffer) 6597 (when (gnus-buffer-live-p gnus-article-buffer)
5514 (setq gnus-article-mime-handles nil))) 6603 (setq gnus-article-mime-handles nil)))
5515 (gnus-kill-save-kill-buffer) 6604 (gnus-kill-save-kill-buffer)
5516 (gnus-async-halt-prefetch) 6605 (gnus-async-halt-prefetch)
5517 (let* ((group gnus-newsgroup-name) 6606 (let* ((group gnus-newsgroup-name)
5518 (quit-config (gnus-group-quit-config gnus-newsgroup-name)) 6607 (quit-config (gnus-group-quit-config gnus-newsgroup-name))
6608 (gnus-group-is-exiting-p t)
5519 (mode major-mode) 6609 (mode major-mode)
5520 (group-point nil) 6610 (group-point nil)
5521 (buf (current-buffer))) 6611 (buf (current-buffer)))
5522 (unless quit-config 6612 (unless quit-config
5523 ;; Do adaptive scoring, and possibly save score files. 6613 ;; Do adaptive scoring, and possibly save score files.
5524 (when gnus-newsgroup-adaptive 6614 (when gnus-newsgroup-adaptive
5525 (gnus-score-adaptive)) 6615 (gnus-score-adaptive))
5565 (gnus-kill-buffer gnus-article-buffer) 6655 (gnus-kill-buffer gnus-article-buffer)
5566 (gnus-kill-buffer gnus-original-article-buffer) 6656 (gnus-kill-buffer gnus-original-article-buffer)
5567 (setq gnus-article-current nil)) 6657 (setq gnus-article-current nil))
5568 (set-buffer buf) 6658 (set-buffer buf)
5569 (if (not gnus-kill-summary-on-exit) 6659 (if (not gnus-kill-summary-on-exit)
5570 (gnus-deaden-summary) 6660 (progn
6661 (gnus-deaden-summary)
6662 (setq mode nil))
5571 ;; We set all buffer-local variables to nil. It is unclear why 6663 ;; We set all buffer-local variables to nil. It is unclear why
5572 ;; this is needed, but if we don't, buffer-local variables are 6664 ;; this is needed, but if we don't, buffer-local variables are
5573 ;; not garbage-collected, it seems. This would the lead to en 6665 ;; not garbage-collected, it seems. This would the lead to en
5574 ;; ever-growing Emacs. 6666 ;; ever-growing Emacs.
5575 (gnus-summary-clear-local-variables) 6667 (gnus-summary-clear-local-variables)
6668 (let ((gnus-summary-local-variables gnus-newsgroup-variables))
6669 (gnus-summary-clear-local-variables))
5576 (when (get-buffer gnus-article-buffer) 6670 (when (get-buffer gnus-article-buffer)
5577 (bury-buffer gnus-article-buffer)) 6671 (bury-buffer gnus-article-buffer))
5578 ;; We clear the global counterparts of the buffer-local 6672 ;; We clear the global counterparts of the buffer-local
5579 ;; variables as well, just to be on the safe side. 6673 ;; variables as well, just to be on the safe side.
5580 (set-buffer gnus-group-buffer) 6674 (set-buffer gnus-group-buffer)
5581 (gnus-summary-clear-local-variables) 6675 (gnus-summary-clear-local-variables)
6676 (let ((gnus-summary-local-variables gnus-newsgroup-variables))
6677 (gnus-summary-clear-local-variables))
5582 ;; Return to group mode buffer. 6678 ;; Return to group mode buffer.
5583 (when (eq mode 'gnus-summary-mode) 6679 (when (eq mode 'gnus-summary-mode)
5584 (gnus-kill-buffer buf))) 6680 (gnus-kill-buffer buf)))
5585 (setq gnus-current-select-method gnus-select-method) 6681 (setq gnus-current-select-method gnus-select-method)
5586 (pop-to-buffer gnus-group-buffer) 6682 (set-buffer gnus-group-buffer)
5587 (if (not quit-config) 6683 (if quit-config
5588 (progn 6684 (gnus-handle-ephemeral-exit quit-config)
5589 (goto-char group-point) 6685 (goto-char group-point)
5590 (gnus-configure-windows 'group 'force)) 6686 ;; If gnus-group-buffer is already displayed, make sure we also move
5591 (gnus-handle-ephemeral-exit quit-config)) 6687 ;; the cursor in the window that displays it.
6688 (let ((win (get-buffer-window (current-buffer) 0)))
6689 (if win (set-window-point win (point))))
6690 (unless leave-hidden
6691 (gnus-configure-windows 'group 'force)))
5592 ;; Clear the current group name. 6692 ;; Clear the current group name.
5593 (unless quit-config 6693 (unless quit-config
5594 (setq gnus-newsgroup-name nil))))) 6694 (setq gnus-newsgroup-name nil)))))
5595 6695
5596 (defalias 'gnus-summary-quit 'gnus-summary-exit-no-update) 6696 (defalias 'gnus-summary-quit 'gnus-summary-exit-no-update)
5597 (defun gnus-summary-exit-no-update (&optional no-questions) 6697 (defun gnus-summary-exit-no-update (&optional no-questions)
5598 "Quit reading current newsgroup without updating read article info." 6698 "Quit reading current newsgroup without updating read article info."
5599 (interactive) 6699 (interactive)
5600 (let* ((group gnus-newsgroup-name) 6700 (let* ((group gnus-newsgroup-name)
6701 (gnus-group-is-exiting-p t)
6702 (gnus-group-is-exiting-without-update-p t)
5601 (quit-config (gnus-group-quit-config group))) 6703 (quit-config (gnus-group-quit-config group)))
5602 (when (or no-questions 6704 (when (or no-questions
5603 gnus-expert-user 6705 gnus-expert-user
5604 (gnus-y-or-n-p "Discard changes to this group and exit? ")) 6706 (gnus-y-or-n-p "Discard changes to this group and exit? "))
5605 (gnus-async-halt-prefetch) 6707 (gnus-async-halt-prefetch)
5606 (mapcar 'funcall 6708 (run-hooks 'gnus-summary-prepare-exit-hook)
5607 (delq 'gnus-summary-expire-articles
5608 (copy-sequence gnus-summary-prepare-exit-hook)))
5609 (when (gnus-buffer-live-p gnus-article-buffer) 6709 (when (gnus-buffer-live-p gnus-article-buffer)
5610 (save-excursion 6710 (save-excursion
5611 (set-buffer gnus-article-buffer) 6711 (set-buffer gnus-article-buffer)
5612 (mm-destroy-parts gnus-article-mime-handles) 6712 (mm-destroy-parts gnus-article-mime-handles)
5613 ;; Set it to nil for safety reason. 6713 ;; Set it to nil for safety reason.
5620 (setq gnus-article-current nil)) 6720 (setq gnus-article-current nil))
5621 (if (not gnus-kill-summary-on-exit) 6721 (if (not gnus-kill-summary-on-exit)
5622 (gnus-deaden-summary) 6722 (gnus-deaden-summary)
5623 (gnus-close-group group) 6723 (gnus-close-group group)
5624 (gnus-summary-clear-local-variables) 6724 (gnus-summary-clear-local-variables)
6725 (let ((gnus-summary-local-variables gnus-newsgroup-variables))
6726 (gnus-summary-clear-local-variables))
5625 (set-buffer gnus-group-buffer) 6727 (set-buffer gnus-group-buffer)
5626 (gnus-summary-clear-local-variables) 6728 (gnus-summary-clear-local-variables)
5627 (when (get-buffer gnus-summary-buffer) 6729 (let ((gnus-summary-local-variables gnus-newsgroup-variables))
5628 (kill-buffer gnus-summary-buffer))) 6730 (gnus-summary-clear-local-variables))
6731 (gnus-kill-buffer gnus-summary-buffer))
5629 (unless gnus-single-article-buffer 6732 (unless gnus-single-article-buffer
5630 (setq gnus-article-current nil)) 6733 (setq gnus-article-current nil))
5631 (when gnus-use-trees 6734 (when gnus-use-trees
5632 (gnus-tree-close group)) 6735 (gnus-tree-close group))
5633 (gnus-async-prefetch-remove-group group) 6736 (gnus-async-prefetch-remove-group group)
5635 (bury-buffer gnus-article-buffer)) 6738 (bury-buffer gnus-article-buffer))
5636 ;; Return to the group buffer. 6739 ;; Return to the group buffer.
5637 (gnus-configure-windows 'group 'force) 6740 (gnus-configure-windows 'group 'force)
5638 ;; Clear the current group name. 6741 ;; Clear the current group name.
5639 (setq gnus-newsgroup-name nil) 6742 (setq gnus-newsgroup-name nil)
6743 (unless (gnus-ephemeral-group-p group)
6744 (gnus-group-update-group group))
5640 (when (equal (gnus-group-group-name) group) 6745 (when (equal (gnus-group-group-name) group)
5641 (gnus-group-next-unread-group 1)) 6746 (gnus-group-next-unread-group 1))
5642 (when quit-config 6747 (when quit-config
5643 (gnus-handle-ephemeral-exit quit-config))))) 6748 (gnus-handle-ephemeral-exit quit-config)))))
5644 6749
5645 (defun gnus-handle-ephemeral-exit (quit-config) 6750 (defun gnus-handle-ephemeral-exit (quit-config)
5646 "Handle movement when leaving an ephemeral group. 6751 "Handle movement when leaving an ephemeral group.
5647 The state which existed when entering the ephemeral is reset." 6752 The state which existed when entering the ephemeral is reset."
5648 (if (not (buffer-name (car quit-config))) 6753 (if (not (buffer-name (car quit-config)))
5649 (gnus-configure-windows 'group 'force) 6754 (gnus-configure-windows 'group 'force)
5650 (set-buffer (car quit-config)) 6755 (set-buffer (car quit-config))
5651 (cond ((eq major-mode 'gnus-summary-mode) 6756 (cond ((eq major-mode 'gnus-summary-mode)
5652 (gnus-set-global-variables)) 6757 (gnus-set-global-variables))
5653 ((eq major-mode 'gnus-article-mode) 6758 ((eq major-mode 'gnus-article-mode)
5654 (save-excursion 6759 (save-excursion
5655 ;; The `gnus-summary-buffer' variable may point 6760 ;; The `gnus-summary-buffer' variable may point
5656 ;; to the old summary buffer when using a single 6761 ;; to the old summary buffer when using a single
5657 ;; article buffer. 6762 ;; article buffer.
5658 (unless (gnus-buffer-live-p gnus-summary-buffer) 6763 (unless (gnus-buffer-live-p gnus-summary-buffer)
5659 (set-buffer gnus-group-buffer)) 6764 (set-buffer gnus-group-buffer))
5660 (set-buffer gnus-summary-buffer) 6765 (set-buffer gnus-summary-buffer)
5661 (gnus-set-global-variables)))) 6766 (gnus-set-global-variables))))
5662 (if (or (eq (cdr quit-config) 'article) 6767 (if (or (eq (cdr quit-config) 'article)
5663 (eq (cdr quit-config) 'pick)) 6768 (eq (cdr quit-config) 'pick))
5664 (progn 6769 (progn
5665 ;; The current article may be from the ephemeral group 6770 ;; The current article may be from the ephemeral group
5666 ;; thus it is best that we reload this article 6771 ;; thus it is best that we reload this article
5667 (gnus-summary-show-article) 6772 ;;
5668 (if (and (boundp 'gnus-pick-mode) (symbol-value 'gnus-pick-mode)) 6773 ;; If we're exiting from a large digest, this can be
5669 (gnus-configure-windows 'pick 'force) 6774 ;; extremely slow. So, it's better not to reload it. -- jh.
5670 (gnus-configure-windows (cdr quit-config) 'force))) 6775 ;;(gnus-summary-show-article)
6776 (if (and (boundp 'gnus-pick-mode) (symbol-value 'gnus-pick-mode))
6777 (gnus-configure-windows 'pick 'force)
6778 (gnus-configure-windows (cdr quit-config) 'force)))
5671 (gnus-configure-windows (cdr quit-config) 'force)) 6779 (gnus-configure-windows (cdr quit-config) 'force))
5672 (when (eq major-mode 'gnus-summary-mode) 6780 (when (eq major-mode 'gnus-summary-mode)
5673 (gnus-summary-next-subject 1 nil t) 6781 (gnus-summary-next-subject 1 nil t)
5674 (gnus-summary-recenter) 6782 (gnus-summary-recenter)
5675 (gnus-summary-position-point)))) 6783 (gnus-summary-position-point))))
5681 (unless gnus-dead-summary-mode-map 6789 (unless gnus-dead-summary-mode-map
5682 (setq gnus-dead-summary-mode-map (make-keymap)) 6790 (setq gnus-dead-summary-mode-map (make-keymap))
5683 (suppress-keymap gnus-dead-summary-mode-map) 6791 (suppress-keymap gnus-dead-summary-mode-map)
5684 (substitute-key-definition 6792 (substitute-key-definition
5685 'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-mode-map) 6793 'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-mode-map)
5686 (let ((keys '("\C-d" "\r" "\177" [delete]))) 6794 (dolist (key '("\C-d" "\r" "\177" [delete]))
5687 (while keys 6795 (define-key gnus-dead-summary-mode-map
5688 (define-key gnus-dead-summary-mode-map 6796 key 'gnus-summary-wake-up-the-dead))
5689 (pop keys) 'gnus-summary-wake-up-the-dead)))) 6797 (dolist (key '("q" "Q"))
6798 (define-key gnus-dead-summary-mode-map key 'bury-buffer)))
5690 6799
5691 (defvar gnus-dead-summary-mode nil 6800 (defvar gnus-dead-summary-mode nil
5692 "Minor mode for Gnus summary buffers.") 6801 "Minor mode for Gnus summary buffers.")
5693 6802
5694 (defun gnus-dead-summary-mode (&optional arg) 6803 (defun gnus-dead-summary-mode (&optional arg)
5730 (not gnus-single-article-buffer)) 6839 (not gnus-single-article-buffer))
5731 (save-excursion 6840 (save-excursion
5732 (set-buffer buffer) 6841 (set-buffer buffer)
5733 (gnus-kill-buffer gnus-article-buffer) 6842 (gnus-kill-buffer gnus-article-buffer)
5734 (gnus-kill-buffer gnus-original-article-buffer))) 6843 (gnus-kill-buffer gnus-original-article-buffer)))
5735 (cond (gnus-kill-summary-on-exit 6844 (cond
5736 (when (and gnus-use-trees 6845 ;; Kill the buffer.
5737 (gnus-buffer-exists-p buffer)) 6846 (gnus-kill-summary-on-exit
5738 (save-excursion 6847 (when (and gnus-use-trees
5739 (set-buffer buffer) 6848 (gnus-buffer-exists-p buffer))
5740 (gnus-tree-close gnus-newsgroup-name))) 6849 (save-excursion
5741 (gnus-kill-buffer buffer)) 6850 (set-buffer buffer)
5742 ((gnus-buffer-exists-p buffer) 6851 (gnus-tree-close gnus-newsgroup-name)))
5743 (save-excursion 6852 (gnus-kill-buffer buffer))
5744 (set-buffer buffer) 6853 ;; Deaden the buffer.
5745 (gnus-deaden-summary)))))) 6854 ((gnus-buffer-exists-p buffer)
6855 (save-excursion
6856 (set-buffer buffer)
6857 (gnus-deaden-summary))))))
5746 6858
5747 (defun gnus-summary-wake-up-the-dead (&rest args) 6859 (defun gnus-summary-wake-up-the-dead (&rest args)
5748 "Wake up the dead summary buffer." 6860 "Wake up the dead summary buffer."
5749 (interactive) 6861 (interactive)
5750 (gnus-dead-summary-mode -1) 6862 (gnus-dead-summary-mode -1)
5787 ;; Walking around group mode buffer from summary mode. 6899 ;; Walking around group mode buffer from summary mode.
5788 6900
5789 (defun gnus-summary-next-group (&optional no-article target-group backward) 6901 (defun gnus-summary-next-group (&optional no-article target-group backward)
5790 "Exit current newsgroup and then select next unread newsgroup. 6902 "Exit current newsgroup and then select next unread newsgroup.
5791 If prefix argument NO-ARTICLE is non-nil, no article is selected 6903 If prefix argument NO-ARTICLE is non-nil, no article is selected
5792 initially. If NEXT-GROUP, go to this group. If BACKWARD, go to 6904 initially. If TARGET-GROUP, go to this group. If BACKWARD, go to
5793 previous group instead." 6905 previous group instead."
5794 (interactive "P") 6906 (interactive "P")
5795 ;; Stop pre-fetching. 6907 ;; Stop pre-fetching.
5796 (gnus-async-halt-prefetch) 6908 (gnus-async-halt-prefetch)
5797 (let ((current-group gnus-newsgroup-name) 6909 (let ((current-group gnus-newsgroup-name)
5824 ;; We try to enter the target group. 6936 ;; We try to enter the target group.
5825 (gnus-group-jump-to-group target-group) 6937 (gnus-group-jump-to-group target-group)
5826 (let ((unreads (gnus-group-group-unread))) 6938 (let ((unreads (gnus-group-group-unread)))
5827 (if (and (or (eq t unreads) 6939 (if (and (or (eq t unreads)
5828 (and unreads (not (zerop unreads)))) 6940 (and unreads (not (zerop unreads))))
5829 (gnus-summary-read-group 6941 (gnus-summary-read-group
5830 target-group nil no-article 6942 target-group nil no-article
5831 (and (buffer-name current-buffer) current-buffer) 6943 (and (buffer-name current-buffer) current-buffer)
5832 nil backward)) 6944 nil backward))
5833 (setq entered t) 6945 (setq entered t)
5834 (setq current-group target-group 6946 (setq current-group target-group
5835 target-group nil))))))) 6947 target-group nil)))))))
5836 6948
5837 (defun gnus-summary-prev-group (&optional no-article) 6949 (defun gnus-summary-prev-group (&optional no-article)
5840 (interactive "P") 6952 (interactive "P")
5841 (gnus-summary-next-group no-article nil t)) 6953 (gnus-summary-next-group no-article nil t))
5842 6954
5843 ;; Walking around summary lines. 6955 ;; Walking around summary lines.
5844 6956
5845 (defun gnus-summary-first-subject (&optional unread undownloaded) 6957 (defun gnus-summary-first-subject (&optional unread undownloaded unseen)
5846 "Go to the first unread subject. 6958 "Go to the first subject satisfying any non-nil constraint.
5847 If UNREAD is non-nil, go to the first unread article. 6959 If UNREAD is non-nil, the article should be unread.
5848 Returns the article selected or nil if there are no unread articles." 6960 If UNDOWNLOADED is non-nil, the article should be undownloaded.
6961 If UNSEEN is non-nil, the article should be unseen.
6962 Returns the article selected or nil if there are no matching articles."
5849 (interactive "P") 6963 (interactive "P")
5850 (prog1 6964 (cond
5851 (cond 6965 ;; Empty summary.
5852 ;; Empty summary. 6966 ((null gnus-newsgroup-data)
5853 ((null gnus-newsgroup-data) 6967 (gnus-message 3 "No articles in the group")
5854 (gnus-message 3 "No articles in the group") 6968 nil)
5855 nil) 6969 ;; Pick the first article.
5856 ;; Pick the first article. 6970 ((not (or unread undownloaded unseen))
5857 ((not unread) 6971 (goto-char (gnus-data-pos (car gnus-newsgroup-data)))
5858 (goto-char (gnus-data-pos (car gnus-newsgroup-data))) 6972 (gnus-data-number (car gnus-newsgroup-data)))
5859 (gnus-data-number (car gnus-newsgroup-data))) 6973 ;; Find the first unread article.
5860 ;; No unread articles. 6974 (t
5861 ((null gnus-newsgroup-unreads) 6975 (let ((data gnus-newsgroup-data))
5862 (gnus-message 3 "No more unread articles") 6976 (while (and data
5863 nil) 6977 (let ((num (gnus-data-number (car data))))
5864 ;; Find the first unread article. 6978 (or (memq num gnus-newsgroup-unfetched)
5865 (t 6979 (not (or (and unread
5866 (let ((data gnus-newsgroup-data)) 6980 (memq num gnus-newsgroup-unreads))
5867 (while (and data 6981 (and undownloaded
5868 (and (not (and undownloaded 6982 (memq num gnus-newsgroup-undownloaded))
5869 (eq gnus-undownloaded-mark 6983 (and unseen
5870 (gnus-data-mark (car data))))) 6984 (memq num gnus-newsgroup-unseen)))))))
5871 (not (gnus-data-unread-p (car data))))) 6985 (setq data (cdr data)))
5872 (setq data (cdr data))) 6986 (prog1
5873 (when data 6987 (if data
5874 (goto-char (gnus-data-pos (car data))) 6988 (progn
5875 (gnus-data-number (car data)))))) 6989 (goto-char (gnus-data-pos (car data)))
5876 (gnus-summary-position-point))) 6990 (gnus-data-number (car data)))
6991 (gnus-message 3 "No more%s articles"
6992 (let* ((r (when unread " unread"))
6993 (d (when undownloaded " undownloaded"))
6994 (s (when unseen " unseen"))
6995 (l (delq nil (list r d s))))
6996 (cond ((= 3 (length l))
6997 (concat r "," d ", or" s))
6998 ((= 2 (length l))
6999 (concat (car l) ", or" (cadr l)))
7000 ((= 1 (length l))
7001 (car l))
7002 (t
7003 ""))))
7004 nil
7005 )
7006 (gnus-summary-position-point))))))
5877 7007
5878 (defun gnus-summary-next-subject (n &optional unread dont-display) 7008 (defun gnus-summary-next-subject (n &optional unread dont-display)
5879 "Go to next N'th summary line. 7009 "Go to next N'th summary line.
5880 If N is negative, go to the previous N'th subject line. 7010 If N is negative, go to the previous N'th subject line.
5881 If UNREAD is non-nil, only unread articles are selected. 7011 If UNREAD is non-nil, only unread articles are selected.
5912 (defun gnus-summary-prev-unread-subject (n) 7042 (defun gnus-summary-prev-unread-subject (n)
5913 "Go to previous N'th unread summary line." 7043 "Go to previous N'th unread summary line."
5914 (interactive "p") 7044 (interactive "p")
5915 (gnus-summary-next-subject (- n) t)) 7045 (gnus-summary-next-subject (- n) t))
5916 7046
7047 (defun gnus-summary-goto-subjects (articles)
7048 "Insert the subject header for ARTICLES in the current buffer."
7049 (save-excursion
7050 (dolist (article articles)
7051 (gnus-summary-goto-subject article t)))
7052 (gnus-summary-limit (append articles gnus-newsgroup-limit))
7053 (gnus-summary-position-point))
7054
5917 (defun gnus-summary-goto-subject (article &optional force silent) 7055 (defun gnus-summary-goto-subject (article &optional force silent)
5918 "Go the subject line of ARTICLE. 7056 "Go the subject line of ARTICLE.
5919 If FORCE, also allow jumping to articles not currently shown." 7057 If FORCE, also allow jumping to articles not currently shown."
5920 (interactive "nArticle number: ") 7058 (interactive "nArticle number: ")
7059 (unless (numberp article)
7060 (error "Article %s is not a number" article))
5921 (let ((b (point)) 7061 (let ((b (point))
5922 (data (gnus-data-find article))) 7062 (data (gnus-data-find article)))
5923 ;; We read in the article if we have to. 7063 ;; We read in the article if we have to.
5924 (and (not data) 7064 (and (not data)
5925 force 7065 force
5932 (if (not data) 7072 (if (not data)
5933 (progn 7073 (progn
5934 (unless silent 7074 (unless silent
5935 (gnus-message 3 "Can't find article %d" article)) 7075 (gnus-message 3 "Can't find article %d" article))
5936 nil) 7076 nil)
5937 (goto-char (gnus-data-pos data)) 7077 (let ((pt (gnus-data-pos data)))
7078 (goto-char pt)
7079 (gnus-summary-set-article-display-arrow pt))
5938 (gnus-summary-position-point) 7080 (gnus-summary-position-point)
5939 article))) 7081 article)))
5940 7082
5941 ;; Walking around summary lines with displaying articles. 7083 ;; Walking around summary lines with displaying articles.
5942 7084
5952 "Display ARTICLE in article buffer." 7094 "Display ARTICLE in article buffer."
5953 (when (gnus-buffer-live-p gnus-article-buffer) 7095 (when (gnus-buffer-live-p gnus-article-buffer)
5954 (with-current-buffer gnus-article-buffer 7096 (with-current-buffer gnus-article-buffer
5955 (mm-enable-multibyte))) 7097 (mm-enable-multibyte)))
5956 (gnus-set-global-variables) 7098 (gnus-set-global-variables)
7099 (when (gnus-buffer-live-p gnus-article-buffer)
7100 (with-current-buffer gnus-article-buffer
7101 (setq gnus-article-charset gnus-newsgroup-charset)
7102 (setq gnus-article-ignored-charsets gnus-newsgroup-ignored-charsets)
7103 (mm-enable-multibyte)))
5957 (if (null article) 7104 (if (null article)
5958 nil 7105 nil
5959 (prog1 7106 (prog1
5960 (if gnus-summary-display-article-function 7107 (if gnus-summary-display-article-function
5961 (funcall gnus-summary-display-article-function article all-header) 7108 (funcall gnus-summary-display-article-function article all-header)
6002 force) 7149 force)
6003 ;; The requested article is different from the current article. 7150 ;; The requested article is different from the current article.
6004 (progn 7151 (progn
6005 (gnus-summary-display-article article all-headers) 7152 (gnus-summary-display-article article all-headers)
6006 (when (gnus-buffer-live-p gnus-article-buffer) 7153 (when (gnus-buffer-live-p gnus-article-buffer)
6007 (with-current-buffer gnus-article-buffer 7154 (with-current-buffer gnus-article-buffer
6008 (if (not gnus-article-decoded-p) ;; a local variable 7155 (if (not gnus-article-decoded-p) ;; a local variable
6009 (mm-disable-multibyte)))) 7156 (mm-disable-multibyte))))
6010 (when (or all-headers gnus-show-all-headers)
6011 (gnus-article-show-all-headers))
6012 (gnus-article-set-window-start 7157 (gnus-article-set-window-start
6013 (cdr (assq article gnus-newsgroup-bookmarks))) 7158 (cdr (assq article gnus-newsgroup-bookmarks)))
6014 article) 7159 article)
6015 (when (or all-headers gnus-show-all-headers)
6016 (gnus-article-show-all-headers))
6017 'old)))) 7160 'old))))
7161
7162 (defun gnus-summary-force-verify-and-decrypt ()
7163 "Display buttons for signed/encrypted parts and verify/decrypt them."
7164 (interactive)
7165 (let ((mm-verify-option 'known)
7166 (mm-decrypt-option 'known)
7167 (gnus-article-emulate-mime t)
7168 (gnus-buttonized-mime-types (append (list "multipart/signed"
7169 "multipart/encrypted")
7170 gnus-buttonized-mime-types)))
7171 (gnus-summary-select-article nil 'force)))
6018 7172
6019 (defun gnus-summary-set-current-mark (&optional current-mark) 7173 (defun gnus-summary-set-current-mark (&optional current-mark)
6020 "Obsolete function." 7174 "Obsolete function."
6021 nil) 7175 nil)
6022 7176
6085 7239
6086 (defun gnus-summary-walk-group-buffer (from-group cmd unread backward start) 7240 (defun gnus-summary-walk-group-buffer (from-group cmd unread backward start)
6087 (let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1)) 7241 (let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1))
6088 (?\C-p (gnus-group-prev-unread-group 1)))) 7242 (?\C-p (gnus-group-prev-unread-group 1))))
6089 (cursor-in-echo-area t) 7243 (cursor-in-echo-area t)
6090 keve key group ended) 7244 keve key group ended prompt)
6091 (save-excursion 7245 (save-excursion
6092 (set-buffer gnus-group-buffer) 7246 (set-buffer gnus-group-buffer)
6093 (goto-char start) 7247 (goto-char start)
6094 (setq group 7248 (setq group
6095 (if (eq gnus-keep-same-level 'best) 7249 (if (eq gnus-keep-same-level 'best)
6096 (gnus-summary-best-group gnus-newsgroup-name) 7250 (gnus-summary-best-group gnus-newsgroup-name)
6097 (gnus-summary-search-group backward gnus-keep-same-level)))) 7251 (gnus-summary-search-group backward gnus-keep-same-level))))
6098 (while (not ended) 7252 (while (not ended)
6099 (gnus-message 7253 (setq prompt
6100 5 "No more%s articles%s" (if unread " unread" "") 7254 (format
6101 (if (and group 7255 "No more%s articles%s " (if unread " unread" "")
6102 (not (gnus-ephemeral-group-p gnus-newsgroup-name))) 7256 (if (and group
6103 (format " (Type %s for %s [%s])" 7257 (not (gnus-ephemeral-group-p gnus-newsgroup-name)))
6104 (single-key-description cmd) group 7258 (format " (Type %s for %s [%s])"
6105 (car (gnus-gethash group gnus-newsrc-hashtb))) 7259 (single-key-description cmd)
6106 (format " (Type %s to exit %s)" 7260 (gnus-group-decoded-name group)
6107 (single-key-description cmd) 7261 (car (gnus-gethash group gnus-newsrc-hashtb)))
6108 gnus-newsgroup-name))) 7262 (format " (Type %s to exit %s)"
7263 (single-key-description cmd)
7264 (gnus-group-decoded-name gnus-newsgroup-name)))))
6109 ;; Confirm auto selection. 7265 ;; Confirm auto selection.
6110 (setq key (car (setq keve (gnus-read-event-char)))) 7266 (setq key (car (setq keve (gnus-read-event-char prompt)))
6111 (setq ended t) 7267 ended t)
6112 (cond 7268 (cond
6113 ((assq key keystrokes) 7269 ((assq key keystrokes)
6114 (let ((obuf (current-buffer))) 7270 (let ((obuf (current-buffer)))
6115 (switch-to-buffer gnus-group-buffer) 7271 (switch-to-buffer gnus-group-buffer)
6116 (when group 7272 (when group
6149 (or (not (eq gnus-summary-goto-unread 'never)) 7305 (or (not (eq gnus-summary-goto-unread 'never))
6150 (gnus-summary-first-article-p (gnus-summary-article-number))) 7306 (gnus-summary-first-article-p (gnus-summary-article-number)))
6151 (and gnus-auto-select-same 7307 (and gnus-auto-select-same
6152 (gnus-summary-article-subject)))) 7308 (gnus-summary-article-subject))))
6153 7309
6154 (defun gnus-summary-next-page (&optional lines circular) 7310 (defun gnus-summary-next-page (&optional lines circular stop)
6155 "Show next page of the selected article. 7311 "Show next page of the selected article.
6156 If at the end of the current article, select the next article. 7312 If at the end of the current article, select the next article.
6157 LINES says how many lines should be scrolled up. 7313 LINES says how many lines should be scrolled up.
6158 7314
6159 If CIRCULAR is non-nil, go to the start of the article instead of 7315 If CIRCULAR is non-nil, go to the start of the article instead of
6160 selecting the next article when reaching the end of the current 7316 selecting the next article when reaching the end of the current
6161 article." 7317 article.
7318
7319 If STOP is non-nil, just stop when reaching the end of the message.
7320
7321 Also see the variable `gnus-article-skip-boring'."
6162 (interactive "P") 7322 (interactive "P")
6163 (setq gnus-summary-buffer (current-buffer)) 7323 (setq gnus-summary-buffer (current-buffer))
6164 (gnus-set-global-variables) 7324 (gnus-set-global-variables)
6165 (let ((article (gnus-summary-article-number)) 7325 (let ((article (gnus-summary-article-number))
6166 (article-window (get-buffer-window gnus-article-buffer t)) 7326 (article-window (get-buffer-window gnus-article-buffer t))
6180 (not (equal (car gnus-article-current) gnus-newsgroup-name))) 7340 (not (equal (car gnus-article-current) gnus-newsgroup-name)))
6181 ;; Selected subject is different from current article's. 7341 ;; Selected subject is different from current article's.
6182 (gnus-summary-display-article article) 7342 (gnus-summary-display-article article)
6183 (when article-window 7343 (when article-window
6184 (gnus-eval-in-buffer-window gnus-article-buffer 7344 (gnus-eval-in-buffer-window gnus-article-buffer
6185 (setq endp (gnus-article-next-page lines))) 7345 (setq endp (or (gnus-article-next-page lines)
7346 (gnus-article-only-boring-p))))
6186 (when endp 7347 (when endp
6187 (cond (circular 7348 (cond (stop
7349 (gnus-message 3 "End of message"))
7350 (circular
6188 (gnus-summary-beginning-of-article)) 7351 (gnus-summary-beginning-of-article))
6189 (lines 7352 (lines
6190 (gnus-message 3 "End of message")) 7353 (gnus-message 3 "End of message"))
6191 ((null lines) 7354 ((null lines)
6192 (if (and (eq gnus-summary-goto-unread 'never) 7355 (if (and (eq gnus-summary-goto-unread 'never)
6294 (when (gnus-summary-first-subject t) 7457 (when (gnus-summary-first-subject t)
6295 (gnus-summary-show-thread) 7458 (gnus-summary-show-thread)
6296 (gnus-summary-first-subject t)) 7459 (gnus-summary-first-subject t))
6297 (gnus-summary-position-point))) 7460 (gnus-summary-position-point)))
6298 7461
7462 (defun gnus-summary-first-unseen-subject ()
7463 "Place the point on the subject line of the first unseen article.
7464 Return nil if there are no unseen articles."
7465 (interactive)
7466 (prog1
7467 (when (gnus-summary-first-subject nil nil t)
7468 (gnus-summary-show-thread)
7469 (gnus-summary-first-subject nil nil t))
7470 (gnus-summary-position-point)))
7471
7472 (defun gnus-summary-first-unseen-or-unread-subject ()
7473 "Place the point on the subject line of the first unseen article or,
7474 if all article have been seen, on the subject line of the first unread
7475 article."
7476 (interactive)
7477 (prog1
7478 (unless (when (gnus-summary-first-subject nil nil t)
7479 (gnus-summary-show-thread)
7480 (gnus-summary-first-subject nil nil t))
7481 (when (gnus-summary-first-subject t)
7482 (gnus-summary-show-thread)
7483 (gnus-summary-first-subject t)))
7484 (gnus-summary-position-point)))
7485
6299 (defun gnus-summary-first-article () 7486 (defun gnus-summary-first-article ()
6300 "Select the first article. 7487 "Select the first article.
6301 Return nil if there are no articles." 7488 Return nil if there are no articles."
6302 (interactive) 7489 (interactive)
6303 (prog1 7490 (prog1
6305 (gnus-summary-show-thread) 7492 (gnus-summary-show-thread)
6306 (gnus-summary-first-subject) 7493 (gnus-summary-first-subject)
6307 (gnus-summary-display-article (gnus-summary-article-number))) 7494 (gnus-summary-display-article (gnus-summary-article-number)))
6308 (gnus-summary-position-point))) 7495 (gnus-summary-position-point)))
6309 7496
6310 (defun gnus-summary-best-unread-article () 7497 (defun gnus-summary-best-unread-article (&optional arg)
6311 "Select the unread article with the highest score." 7498 "Select the unread article with the highest score.
7499 If given a prefix argument, select the next unread article that has a
7500 score higher than the default score."
7501 (interactive "P")
7502 (let ((article (if arg
7503 (gnus-summary-better-unread-subject)
7504 (gnus-summary-best-unread-subject))))
7505 (if article
7506 (gnus-summary-goto-article article)
7507 (error "No unread articles"))))
7508
7509 (defun gnus-summary-best-unread-subject ()
7510 "Select the unread subject with the highest score."
6312 (interactive) 7511 (interactive)
6313 (let ((best -1000000) 7512 (let ((best -1000000)
6314 (data gnus-newsgroup-data) 7513 (data gnus-newsgroup-data)
6315 article score) 7514 article score)
6316 (while data 7515 (while data
6319 (gnus-summary-article-score (gnus-data-number (car data)))) 7518 (gnus-summary-article-score (gnus-data-number (car data))))
6320 best) 7519 best)
6321 (setq best score 7520 (setq best score
6322 article (gnus-data-number (car data)))) 7521 article (gnus-data-number (car data))))
6323 (setq data (cdr data))) 7522 (setq data (cdr data)))
6324 (prog1 7523 (when article
6325 (if article 7524 (gnus-summary-goto-subject article))
6326 (gnus-summary-goto-article article) 7525 (gnus-summary-position-point)
6327 (error "No unread articles")) 7526 article))
6328 (gnus-summary-position-point)))) 7527
7528 (defun gnus-summary-better-unread-subject ()
7529 "Select the first unread subject that has a score over the default score."
7530 (interactive)
7531 (let ((data gnus-newsgroup-data)
7532 article score)
7533 (while (and (setq article (gnus-data-number (car data)))
7534 (or (gnus-data-read-p (car data))
7535 (not (> (gnus-summary-article-score article)
7536 gnus-summary-default-score))))
7537 (setq data (cdr data)))
7538 (when article
7539 (gnus-summary-goto-subject article))
7540 (gnus-summary-position-point)
7541 article))
6329 7542
6330 (defun gnus-summary-last-subject () 7543 (defun gnus-summary-last-subject ()
6331 "Go to the last displayed subject line in the group." 7544 "Go to the last displayed subject line in the group."
6332 (let ((article (gnus-data-number (car (gnus-data-list t))))) 7545 (let ((article (gnus-data-number (car (gnus-data-list t)))))
6333 (when article 7546 (when article
6346 gnus-newsgroup-limit)) 7559 gnus-newsgroup-limit))
6347 current-prefix-arg 7560 current-prefix-arg
6348 t)) 7561 t))
6349 (prog1 7562 (prog1
6350 (if (and (stringp article) 7563 (if (and (stringp article)
6351 (string-match "@" article)) 7564 (string-match "@\\|%40" article))
6352 (gnus-summary-refer-article article) 7565 (gnus-summary-refer-article article)
6353 (when (stringp article) 7566 (when (stringp article)
6354 (setq article (string-to-number article))) 7567 (setq article (string-to-number article)))
6355 (if (gnus-summary-goto-subject article force) 7568 (if (gnus-summary-goto-subject article force)
6356 (gnus-summary-display-article article all-headers) 7569 (gnus-summary-display-article article all-headers)
6441 (let ((younger current-prefix-arg) 7654 (let ((younger current-prefix-arg)
6442 (days-got nil) 7655 (days-got nil)
6443 days) 7656 days)
6444 (while (not days-got) 7657 (while (not days-got)
6445 (setq days (if younger 7658 (setq days (if younger
6446 (read-string "Limit to articles within (in days): ") 7659 (read-string "Limit to articles younger than (in days, older when negative): ")
6447 (read-string "Limit to articles old than (in days): "))) 7660 (read-string
7661 "Limit to articles older than (in days, younger when negative): ")))
6448 (when (> (length days) 0) 7662 (when (> (length days) 0)
6449 (setq days (read days))) 7663 (setq days (read days)))
6450 (if (numberp days) 7664 (if (numberp days)
6451 (setq days-got t) 7665 (progn
7666 (setq days-got t)
7667 (if (< days 0)
7668 (progn
7669 (setq younger (not younger))
7670 (setq days (* days -1)))))
6452 (message "Please enter a number.") 7671 (message "Please enter a number.")
6453 (sleep-for 1))) 7672 (sleep-for 1)))
6454 (list days younger))) 7673 (list days younger)))
6455 (prog1 7674 (prog1
6456 (let ((data gnus-newsgroup-data) 7675 (let ((data gnus-newsgroup-data)
6474 (defun gnus-summary-limit-to-extra (header regexp &optional not-matching) 7693 (defun gnus-summary-limit-to-extra (header regexp &optional not-matching)
6475 "Limit the summary buffer to articles that match an 'extra' header." 7694 "Limit the summary buffer to articles that match an 'extra' header."
6476 (interactive 7695 (interactive
6477 (let ((header 7696 (let ((header
6478 (intern 7697 (intern
6479 (gnus-completing-read 7698 (gnus-completing-read-with-default
6480 (symbol-name (car gnus-extra-headers)) 7699 (symbol-name (car gnus-extra-headers))
6481 (if current-prefix-arg 7700 (if current-prefix-arg
6482 "Exclude extra header:" 7701 "Exclude extra header"
6483 "Limit extra header:") 7702 "Limit extra header")
6484 (mapcar (lambda (x) 7703 (mapcar (lambda (x)
6485 (cons (symbol-name x) x)) 7704 (cons (symbol-name x) x))
6486 gnus-extra-headers) 7705 gnus-extra-headers)
6487 nil 7706 nil
6488 t)))) 7707 t))))
6499 (unless articles 7718 (unless articles
6500 (error "Found no matches for \"%s\"" regexp)) 7719 (error "Found no matches for \"%s\"" regexp))
6501 (gnus-summary-limit articles)) 7720 (gnus-summary-limit articles))
6502 (gnus-summary-position-point)))) 7721 (gnus-summary-position-point))))
6503 7722
7723 (defun gnus-summary-limit-to-display-predicate ()
7724 "Limit the summary buffer to the predicated in the `display' group parameter."
7725 (interactive)
7726 (unless gnus-newsgroup-display
7727 (error "There is no `display' group parameter"))
7728 (let (articles)
7729 (dolist (number gnus-newsgroup-articles)
7730 (when (funcall gnus-newsgroup-display)
7731 (push number articles)))
7732 (gnus-summary-limit articles))
7733 (gnus-summary-position-point))
7734
6504 (defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread) 7735 (defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
6505 (make-obsolete 7736 (make-obsolete
6506 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread) 7737 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
6507 7738
6508 (defun gnus-summary-limit-to-unread (&optional all) 7739 (defun gnus-summary-limit-to-unread (&optional all)
6513 (gnus-summary-limit-to-marks (char-to-string gnus-unread-mark)) 7744 (gnus-summary-limit-to-marks (char-to-string gnus-unread-mark))
6514 (gnus-summary-limit-to-marks 7745 (gnus-summary-limit-to-marks
6515 ;; Concat all the marks that say that an article is read and have 7746 ;; Concat all the marks that say that an article is read and have
6516 ;; those removed. 7747 ;; those removed.
6517 (list gnus-del-mark gnus-read-mark gnus-ancient-mark 7748 (list gnus-del-mark gnus-read-mark gnus-ancient-mark
6518 gnus-killed-mark gnus-kill-file-mark 7749 gnus-killed-mark gnus-spam-mark gnus-kill-file-mark
6519 gnus-low-score-mark gnus-expirable-mark 7750 gnus-low-score-mark gnus-expirable-mark
6520 gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark 7751 gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark
6521 gnus-duplicate-mark gnus-souped-mark) 7752 gnus-duplicate-mark gnus-souped-mark)
6522 'reverse))) 7753 'reverse)))
6523 7754
6551 (push (gnus-data-number (car data)) articles)) 7782 (push (gnus-data-number (car data)) articles))
6552 (setq data (cdr data))) 7783 (setq data (cdr data)))
6553 (gnus-summary-limit articles)) 7784 (gnus-summary-limit articles))
6554 (gnus-summary-position-point))) 7785 (gnus-summary-position-point)))
6555 7786
6556 (defun gnus-summary-limit-to-score (&optional score) 7787 (defun gnus-summary-limit-to-score (score)
6557 "Limit to articles with score at or above SCORE." 7788 "Limit to articles with score at or above SCORE."
6558 (interactive "P") 7789 (interactive "NLimit to articles with score of at least: ")
6559 (setq score (if score
6560 (prefix-numeric-value score)
6561 (or gnus-summary-default-score 0)))
6562 (let ((data gnus-newsgroup-data) 7790 (let ((data gnus-newsgroup-data)
6563 articles) 7791 articles)
6564 (while data 7792 (while data
6565 (when (>= (gnus-summary-article-score (gnus-data-number (car data))) 7793 (when (>= (gnus-summary-article-score (gnus-data-number (car data)))
6566 score) 7794 score)
6568 (setq data (cdr data))) 7796 (setq data (cdr data)))
6569 (prog1 7797 (prog1
6570 (gnus-summary-limit articles) 7798 (gnus-summary-limit articles)
6571 (gnus-summary-position-point)))) 7799 (gnus-summary-position-point))))
6572 7800
7801 (defun gnus-summary-limit-to-unseen ()
7802 "Limit to unseen articles."
7803 (interactive)
7804 (prog1
7805 (gnus-summary-limit gnus-newsgroup-unseen)
7806 (gnus-summary-position-point)))
7807
6573 (defun gnus-summary-limit-include-thread (id) 7808 (defun gnus-summary-limit-include-thread (id)
6574 "Display all the hidden articles that in the current thread." 7809 "Display all the hidden articles that is in the thread with ID in it.
7810 When called interactively, ID is the Message-ID of the current
7811 article."
6575 (interactive (list (mail-header-id (gnus-summary-article-header)))) 7812 (interactive (list (mail-header-id (gnus-summary-article-header))))
6576 (let ((articles (gnus-articles-in-thread 7813 (let ((articles (gnus-articles-in-thread
6577 (gnus-id-to-thread (gnus-root-id id))))) 7814 (gnus-id-to-thread (gnus-root-id id)))))
6578 (prog1 7815 (prog1
6579 (gnus-summary-limit (nconc articles gnus-newsgroup-limit)) 7816 (gnus-summary-limit (nconc articles gnus-newsgroup-limit))
7817 (gnus-summary-limit-include-matching-articles
7818 "subject"
7819 (regexp-quote (gnus-simplify-subject-re
7820 (mail-header-subject (gnus-id-to-header id)))))
6580 (gnus-summary-position-point)))) 7821 (gnus-summary-position-point))))
7822
7823 (defun gnus-summary-limit-include-matching-articles (header regexp)
7824 "Display all the hidden articles that have HEADERs that match REGEXP."
7825 (interactive (list (read-string "Match on header: ")
7826 (read-string "Regexp: ")))
7827 (let ((articles (gnus-find-matching-articles header regexp)))
7828 (prog1
7829 (gnus-summary-limit (nconc articles gnus-newsgroup-limit))
7830 (gnus-summary-position-point))))
7831
7832 (defun gnus-summary-insert-dormant-articles ()
7833 "Insert all the dormant articles for this group into the current buffer."
7834 (interactive)
7835 (let ((gnus-verbose (max 6 gnus-verbose)))
7836 (if (not gnus-newsgroup-dormant)
7837 (gnus-message 3 "No cached articles for this group")
7838 (gnus-summary-goto-subjects gnus-newsgroup-dormant))))
6581 7839
6582 (defun gnus-summary-limit-include-dormant () 7840 (defun gnus-summary-limit-include-dormant ()
6583 "Display all the hidden articles that are marked as dormant. 7841 "Display all the hidden articles that are marked as dormant.
6584 Note that this command only works on a subset of the articles currently 7842 Note that this command only works on a subset of the articles currently
6585 fetched for this group." 7843 fetched for this group."
6623 7881
6624 (defun gnus-summary-limit-mark-excluded-as-read (&optional all) 7882 (defun gnus-summary-limit-mark-excluded-as-read (&optional all)
6625 "Mark all unread excluded articles as read. 7883 "Mark all unread excluded articles as read.
6626 If ALL, mark even excluded ticked and dormants as read." 7884 If ALL, mark even excluded ticked and dormants as read."
6627 (interactive "P") 7885 (interactive "P")
6628 (let ((articles (gnus-sorted-complement 7886 (setq gnus-newsgroup-limit (sort gnus-newsgroup-limit '<))
7887 (let ((articles (gnus-sorted-ndifference
6629 (sort 7888 (sort
6630 (mapcar (lambda (h) (mail-header-number h)) 7889 (mapcar (lambda (h) (mail-header-number h))
6631 gnus-newsgroup-headers) 7890 gnus-newsgroup-headers)
6632 '<) 7891 '<)
6633 (sort gnus-newsgroup-limit '<))) 7892 gnus-newsgroup-limit))
6634 article) 7893 article)
6635 (setq gnus-newsgroup-unreads 7894 (setq gnus-newsgroup-unreads
6636 (gnus-intersection gnus-newsgroup-unreads gnus-newsgroup-limit)) 7895 (gnus-sorted-intersection gnus-newsgroup-unreads
7896 gnus-newsgroup-limit))
6637 (if all 7897 (if all
6638 (setq gnus-newsgroup-dormant nil 7898 (setq gnus-newsgroup-dormant nil
6639 gnus-newsgroup-marked nil 7899 gnus-newsgroup-marked nil
6640 gnus-newsgroup-reads 7900 gnus-newsgroup-reads
6641 (nconc 7901 (nconc
6661 found) 7921 found)
6662 ;; This will do all the work of generating the new summary buffer 7922 ;; This will do all the work of generating the new summary buffer
6663 ;; according to the new limit. 7923 ;; according to the new limit.
6664 (gnus-summary-prepare) 7924 (gnus-summary-prepare)
6665 ;; Hide any threads, possibly. 7925 ;; Hide any threads, possibly.
6666 (and gnus-show-threads 7926 (gnus-summary-maybe-hide-threads)
6667 gnus-thread-hide-subtree
6668 (gnus-summary-hide-all-threads))
6669 ;; Try to return to the article you were at, or one in the 7927 ;; Try to return to the article you were at, or one in the
6670 ;; neighborhood. 7928 ;; neighborhood.
6671 (when data 7929 (when data
6672 ;; We try to find some article after the current one. 7930 ;; We try to find some article after the current one.
6673 (while data 7931 (while data
6723 th nil) 7981 th nil)
6724 (setq th (cdr th)))))))))) 7982 (setq th (cdr th))))))))))
6725 thread) 7983 thread)
6726 7984
6727 (defun gnus-cut-threads (threads) 7985 (defun gnus-cut-threads (threads)
6728 "Cut off all uninteresting articles from the beginning of threads." 7986 "Cut off all uninteresting articles from the beginning of THREADS."
6729 (when (or (eq gnus-fetch-old-headers 'some) 7987 (when (or (eq gnus-fetch-old-headers 'some)
6730 (eq gnus-fetch-old-headers 'invisible) 7988 (eq gnus-fetch-old-headers 'invisible)
6731 (numberp gnus-fetch-old-headers) 7989 (numberp gnus-fetch-old-headers)
6732 (eq gnus-build-sparse-threads 'some) 7990 (eq gnus-build-sparse-threads 'some)
6733 (eq gnus-build-sparse-threads 'more)) 7991 (eq gnus-build-sparse-threads 'more))
6743 This entails weeding out unwanted dormants, low-scored articles, 8001 This entails weeding out unwanted dormants, low-scored articles,
6744 fetch-old-headers verbiage, and so on." 8002 fetch-old-headers verbiage, and so on."
6745 ;; Most groups have nothing to remove. 8003 ;; Most groups have nothing to remove.
6746 (if (or gnus-inhibit-limiting 8004 (if (or gnus-inhibit-limiting
6747 (and (null gnus-newsgroup-dormant) 8005 (and (null gnus-newsgroup-dormant)
8006 (eq gnus-newsgroup-display 'gnus-not-ignore)
6748 (not (eq gnus-fetch-old-headers 'some)) 8007 (not (eq gnus-fetch-old-headers 'some))
6749 (not (numberp gnus-fetch-old-headers)) 8008 (not (numberp gnus-fetch-old-headers))
6750 (not (eq gnus-fetch-old-headers 'invisible)) 8009 (not (eq gnus-fetch-old-headers 'invisible))
6751 (null gnus-summary-expunge-below) 8010 (null gnus-summary-expunge-below)
6752 (not (eq gnus-build-sparse-threads 'some)) 8011 (not (eq gnus-build-sparse-threads 'some))
6782 ;; First we get the number of visible children to this thread. This 8041 ;; First we get the number of visible children to this thread. This
6783 ;; is done by recursing down the thread using this function, so this 8042 ;; is done by recursing down the thread using this function, so this
6784 ;; will really go down to a leaf article first, before slowly 8043 ;; will really go down to a leaf article first, before slowly
6785 ;; working its way up towards the root. 8044 ;; working its way up towards the root.
6786 (when thread 8045 (when thread
6787 (let ((children 8046 (let* ((max-lisp-eval-depth 5000)
8047 (children
6788 (if (cdr thread) 8048 (if (cdr thread)
6789 (apply '+ (mapcar 'gnus-summary-limit-children 8049 (apply '+ (mapcar 'gnus-summary-limit-children
6790 (cdr thread))) 8050 (cdr thread)))
6791 0)) 8051 0))
6792 (number (mail-header-number (car thread))) 8052 (number (mail-header-number (car thread)))
6831 (if gnus-newsgroup-auto-expire 8091 (if gnus-newsgroup-auto-expire
6832 (push number gnus-newsgroup-expirable) 8092 (push number gnus-newsgroup-expirable)
6833 (push (cons number gnus-low-score-mark) 8093 (push (cons number gnus-low-score-mark)
6834 gnus-newsgroup-reads))) 8094 gnus-newsgroup-reads)))
6835 t) 8095 t)
8096 ;; Do the `display' group parameter.
8097 (and gnus-newsgroup-display
8098 (not (funcall gnus-newsgroup-display)))
6836 ;; Check NoCeM things. 8099 ;; Check NoCeM things.
6837 (if (and gnus-use-nocem 8100 (if (and gnus-use-nocem
6838 (gnus-nocem-unwanted-article-p 8101 (gnus-nocem-unwanted-article-p
6839 (mail-header-id (car thread)))) 8102 (mail-header-id (car thread))))
6840 (progn 8103 (progn
6888 ;; server. 8151 ;; server.
6889 (save-excursion 8152 (save-excursion
6890 (set-buffer gnus-original-article-buffer) 8153 (set-buffer gnus-original-article-buffer)
6891 (nnheader-narrow-to-headers) 8154 (nnheader-narrow-to-headers)
6892 (unless (setq ref (message-fetch-field "references")) 8155 (unless (setq ref (message-fetch-field "references"))
6893 (setq ref (message-fetch-field "in-reply-to"))) 8156 (when (setq ref (message-fetch-field "in-reply-to"))
8157 (setq ref (gnus-extract-message-id-from-in-reply-to ref))))
6894 (widen)) 8158 (widen))
6895 (setq ref 8159 (setq ref
6896 ;; It's not the current article, so we take a bet on 8160 ;; It's not the current article, so we take a bet on
6897 ;; the value we got from the server. 8161 ;; the value we got from the server.
6898 (mail-header-references header))) 8162 (mail-header-references header)))
6934 of what's specified by the `gnus-refer-thread-limit' variable." 8198 of what's specified by the `gnus-refer-thread-limit' variable."
6935 (interactive "P") 8199 (interactive "P")
6936 (let ((id (mail-header-id (gnus-summary-article-header))) 8200 (let ((id (mail-header-id (gnus-summary-article-header)))
6937 (limit (if limit (prefix-numeric-value limit) 8201 (limit (if limit (prefix-numeric-value limit)
6938 gnus-refer-thread-limit))) 8202 gnus-refer-thread-limit)))
6939 ;; We want to fetch LIMIT *old* headers, but we also have to
6940 ;; re-fetch all the headers in the current buffer, because many of
6941 ;; them may be undisplayed. So we adjust LIMIT.
6942 (when (numberp limit)
6943 (incf limit (- gnus-newsgroup-end gnus-newsgroup-begin)))
6944 (unless (eq gnus-fetch-old-headers 'invisible) 8203 (unless (eq gnus-fetch-old-headers 'invisible)
6945 (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name) 8204 (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name)
6946 ;; Retrieve the headers and read them in. 8205 ;; Retrieve the headers and read them in.
6947 (if (eq (gnus-retrieve-headers 8206 (if (eq (if (numberp limit)
6948 (list gnus-newsgroup-end) gnus-newsgroup-name limit) 8207 (gnus-retrieve-headers
8208 (list (min
8209 (+ (mail-header-number
8210 (gnus-summary-article-header))
8211 limit)
8212 gnus-newsgroup-end))
8213 gnus-newsgroup-name (* limit 2))
8214 ;; gnus-refer-thread-limit is t, i.e. fetch _all_
8215 ;; headers.
8216 (gnus-retrieve-headers (list gnus-newsgroup-end)
8217 gnus-newsgroup-name limit))
6949 'nov) 8218 'nov)
6950 (gnus-build-all-threads) 8219 (gnus-build-all-threads)
6951 (error "Can't fetch thread from backends that don't support NOV")) 8220 (error "Can't fetch thread from back ends that don't support NOV"))
6952 (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name)) 8221 (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name))
6953 (gnus-summary-limit-include-thread id))) 8222 (gnus-summary-limit-include-thread id)))
6954 8223
6955 (defun gnus-summary-refer-article (message-id) 8224 (defun gnus-summary-refer-article (message-id)
6956 "Fetch an article specified by MESSAGE-ID." 8225 "Fetch an article specified by MESSAGE-ID."
6957 (interactive "sMessage-ID: ") 8226 (interactive "sMessage-ID: ")
6958 (when (and (stringp message-id) 8227 (when (and (stringp message-id)
6959 (not (zerop (length message-id)))) 8228 (not (zerop (length message-id))))
8229 (setq message-id (gnus-replace-in-string message-id " " ""))
6960 ;; Construct the correct Message-ID if necessary. 8230 ;; Construct the correct Message-ID if necessary.
6961 ;; Suggested by tale@pawl.rpi.edu. 8231 ;; Suggested by tale@pawl.rpi.edu.
6962 (unless (string-match "^<" message-id) 8232 (unless (string-match "^<" message-id)
6963 (setq message-id (concat "<" message-id))) 8233 (setq message-id (concat "<" message-id)))
6964 (unless (string-match ">$" message-id) 8234 (unless (string-match ">$" message-id)
6965 (setq message-id (concat message-id ">"))) 8235 (setq message-id (concat message-id ">")))
8236 ;; People often post MIDs from URLs, so unhex it:
8237 (unless (string-match "@" message-id)
8238 (setq message-id (gnus-url-unhex-string message-id)))
6966 (let* ((header (gnus-id-to-header message-id)) 8239 (let* ((header (gnus-id-to-header message-id))
6967 (sparse (and header 8240 (sparse (and header
6968 (gnus-summary-article-sparse-p 8241 (gnus-summary-article-sparse-p
6969 (mail-header-number header)) 8242 (mail-header-number header))
6970 (memq (mail-header-number header) 8243 (memq (mail-header-number header)
6983 (gnus-summary-update-article (mail-header-number header))))) 8256 (gnus-summary-update-article (mail-header-number header)))))
6984 (t 8257 (t
6985 ;; We fetch the article. 8258 ;; We fetch the article.
6986 (catch 'found 8259 (catch 'found
6987 (dolist (gnus-override-method (gnus-refer-article-methods)) 8260 (dolist (gnus-override-method (gnus-refer-article-methods))
6988 (gnus-check-server gnus-override-method) 8261 (when (and (gnus-check-server gnus-override-method)
6989 ;; Fetch the header, and display the article. 8262 ;; Fetch the header,
6990 (when (setq number (gnus-summary-insert-subject message-id)) 8263 (setq number (gnus-summary-insert-subject message-id)))
8264 ;; and display the article.
6991 (gnus-summary-select-article nil nil nil number) 8265 (gnus-summary-select-article nil nil nil number)
6992 (throw 'found t))) 8266 (throw 'found t)))
6993 (gnus-message 3 "Couldn't fetch article %s" message-id))))))) 8267 (gnus-message 3 "Couldn't fetch article %s" message-id)))))))
6994 8268
6995 (defun gnus-refer-article-methods () 8269 (defun gnus-refer-article-methods ()
7029 "Enter an nndoc group based on the current article. 8303 "Enter an nndoc group based on the current article.
7030 If FORCE, force a digest interpretation. If not, try 8304 If FORCE, force a digest interpretation. If not, try
7031 to guess what the document format is." 8305 to guess what the document format is."
7032 (interactive "P") 8306 (interactive "P")
7033 (let ((conf gnus-current-window-configuration)) 8307 (let ((conf gnus-current-window-configuration))
7034 (save-excursion 8308 (save-window-excursion
7035 (gnus-summary-select-article)) 8309 (save-excursion
8310 (let (gnus-article-prepare-hook
8311 gnus-display-mime-function
8312 gnus-break-pages)
8313 (gnus-summary-select-article))))
7036 (setq gnus-current-window-configuration conf) 8314 (setq gnus-current-window-configuration conf)
7037 (let* ((name (format "%s-%d" 8315 (let* ((name (format "%s-%d"
7038 (gnus-group-prefixed-name 8316 (gnus-group-prefixed-name
7039 gnus-newsgroup-name (list 'nndoc "")) 8317 gnus-newsgroup-name (list 'nndoc ""))
7040 (save-excursion 8318 (save-excursion
7041 (set-buffer gnus-summary-buffer) 8319 (set-buffer gnus-summary-buffer)
7042 gnus-current-article))) 8320 gnus-current-article)))
7043 (ogroup gnus-newsgroup-name) 8321 (ogroup gnus-newsgroup-name)
7044 (params (append (gnus-info-params (gnus-get-info ogroup)) 8322 (params (append (gnus-info-params (gnus-get-info ogroup))
7045 (list (cons 'to-group ogroup)) 8323 (list (cons 'to-group ogroup))
8324 (list (cons 'parent-group ogroup))
7046 (list (cons 'save-article-group ogroup)))) 8325 (list (cons 'save-article-group ogroup))))
7047 (case-fold-search t) 8326 (case-fold-search t)
7048 (buf (current-buffer)) 8327 (buf (current-buffer))
7049 dig to-address) 8328 dig to-address)
7050 (save-excursion 8329 (save-excursion
7051 (set-buffer gnus-original-article-buffer) 8330 (set-buffer gnus-original-article-buffer)
7052 ;; Have the digest group inherit the main mail address of 8331 ;; Have the digest group inherit the main mail address of
7053 ;; the parent article. 8332 ;; the parent article.
7054 (when (setq to-address (or (message-fetch-field "reply-to") 8333 (when (setq to-address (or (gnus-fetch-field "reply-to")
7055 (message-fetch-field "from"))) 8334 (gnus-fetch-field "from")))
7056 (setq params (append 8335 (setq params (append
7057 (list (cons 'to-address 8336 (list (cons 'to-address
7058 (funcall gnus-decode-encoded-word-function 8337 (funcall gnus-decode-encoded-word-function
7059 to-address)))))) 8338 to-address))))))
7060 (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*")) 8339 (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*"))
7066 (or (search-forward "\n\n" nil t) (point))) 8345 (or (search-forward "\n\n" nil t) (point)))
7067 (goto-char (point-min)) 8346 (goto-char (point-min))
7068 (delete-matching-lines "^Path:\\|^From ") 8347 (delete-matching-lines "^Path:\\|^From ")
7069 (widen)) 8348 (widen))
7070 (unwind-protect 8349 (unwind-protect
7071 (if (let ((gnus-newsgroup-ephemeral-charset gnus-newsgroup-charset) 8350 (if (let ((gnus-newsgroup-ephemeral-charset gnus-newsgroup-charset)
7072 (gnus-newsgroup-ephemeral-ignored-charsets 8351 (gnus-newsgroup-ephemeral-ignored-charsets
7073 gnus-newsgroup-ignored-charsets)) 8352 gnus-newsgroup-ignored-charsets))
7074 (gnus-group-read-ephemeral-group 8353 (gnus-group-read-ephemeral-group
7075 name `(nndoc ,name (nndoc-address ,(get-buffer dig)) 8354 name `(nndoc ,name (nndoc-address ,(get-buffer dig))
7076 (nndoc-article-type 8355 (nndoc-article-type
7077 ,(if force 'mbox 'guess))) t)) 8356 ,(if force 'mbox 'guess)))
8357 t nil nil nil
8358 `((adapt-file . ,(gnus-score-file-name gnus-newsgroup-name
8359 "ADAPT")))))
7078 ;; Make all postings to this group go to the parent group. 8360 ;; Make all postings to this group go to the parent group.
7079 (nconc (gnus-info-params (gnus-get-info name)) 8361 (nconc (gnus-info-params (gnus-get-info name))
7080 params) 8362 params)
7081 ;; Couldn't select this doc group. 8363 ;; Couldn't select this doc group.
7082 (switch-to-buffer buf) 8364 (switch-to-buffer buf)
7083 (gnus-set-global-variables) 8365 (gnus-set-global-variables)
7084 (gnus-configure-windows 'summary) 8366 (gnus-configure-windows 'summary)
7085 (gnus-message 3 "Article couldn't be entered?")) 8367 (gnus-message 3 "Article couldn't be entered?"))
7086 (kill-buffer dig))))) 8368 (kill-buffer dig)))))
7087 8369
7088 (defun gnus-summary-read-document (n) 8370 (defun gnus-summary-read-document (n)
7089 "Open a new group based on the current article(s). 8371 "Open a new group based on the current article(s).
7090 This will allow you to read digests and other similar 8372 This will allow you to read digests and other similar
7113 (gnus-group-read-ephemeral-group 8395 (gnus-group-read-ephemeral-group
7114 group `(nndoc ,group (nndoc-address ,(current-buffer)) 8396 group `(nndoc ,group (nndoc-address ,(current-buffer))
7115 (nndoc-article-type guess)) 8397 (nndoc-article-type guess))
7116 t nil t)) 8398 t nil t))
7117 (progn 8399 (progn
7118 ;; Make all postings to this group go to the parent group. 8400 ;; Make all postings to this group go to the parent group.
7119 (nconc (gnus-info-params (gnus-get-info egroup)) 8401 (nconc (gnus-info-params (gnus-get-info egroup))
7120 params) 8402 params)
7121 (push egroup groups)) 8403 (push egroup groups))
7122 ;; Couldn't select this doc group. 8404 ;; Couldn't select this doc group.
7123 (gnus-error 3 "Article couldn't be entered")))))) 8405 (gnus-error 3 "Article couldn't be entered"))))))
7157 (concat ", default " gnus-last-search-regexp) 8439 (concat ", default " gnus-last-search-regexp)
7158 ""))) 8440 "")))
7159 current-prefix-arg)) 8441 current-prefix-arg))
7160 (if (string-equal regexp "") 8442 (if (string-equal regexp "")
7161 (setq regexp (or gnus-last-search-regexp "")) 8443 (setq regexp (or gnus-last-search-regexp ""))
7162 (setq gnus-last-search-regexp regexp)) 8444 (setq gnus-last-search-regexp regexp)
7163 (if (gnus-summary-search-article regexp backward) 8445 (setq gnus-article-before-search gnus-current-article))
7164 (gnus-summary-show-thread) 8446 ;; Intentionally set gnus-last-article.
7165 (error "Search failed: \"%s\"" regexp))) 8447 (setq gnus-last-article gnus-article-before-search)
8448 (let ((gnus-last-article gnus-last-article))
8449 (if (gnus-summary-search-article regexp backward)
8450 (gnus-summary-show-thread)
8451 (signal 'search-failed (list regexp)))))
7166 8452
7167 (defun gnus-summary-search-article-backward (regexp) 8453 (defun gnus-summary-search-article-backward (regexp)
7168 "Search for an article containing REGEXP backward." 8454 "Search for an article containing REGEXP backward."
7169 (interactive 8455 (interactive
7170 (list (read-string 8456 (list (read-string
7186 (gnus-article-prepare-hook nil) 8472 (gnus-article-prepare-hook nil)
7187 (gnus-mark-article-hook nil) ;Inhibit marking as read. 8473 (gnus-mark-article-hook nil) ;Inhibit marking as read.
7188 (gnus-use-article-prefetch nil) 8474 (gnus-use-article-prefetch nil)
7189 (gnus-xmas-force-redisplay nil) ;Inhibit XEmacs redisplay. 8475 (gnus-xmas-force-redisplay nil) ;Inhibit XEmacs redisplay.
7190 (gnus-use-trees nil) ;Inhibit updating tree buffer. 8476 (gnus-use-trees nil) ;Inhibit updating tree buffer.
8477 (gnus-visual nil)
8478 (gnus-keep-backlog nil)
8479 (gnus-break-pages nil)
8480 (gnus-summary-display-arrow nil)
8481 (gnus-updated-mode-lines nil)
8482 (gnus-auto-center-summary nil)
7191 (sum (current-buffer)) 8483 (sum (current-buffer))
7192 (gnus-display-mime-function nil) 8484 (gnus-display-mime-function nil)
7193 (found nil) 8485 (found nil)
7194 point) 8486 point)
7195 (gnus-save-hidden-threads 8487 (gnus-save-hidden-threads
7239 (gnus-summary-show-thread) 8531 (gnus-summary-show-thread)
7240 (gnus-summary-goto-subject gnus-current-article) 8532 (gnus-summary-goto-subject gnus-current-article)
7241 (gnus-summary-position-point) 8533 (gnus-summary-position-point)
7242 t))) 8534 t)))
7243 8535
8536 (defun gnus-find-matching-articles (header regexp)
8537 "Return a list of all articles that match REGEXP on HEADER.
8538 This search includes all articles in the current group that Gnus has
8539 fetched headers for, whether they are displayed or not."
8540 (let ((articles nil)
8541 (func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))
8542 (case-fold-search t))
8543 (dolist (header gnus-newsgroup-headers)
8544 (when (string-match regexp (funcall func header))
8545 (push (mail-header-number header) articles)))
8546 (nreverse articles)))
8547
7244 (defun gnus-summary-find-matching (header regexp &optional backward unread 8548 (defun gnus-summary-find-matching (header regexp &optional backward unread
7245 not-case-fold not-matching) 8549 not-case-fold not-matching)
7246 "Return a list of all articles that match REGEXP on HEADER. 8550 "Return a list of all articles that match REGEXP on HEADER.
7247 The search stars on the current article and goes forwards unless 8551 The search stars on the current article and goes forwards unless
7248 BACKWARD is non-nil. If BACKWARD is `all', do all articles. 8552 BACKWARD is non-nil. If BACKWARD is `all', do all articles.
7285 article. If BACKWARD (the prefix) is non-nil, search backward instead." 8589 article. If BACKWARD (the prefix) is non-nil, search backward instead."
7286 (interactive 8590 (interactive
7287 (list (let ((completion-ignore-case t)) 8591 (list (let ((completion-ignore-case t))
7288 (completing-read 8592 (completing-read
7289 "Header name: " 8593 "Header name: "
7290 (mapcar (lambda (string) (list string)) 8594 (mapcar (lambda (header) (list (format "%s" header)))
7291 '("Number" "Subject" "From" "Lines" "Date" 8595 (append
7292 "Message-ID" "Xref" "References" "Body")) 8596 '("Number" "Subject" "From" "Lines" "Date"
8597 "Message-ID" "Xref" "References" "Body")
8598 gnus-extra-headers))
7293 nil 'require-match)) 8599 nil 'require-match))
7294 (read-string "Regexp: ") 8600 (read-string "Regexp: ")
7295 (read-key-sequence "Command: ") 8601 (read-key-sequence "Command: ")
7296 current-prefix-arg)) 8602 current-prefix-arg))
7297 (when (equal header "Body") 8603 (when (equal header "Body")
7299 ;; Hidden thread subtrees must be searched as well. 8605 ;; Hidden thread subtrees must be searched as well.
7300 (gnus-summary-show-all-threads) 8606 (gnus-summary-show-all-threads)
7301 ;; We don't want to change current point nor window configuration. 8607 ;; We don't want to change current point nor window configuration.
7302 (save-excursion 8608 (save-excursion
7303 (save-window-excursion 8609 (save-window-excursion
7304 (gnus-message 6 "Executing %s..." (key-description command)) 8610 (let (gnus-visual
7305 ;; We'd like to execute COMMAND interactively so as to give arguments. 8611 gnus-treat-strip-trailing-blank-lines
7306 (gnus-execute header regexp 8612 gnus-treat-strip-leading-blank-lines
7307 `(call-interactively ',(key-binding command)) 8613 gnus-treat-strip-multiple-blank-lines
7308 backward) 8614 gnus-treat-hide-boring-headers
7309 (gnus-message 6 "Executing %s...done" (key-description command))))) 8615 gnus-treat-fold-newsgroups
8616 gnus-article-prepare-hook)
8617 (gnus-message 6 "Executing %s..." (key-description command))
8618 ;; We'd like to execute COMMAND interactively so as to give arguments.
8619 (gnus-execute header regexp
8620 `(call-interactively ',(key-binding command))
8621 backward)
8622 (gnus-message 6 "Executing %s...done" (key-description command))))))
7310 8623
7311 (defun gnus-summary-beginning-of-article () 8624 (defun gnus-summary-beginning-of-article ()
7312 "Scroll the article back to the beginning." 8625 "Scroll the article back to the beginning."
7313 (interactive) 8626 (interactive)
7314 (gnus-summary-select-article) 8627 (gnus-summary-select-article)
7315 (gnus-configure-windows 'article) 8628 (gnus-configure-windows 'article)
7316 (gnus-eval-in-buffer-window gnus-article-buffer 8629 (gnus-eval-in-buffer-window gnus-article-buffer
7317 (widen) 8630 (widen)
7318 (goto-char (point-min)) 8631 (goto-char (point-min))
7319 (when gnus-page-broken 8632 (when gnus-break-pages
7320 (gnus-narrow-to-page)))) 8633 (gnus-narrow-to-page))))
7321 8634
7322 (defun gnus-summary-end-of-article () 8635 (defun gnus-summary-end-of-article ()
7323 "Scroll to the end of the article." 8636 "Scroll to the end of the article."
7324 (interactive) 8637 (interactive)
7326 (gnus-configure-windows 'article) 8639 (gnus-configure-windows 'article)
7327 (gnus-eval-in-buffer-window gnus-article-buffer 8640 (gnus-eval-in-buffer-window gnus-article-buffer
7328 (widen) 8641 (widen)
7329 (goto-char (point-max)) 8642 (goto-char (point-max))
7330 (recenter -3) 8643 (recenter -3)
7331 (when gnus-page-broken 8644 (when gnus-break-pages
8645 (when (re-search-backward page-delimiter nil t)
8646 (narrow-to-region (match-end 0) (point-max)))
7332 (gnus-narrow-to-page)))) 8647 (gnus-narrow-to-page))))
7333 8648
8649 (defun gnus-summary-print-truncate-and-quote (string &optional len)
8650 "Truncate to LEN and quote all \"(\"'s in STRING."
8651 (gnus-replace-in-string (if (and len (> (length string) len))
8652 (substring string 0 len)
8653 string)
8654 "[()]" "\\\\\\&"))
8655
7334 (defun gnus-summary-print-article (&optional filename n) 8656 (defun gnus-summary-print-article (&optional filename n)
7335 "Generate and print a PostScript image of the N next (mail) articles. 8657 "Generate and print a PostScript image of the process-marked (mail) articles.
7336 8658
7337 If N is negative, print the N previous articles. If N is nil and articles 8659 If used interactively, print the current article if none are
7338 have been marked with the process mark, print these instead. 8660 process-marked. With prefix arg, prompt the user for the name of the
8661 file to save in.
8662
8663 When used from Lisp, accept two optional args FILENAME and N. N means
8664 to print the next N articles. If N is negative, print the N previous
8665 articles. If N is nil and articles have been marked with the process
8666 mark, print these instead.
7339 8667
7340 If the optional first argument FILENAME is nil, send the image to the 8668 If the optional first argument FILENAME is nil, send the image to the
7341 printer. If FILENAME is a string, save the PostScript image in a file with 8669 printer. If FILENAME is a string, save the PostScript image in a file with
7342 that name. If FILENAME is a number, prompt the user for the name of the file 8670 that name. If FILENAME is a number, prompt the user for the name of the file
7343 to save in." 8671 to save in."
7344 (interactive (list (ps-print-preprint current-prefix-arg))) 8672 (interactive (list (ps-print-preprint current-prefix-arg)))
7345 (dolist (article (gnus-summary-work-articles n)) 8673 (dolist (article (gnus-summary-work-articles n))
7346 (gnus-summary-select-article nil nil 'pseudo article) 8674 (gnus-summary-select-article nil nil 'pseudo article)
7347 (gnus-eval-in-buffer-window gnus-article-buffer 8675 (gnus-eval-in-buffer-window gnus-article-buffer
7348 (let ((buffer (generate-new-buffer " *print*"))) 8676 (gnus-print-buffer))
7349 (unwind-protect
7350 (progn
7351 (copy-to-buffer buffer (point-min) (point-max))
7352 (set-buffer buffer)
7353 (gnus-article-delete-invisible-text)
7354 (let ((ps-left-header
7355 (list
7356 (concat "("
7357 (mail-header-subject gnus-current-headers) ")")
7358 (concat "("
7359 (mail-header-from gnus-current-headers) ")")))
7360 (ps-right-header
7361 (list
7362 "/pagenumberstring load"
7363 (concat "("
7364 (mail-header-date gnus-current-headers) ")"))))
7365 (gnus-run-hooks 'gnus-ps-print-hook)
7366 (save-excursion
7367 (ps-spool-buffer-with-faces))))
7368 (kill-buffer buffer))))
7369 (gnus-summary-remove-process-mark article)) 8677 (gnus-summary-remove-process-mark article))
7370 (ps-despool filename)) 8678 (ps-despool filename))
7371 8679
8680 (defun gnus-print-buffer ()
8681 (let ((buffer (generate-new-buffer " *print*")))
8682 (unwind-protect
8683 (progn
8684 (copy-to-buffer buffer (point-min) (point-max))
8685 (set-buffer buffer)
8686 (gnus-remove-text-with-property 'gnus-decoration)
8687 (when (gnus-visual-p 'article-highlight 'highlight)
8688 ;; Copy-to-buffer doesn't copy overlay. So redo
8689 ;; highlight.
8690 (let ((gnus-article-buffer buffer))
8691 (gnus-article-highlight-citation t)
8692 (gnus-article-highlight-signature)
8693 (gnus-article-emphasize)
8694 (gnus-article-delete-invisible-text)))
8695 (let ((ps-left-header
8696 (list
8697 (concat "("
8698 (gnus-summary-print-truncate-and-quote
8699 (mail-header-subject gnus-current-headers)
8700 66) ")")
8701 (concat "("
8702 (gnus-summary-print-truncate-and-quote
8703 (mail-header-from gnus-current-headers)
8704 45) ")")))
8705 (ps-right-header
8706 (list
8707 "/pagenumberstring load"
8708 (concat "("
8709 (mail-header-date gnus-current-headers) ")"))))
8710 (gnus-run-hooks 'gnus-ps-print-hook)
8711 (save-excursion
8712 (if window-system
8713 (ps-spool-buffer-with-faces)
8714 (ps-spool-buffer)))))
8715 (kill-buffer buffer))))
8716
7372 (defun gnus-summary-show-article (&optional arg) 8717 (defun gnus-summary-show-article (&optional arg)
7373 "Force re-fetching of the current article. 8718 "Force redisplaying of the current article.
7374 If ARG (the prefix) is a number, show the article with the charset 8719 If ARG (the prefix) is a number, show the article with the charset
7375 defined in `gnus-summary-show-article-charset-alist', or the charset 8720 defined in `gnus-summary-show-article-charset-alist', or the charset
7376 inputed. 8721 input.
7377 If ARG (the prefix) is non-nil and not a number, show the raw article 8722 If ARG (the prefix) is non-nil and not a number, show the raw article
7378 without any article massaging functions being run." 8723 without any article massaging functions being run. Normally, the key
8724 strokes are `C-u g'."
7379 (interactive "P") 8725 (interactive "P")
7380 (cond 8726 (cond
7381 ((numberp arg) 8727 ((numberp arg)
8728 (gnus-summary-show-article t)
7382 (let ((gnus-newsgroup-charset 8729 (let ((gnus-newsgroup-charset
7383 (or (cdr (assq arg gnus-summary-show-article-charset-alist)) 8730 (or (cdr (assq arg gnus-summary-show-article-charset-alist))
7384 (read-coding-system "Charset: "))) 8731 (mm-read-coding-system
8732 "View as charset: " ;; actually it is coding system.
8733 (save-excursion
8734 (set-buffer gnus-article-buffer)
8735 (mm-detect-coding-region (point) (point-max))))))
7385 (gnus-newsgroup-ignored-charsets 'gnus-all)) 8736 (gnus-newsgroup-ignored-charsets 'gnus-all))
7386 (gnus-summary-select-article nil 'force))) 8737 (gnus-summary-select-article nil 'force)
8738 (let ((deps gnus-newsgroup-dependencies)
8739 head header lines)
8740 (save-excursion
8741 (set-buffer gnus-original-article-buffer)
8742 (save-restriction
8743 (message-narrow-to-head)
8744 (setq head (buffer-string))
8745 (goto-char (point-min))
8746 (unless (re-search-forward "^lines:[ \t]\\([0-9]+\\)" nil t)
8747 (goto-char (point-max))
8748 (widen)
8749 (setq lines (1- (count-lines (point) (point-max))))))
8750 (with-temp-buffer
8751 (insert (format "211 %d Article retrieved.\n"
8752 (cdr gnus-article-current)))
8753 (insert head)
8754 (if lines (insert (format "Lines: %d\n" lines)))
8755 (insert ".\n")
8756 (let ((nntp-server-buffer (current-buffer)))
8757 (setq header (car (gnus-get-newsgroup-headers deps t))))))
8758 (gnus-data-set-header
8759 (gnus-data-find (cdr gnus-article-current))
8760 header)
8761 (gnus-summary-update-article-line
8762 (cdr gnus-article-current) header)
8763 (when (gnus-summary-goto-subject (cdr gnus-article-current) nil t)
8764 (gnus-summary-update-secondary-mark (cdr gnus-article-current))))))
7387 ((not arg) 8765 ((not arg)
7388 ;; Select the article the normal way. 8766 ;; Select the article the normal way.
7389 (gnus-summary-select-article nil 'force)) 8767 (gnus-summary-select-article nil 'force))
7390 (t 8768 (t
7391 ;; We have to require this here to make sure that the following 8769 ;; We have to require this here to make sure that the following
7408 (setq gnus-article-mime-handles nil))) 8786 (setq gnus-article-mime-handles nil)))
7409 (gnus-summary-select-article nil 'force)))) 8787 (gnus-summary-select-article nil 'force))))
7410 (gnus-summary-goto-subject gnus-current-article) 8788 (gnus-summary-goto-subject gnus-current-article)
7411 (gnus-summary-position-point)) 8789 (gnus-summary-position-point))
7412 8790
8791 (defun gnus-summary-show-raw-article ()
8792 "Show the raw article without any article massaging functions being run."
8793 (interactive)
8794 (gnus-summary-show-article t))
8795
7413 (defun gnus-summary-verbose-headers (&optional arg) 8796 (defun gnus-summary-verbose-headers (&optional arg)
7414 "Toggle permanent full header display. 8797 "Toggle permanent full header display.
7415 If ARG is a positive number, turn header display on. 8798 If ARG is a positive number, turn header display on.
7416 If ARG is a negative number, turn header display off." 8799 If ARG is a negative number, turn header display off."
7417 (interactive "P") 8800 (interactive "P")
7426 (defun gnus-summary-toggle-header (&optional arg) 8809 (defun gnus-summary-toggle-header (&optional arg)
7427 "Show the headers if they are hidden, or hide them if they are shown. 8810 "Show the headers if they are hidden, or hide them if they are shown.
7428 If ARG is a positive number, show the entire header. 8811 If ARG is a positive number, show the entire header.
7429 If ARG is a negative number, hide the unwanted header lines." 8812 If ARG is a negative number, hide the unwanted header lines."
7430 (interactive "P") 8813 (interactive "P")
7431 (save-excursion 8814 (let ((window (and (gnus-buffer-live-p gnus-article-buffer)
7432 (set-buffer gnus-article-buffer) 8815 (get-buffer-window gnus-article-buffer t))))
7433 (save-restriction 8816 (with-current-buffer gnus-article-buffer
8817 (widen)
8818 (article-narrow-to-head)
7434 (let* ((buffer-read-only nil) 8819 (let* ((buffer-read-only nil)
7435 (inhibit-point-motion-hooks t) 8820 (inhibit-point-motion-hooks t)
7436 hidden s e) 8821 (hidden (if (numberp arg)
7437 (setq hidden 8822 (>= arg 0)
7438 (if (numberp arg) 8823 (or (not (looking-at "[^ \t\n]+:"))
7439 (>= arg 0) 8824 (gnus-article-hidden-text-p 'headers))))
7440 (save-restriction 8825 s e)
7441 (article-narrow-to-head) 8826 (delete-region (point-min) (point-max))
7442 (gnus-article-hidden-text-p 'headers))))
7443 (goto-char (point-min))
7444 (when (search-forward "\n\n" nil t)
7445 (delete-region (point-min) (1- (point))))
7446 (goto-char (point-min))
7447 (with-current-buffer gnus-original-article-buffer 8827 (with-current-buffer gnus-original-article-buffer
7448 (goto-char (setq s (point-min))) 8828 (goto-char (setq s (point-min)))
7449 (setq e (1- (or (search-forward "\n\n" nil t) (point-max))))) 8829 (setq e (if (search-forward "\n\n" nil t)
8830 (1- (point))
8831 (point-max))))
7450 (insert-buffer-substring gnus-original-article-buffer s e) 8832 (insert-buffer-substring gnus-original-article-buffer s e)
7451 (save-restriction 8833 (run-hooks 'gnus-article-decode-hook)
7452 (narrow-to-region (point-min) (point)) 8834 (if hidden
7453 (article-decode-encoded-words) 8835 (let ((gnus-treat-hide-headers nil)
7454 (if hidden 8836 (gnus-treat-hide-boring-headers nil))
7455 (let ((gnus-treat-hide-headers nil) 8837 (gnus-delete-wash-type 'headers)
7456 (gnus-treat-hide-boring-headers nil)) 8838 (gnus-treat-article 'head))
7457 (setq gnus-article-wash-types 8839 (gnus-treat-article 'head))
7458 (delq 'headers gnus-article-wash-types)) 8840 (widen)
7459 (gnus-treat-article 'head)) 8841 (if window
7460 (gnus-treat-article 'head))) 8842 (set-window-start window (goto-char (point-min))))
8843 (if gnus-break-pages
8844 (gnus-narrow-to-page)
8845 (when (gnus-visual-p 'page-marker)
8846 (let ((buffer-read-only nil))
8847 (gnus-remove-text-with-property 'gnus-prev)
8848 (gnus-remove-text-with-property 'gnus-next))))
7461 (gnus-set-mode-line 'article))))) 8849 (gnus-set-mode-line 'article)))))
7462 8850
7463 (defun gnus-summary-show-all-headers () 8851 (defun gnus-summary-show-all-headers ()
7464 "Make all header lines visible." 8852 "Make all header lines visible."
7465 (interactive) 8853 (interactive)
7466 (gnus-article-show-all-headers)) 8854 (gnus-summary-toggle-header 1))
7467 8855
7468 (defun gnus-summary-caesar-message (&optional arg) 8856 (defun gnus-summary-caesar-message (&optional arg)
7469 "Caesar rotate the current article by 13. 8857 "Caesar rotate the current article by 13.
7470 The numerical prefix specifies how many places to rotate each letter 8858 The numerical prefix specifies how many places to rotate each letter
7471 forward." 8859 forward."
7476 (save-restriction 8864 (save-restriction
7477 (widen) 8865 (widen)
7478 (let ((start (window-start)) 8866 (let ((start (window-start))
7479 buffer-read-only) 8867 buffer-read-only)
7480 (message-caesar-buffer-body arg) 8868 (message-caesar-buffer-body arg)
7481 (set-window-start (get-buffer-window (current-buffer)) start)))))) 8869 (set-window-start (get-buffer-window (current-buffer)) start)))))
8870 ;; Create buttons and stuff...
8871 (gnus-treat-article nil))
8872
8873 (autoload 'unmorse-region "morse"
8874 "Convert morse coded text in region to ordinary ASCII text."
8875 t)
8876
8877 (defun gnus-summary-morse-message (&optional arg)
8878 "Morse decode the current article."
8879 (interactive "P")
8880 (gnus-summary-select-article)
8881 (let ((mail-header-separator ""))
8882 (gnus-eval-in-buffer-window gnus-article-buffer
8883 (save-excursion
8884 (save-restriction
8885 (widen)
8886 (let ((pos (window-start))
8887 buffer-read-only)
8888 (goto-char (point-min))
8889 (when (message-goto-body)
8890 (gnus-narrow-to-body))
8891 (goto-char (point-min))
8892 (while (re-search-forward "·" (point-max) t)
8893 (replace-match "."))
8894 (unmorse-region (point-min) (point-max))
8895 (widen)
8896 (set-window-start (get-buffer-window (current-buffer)) pos)))))))
7482 8897
7483 (defun gnus-summary-stop-page-breaking () 8898 (defun gnus-summary-stop-page-breaking ()
7484 "Stop page breaking in the current article." 8899 "Stop page breaking in the current article."
7485 (interactive) 8900 (interactive)
7486 (gnus-summary-select-article) 8901 (gnus-summary-select-article)
7501 move those articles instead. 8916 move those articles instead.
7502 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. 8917 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to.
7503 If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but 8918 If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but
7504 re-spool using this method. 8919 re-spool using this method.
7505 8920
8921 When called interactively with TO-NEWSGROUP being nil, the value of
8922 the variable `gnus-move-split-methods' is used for finding a default
8923 for the target newsgroup.
8924
7506 For this function to work, both the current newsgroup and the 8925 For this function to work, both the current newsgroup and the
7507 newsgroup that you want to move to have to support the `request-move' 8926 newsgroup that you want to move to have to support the `request-move'
7508 and `request-accept' functions. 8927 and `request-accept' functions.
7509 8928
7510 ACTION can be either `move' (the default), `crosspost' or `copy'." 8929 ACTION can be either `move' (the default), `crosspost' or `copy'."
7511 (interactive "P") 8930 (interactive "P")
7512 (unless action 8931 (unless action
7513 (setq action 'move)) 8932 (setq action 'move))
7514 ;; Disable marking as read.
7515 (let (gnus-mark-article-hook)
7516 (save-window-excursion
7517 (gnus-summary-select-article)))
7518 ;; Check whether the source group supports the required functions. 8933 ;; Check whether the source group supports the required functions.
7519 (cond ((and (eq action 'move) 8934 (cond ((and (eq action 'move)
7520 (not (gnus-check-backend-function 8935 (not (gnus-check-backend-function
7521 'request-move-article gnus-newsgroup-name))) 8936 'request-move-article gnus-newsgroup-name)))
7522 (error "The current group does not support article moving")) 8937 (error "The current group does not support article moving"))
7524 (not (gnus-check-backend-function 8939 (not (gnus-check-backend-function
7525 'request-replace-article gnus-newsgroup-name))) 8940 'request-replace-article gnus-newsgroup-name)))
7526 (error "The current group does not support article editing"))) 8941 (error "The current group does not support article editing")))
7527 (let ((articles (gnus-summary-work-articles n)) 8942 (let ((articles (gnus-summary-work-articles n))
7528 (prefix (if (gnus-check-backend-function 8943 (prefix (if (gnus-check-backend-function
7529 'request-move-article gnus-newsgroup-name) 8944 'request-move-article gnus-newsgroup-name)
7530 (gnus-group-real-prefix gnus-newsgroup-name) 8945 (gnus-group-real-prefix gnus-newsgroup-name)
7531 "")) 8946 ""))
7532 (names '((move "Move" "Moving") 8947 (names '((move "Move" "Moving")
7533 (copy "Copy" "Copying") 8948 (copy "Copy" "Copying")
7534 (crosspost "Crosspost" "Crossposting"))) 8949 (crosspost "Crosspost" "Crossposting")))
7538 (unless (assq action names) 8953 (unless (assq action names)
7539 (error "Unknown action %s" action)) 8954 (error "Unknown action %s" action))
7540 ;; Read the newsgroup name. 8955 ;; Read the newsgroup name.
7541 (when (and (not to-newsgroup) 8956 (when (and (not to-newsgroup)
7542 (not select-method)) 8957 (not select-method))
8958 (if (and gnus-move-split-methods
8959 (not
8960 (and (memq gnus-current-article articles)
8961 (gnus-buffer-live-p gnus-original-article-buffer))))
8962 ;; When `gnus-move-split-methods' is non-nil, we have to
8963 ;; select an article to give `gnus-read-move-group-name' an
8964 ;; opportunity to suggest an appropriate default. However,
8965 ;; we needn't render or mark the article.
8966 (let ((gnus-display-mime-function nil)
8967 (gnus-article-prepare-hook nil)
8968 (gnus-mark-article-hook nil))
8969 (gnus-summary-select-article nil nil nil (car articles))))
7543 (setq to-newsgroup 8970 (setq to-newsgroup
7544 (gnus-read-move-group-name 8971 (gnus-read-move-group-name
7545 (cadr (assq action names)) 8972 (cadr (assq action names))
7546 (symbol-value (intern (format "gnus-current-%s-group" action))) 8973 (symbol-value (intern (format "gnus-current-%s-group" action)))
7547 articles prefix)) 8974 articles prefix))
7587 ((eq action 'crosspost) 9014 ((eq action 'crosspost)
7588 (let ((xref (message-tokenize-header 9015 (let ((xref (message-tokenize-header
7589 (mail-header-xref (gnus-summary-article-header article)) 9016 (mail-header-xref (gnus-summary-article-header article))
7590 " "))) 9017 " ")))
7591 (setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name) 9018 (setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name)
7592 ":" article)) 9019 ":" (number-to-string article)))
7593 (unless xref 9020 (unless xref
7594 (setq xref (list (system-name)))) 9021 (setq xref (list (system-name))))
7595 (setq new-xref 9022 (setq new-xref
7596 (concat 9023 (concat
7597 (mapconcat 'identity 9024 (mapconcat 'identity
7604 (gnus-request-article-this-buffer article gnus-newsgroup-name) 9031 (gnus-request-article-this-buffer article gnus-newsgroup-name)
7605 (when (consp (setq art-group 9032 (when (consp (setq art-group
7606 (gnus-request-accept-article 9033 (gnus-request-accept-article
7607 to-newsgroup select-method (not articles)))) 9034 to-newsgroup select-method (not articles))))
7608 (setq new-xref (concat new-xref " " (car art-group) 9035 (setq new-xref (concat new-xref " " (car art-group)
7609 ":" (cdr art-group))) 9036 ":"
9037 (number-to-string (cdr art-group))))
7610 ;; Now we have the new Xrefs header, so we insert 9038 ;; Now we have the new Xrefs header, so we insert
7611 ;; it and replace the new article. 9039 ;; it and replace the new article.
7612 (nnheader-replace-header "Xref" new-xref) 9040 (nnheader-replace-header "Xref" new-xref)
7613 (gnus-request-replace-article 9041 (gnus-request-replace-article
7614 (cdr art-group) to-newsgroup (current-buffer)) 9042 (cdr art-group) to-newsgroup (current-buffer))
7619 (cadr (assq action names)) article 9047 (cadr (assq action names)) article
7620 (nnheader-get-report (car to-method)))) 9048 (nnheader-get-report (car to-method))))
7621 ((eq art-group 'junk) 9049 ((eq art-group 'junk)
7622 (when (eq action 'move) 9050 (when (eq action 'move)
7623 (gnus-summary-mark-article article gnus-canceled-mark) 9051 (gnus-summary-mark-article article gnus-canceled-mark)
7624 (gnus-message 4 "Deleted article %s" article))) 9052 (gnus-message 4 "Deleted article %s" article)
9053 ;; run the delete hook
9054 (run-hook-with-args 'gnus-summary-article-delete-hook
9055 action
9056 (gnus-data-header
9057 (assoc article (gnus-data-list nil)))
9058 gnus-newsgroup-name nil
9059 select-method)))
7625 (t 9060 (t
7626 (let* ((pto-group (gnus-group-prefixed-name 9061 (let* ((pto-group (gnus-group-prefixed-name
7627 (car art-group) to-method)) 9062 (car art-group) to-method))
7628 (entry 9063 (entry
7629 (gnus-gethash pto-group gnus-newsrc-hashtb)) 9064 (gnus-gethash pto-group gnus-newsrc-hashtb))
7630 (info (nth 2 entry)) 9065 (info (nth 2 entry))
7631 (to-group (gnus-info-group info)) 9066 (to-group (gnus-info-group info))
7632 to-marks) 9067 to-marks)
7633 ;; Update the group that has been moved to. 9068 ;; Update the group that has been moved to.
7634 (when (and info 9069 (when (and info
7635 (memq action '(move copy))) 9070 (memq action '(move copy)))
7636 (unless (member to-group to-groups) 9071 (unless (member to-group to-groups)
7641 (gnus-info-set-read 9076 (gnus-info-set-read
7642 info (gnus-add-to-range (gnus-info-read info) 9077 info (gnus-add-to-range (gnus-info-read info)
7643 (list (cdr art-group))))) 9078 (list (cdr art-group)))))
7644 9079
7645 ;; See whether the article is to be put in the cache. 9080 ;; See whether the article is to be put in the cache.
7646 (let ((marks gnus-article-mark-lists) 9081 (let ((marks (if (gnus-group-auto-expirable-p to-group)
9082 gnus-article-mark-lists
9083 (delete '(expirable . expire)
9084 (copy-sequence gnus-article-mark-lists))))
7647 (to-article (cdr art-group))) 9085 (to-article (cdr art-group)))
7648 9086
7649 ;; Enter the article into the cache in the new group, 9087 ;; Enter the article into the cache in the new group,
7650 ;; if that is required. 9088 ;; if that is required.
7651 (when gnus-use-cache 9089 (when gnus-use-cache
7663 (push (cons to-article gnus-read-mark) gnus-newsgroup-reads) 9101 (push (cons to-article gnus-read-mark) gnus-newsgroup-reads)
7664 (setcdr (gnus-active to-group) to-article) 9102 (setcdr (gnus-active to-group) to-article)
7665 (setcdr gnus-newsgroup-active to-article)) 9103 (setcdr gnus-newsgroup-active to-article))
7666 9104
7667 (while marks 9105 (while marks
7668 (when (memq article (symbol-value 9106 (when (eq (gnus-article-mark-to-type (cdar marks)) 'list)
7669 (intern (format "gnus-newsgroup-%s" 9107 (when (memq article (symbol-value
7670 (caar marks))))) 9108 (intern (format "gnus-newsgroup-%s"
7671 (push (cdar marks) to-marks) 9109 (caar marks)))))
7672 ;; If the other group is the same as this group, 9110 (push (cdar marks) to-marks)
7673 ;; then we have to add the mark to the list. 9111 ;; If the other group is the same as this group,
7674 (when (equal to-group gnus-newsgroup-name) 9112 ;; then we have to add the mark to the list.
7675 (set (intern (format "gnus-newsgroup-%s" (caar marks))) 9113 (when (equal to-group gnus-newsgroup-name)
7676 (cons to-article 9114 (set (intern (format "gnus-newsgroup-%s" (caar marks)))
7677 (symbol-value 9115 (cons to-article
7678 (intern (format "gnus-newsgroup-%s" 9116 (symbol-value
7679 (caar marks))))))) 9117 (intern (format "gnus-newsgroup-%s"
7680 ;; Copy the marks to other group. 9118 (caar marks)))))))
7681 (gnus-add-marked-articles 9119 ;; Copy the marks to other group.
7682 to-group (cdar marks) (list to-article) info)) 9120 (gnus-add-marked-articles
9121 to-group (cdar marks) (list to-article) info)))
7683 (setq marks (cdr marks))) 9122 (setq marks (cdr marks)))
7684 9123
7685 (gnus-request-set-mark to-group (list (list (list to-article) 9124 (gnus-request-set-mark
7686 'set 9125 to-group (list (list (list to-article) 'add to-marks))))
7687 to-marks))))
7688 9126
7689 (gnus-dribble-enter 9127 (gnus-dribble-enter
7690 (concat "(gnus-group-set-info '" 9128 (concat "(gnus-group-set-info '"
7691 (gnus-prin1-to-string (gnus-get-info to-group)) 9129 (gnus-prin1-to-string (gnus-get-info to-group))
7692 ")")))) 9130 ")"))))
7697 (save-excursion 9135 (save-excursion
7698 (set-buffer copy-buf) 9136 (set-buffer copy-buf)
7699 (gnus-request-article-this-buffer article gnus-newsgroup-name) 9137 (gnus-request-article-this-buffer article gnus-newsgroup-name)
7700 (nnheader-replace-header "Xref" new-xref) 9138 (nnheader-replace-header "Xref" new-xref)
7701 (gnus-request-replace-article 9139 (gnus-request-replace-article
7702 article gnus-newsgroup-name (current-buffer))))) 9140 article gnus-newsgroup-name (current-buffer))))
9141
9142 ;; run the move/copy/crosspost/respool hook
9143 (run-hook-with-args 'gnus-summary-article-move-hook
9144 action
9145 (gnus-data-header
9146 (assoc article (gnus-data-list nil)))
9147 gnus-newsgroup-name
9148 to-newsgroup
9149 select-method))
7703 9150
7704 ;;;!!!Why is this necessary? 9151 ;;;!!!Why is this necessary?
7705 (set-buffer gnus-summary-buffer) 9152 (set-buffer gnus-summary-buffer)
7706 9153
7707 (gnus-summary-goto-subject article) 9154 (gnus-summary-goto-subject article)
7708 (when (eq action 'move) 9155 (when (eq action 'move)
7709 (gnus-summary-mark-article article gnus-canceled-mark)))) 9156 (gnus-summary-mark-article article gnus-canceled-mark))))
7710 (gnus-summary-remove-process-mark article)) 9157 (gnus-summary-remove-process-mark article))
7711 ;; Re-activate all groups that have been moved to. 9158 ;; Re-activate all groups that have been moved to.
7712 (while to-groups 9159 (save-excursion
7713 (save-excursion 9160 (set-buffer gnus-group-buffer)
7714 (set-buffer gnus-group-buffer) 9161 (let ((gnus-group-marked to-groups))
7715 (when (gnus-group-goto-group (car to-groups) t) 9162 (gnus-group-get-new-news-this-group nil t)))
7716 (gnus-group-get-new-news-this-group 1 t))
7717 (pop to-groups)))
7718 9163
7719 (gnus-kill-buffer copy-buf) 9164 (gnus-kill-buffer copy-buf)
7720 (gnus-summary-position-point) 9165 (gnus-summary-position-point)
7721 (gnus-set-mode-line 'summary))) 9166 (gnus-set-mode-line 'summary)))
7722 9167
7723 (defun gnus-summary-copy-article (&optional n to-newsgroup select-method) 9168 (defun gnus-summary-copy-article (&optional n to-newsgroup select-method)
7724 "Move the current article to a different newsgroup. 9169 "Copy the current article to some other group.
7725 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. 9170 If TO-NEWSGROUP is string, do not prompt for a newsgroup to copy to.
9171 When called interactively, if TO-NEWSGROUP is nil, use the value of
9172 the variable `gnus-move-split-methods' for finding a default target
9173 newsgroup.
7726 If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but 9174 If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but
7727 re-spool using this method." 9175 re-spool using this method."
7728 (interactive "P") 9176 (interactive "P")
7729 (gnus-summary-move-article n to-newsgroup select-method 'copy)) 9177 (gnus-summary-move-article n to-newsgroup select-method 'copy))
7730 9178
7732 "Crosspost the current article to some other group." 9180 "Crosspost the current article to some other group."
7733 (interactive "P") 9181 (interactive "P")
7734 (gnus-summary-move-article n nil nil 'crosspost)) 9182 (gnus-summary-move-article n nil nil 'crosspost))
7735 9183
7736 (defcustom gnus-summary-respool-default-method nil 9184 (defcustom gnus-summary-respool-default-method nil
7737 "Default method for respooling an article. 9185 "Default method type for respooling an article.
7738 If nil, use to the current newsgroup method." 9186 If nil, use to the current newsgroup method."
7739 :type '(choice (gnus-select-method :value (nnml "")) 9187 :type 'symbol
7740 (const nil))
7741 :group 'gnus-summary-mail) 9188 :group 'gnus-summary-mail)
9189
9190 (defcustom gnus-summary-display-while-building nil
9191 "If non-nil, show and update the summary buffer as it's being built.
9192 If the value is t, update the buffer after every line is inserted. If
9193 the value is an integer (N), update the display every N lines."
9194 :version "22.1"
9195 :group 'gnus-thread
9196 :type '(choice (const :tag "off" nil)
9197 number
9198 (const :tag "frequently" t)))
7742 9199
7743 (defun gnus-summary-respool-article (&optional n method) 9200 (defun gnus-summary-respool-article (&optional n method)
7744 "Respool the current article. 9201 "Respool the current article.
7745 The article will be squeezed through the mail spooling process again, 9202 The article will be squeezed through the mail spooling process again,
7746 which means that it will be put in some mail newsgroup or other 9203 which means that it will be put in some mail newsgroup or other
7760 (methname 9217 (methname
7761 (symbol-name (or gnus-summary-respool-default-method 9218 (symbol-name (or gnus-summary-respool-default-method
7762 (car (gnus-find-method-for-group 9219 (car (gnus-find-method-for-group
7763 gnus-newsgroup-name))))) 9220 gnus-newsgroup-name)))))
7764 (method 9221 (method
7765 (gnus-completing-read 9222 (gnus-completing-read-with-default
7766 methname "What backend do you want to use when respooling?" 9223 methname "Backend to use when respooling"
7767 methods nil t nil 'gnus-mail-method-history)) 9224 methods nil t nil 'gnus-mail-method-history))
7768 ms) 9225 ms)
7769 (cond 9226 (cond
7770 ((zerop (length (setq ms (gnus-servers-using-backend 9227 ((zerop (length (setq ms (gnus-servers-using-backend
7771 (intern method))))) 9228 (intern method)))))
7782 (car (gnus-find-method-for-group gnus-newsgroup-name))) 9239 (car (gnus-find-method-for-group gnus-newsgroup-name)))
7783 (gnus-methods-using 'respool)) 9240 (gnus-methods-using 'respool))
7784 (gnus-summary-move-article n nil method) 9241 (gnus-summary-move-article n nil method)
7785 (gnus-summary-copy-article n nil method))) 9242 (gnus-summary-copy-article n nil method)))
7786 9243
7787 (defun gnus-summary-import-article (file) 9244 (defun gnus-summary-import-article (file &optional edit)
7788 "Import an arbitrary file into a mail newsgroup." 9245 "Import an arbitrary file into a mail newsgroup."
7789 (interactive "fImport file: ") 9246 (interactive "fImport file: \nP")
7790 (let ((group gnus-newsgroup-name) 9247 (let ((group gnus-newsgroup-name)
7791 (now (current-time)) 9248 (now (current-time))
7792 atts lines) 9249 atts lines group-art)
7793 (unless (gnus-check-backend-function 'request-accept-article group) 9250 (unless (gnus-check-backend-function 'request-accept-article group)
7794 (error "%s does not support article importing" group)) 9251 (error "%s does not support article importing" group))
7795 (or (file-readable-p file) 9252 (or (file-readable-p file)
7796 (not (file-regular-p file)) 9253 (not (file-regular-p file))
7797 (error "Can't read %s" file)) 9254 (error "Can't read %s" file))
7798 (save-excursion 9255 (save-excursion
7799 (set-buffer (gnus-get-buffer-create " *import file*")) 9256 (set-buffer (gnus-get-buffer-create " *import file*"))
7800 (erase-buffer) 9257 (erase-buffer)
7801 (nnheader-insert-file-contents file) 9258 (nnheader-insert-file-contents file)
7802 (goto-char (point-min)) 9259 (goto-char (point-min))
7803 (unless (nnheader-article-p) 9260 (if (nnheader-article-p)
7804 ;; This doesn't look like an article, so we fudge some headers. 9261 (save-restriction
9262 (goto-char (point-min))
9263 (search-forward "\n\n" nil t)
9264 (narrow-to-region (point-min) (1- (point)))
9265 (goto-char (point-min))
9266 (unless (re-search-forward "^date:" nil t)
9267 (goto-char (point-max))
9268 (insert "Date: " (message-make-date (nth 5 atts)) "\n")))
9269 ;; This doesn't look like an article, so we fudge some headers.
7805 (setq atts (file-attributes file) 9270 (setq atts (file-attributes file)
7806 lines (count-lines (point-min) (point-max))) 9271 lines (count-lines (point-min) (point-max)))
7807 (insert "From: " (read-string "From: ") "\n" 9272 (insert "From: " (read-string "From: ") "\n"
7808 "Subject: " (read-string "Subject: ") "\n" 9273 "Subject: " (read-string "Subject: ") "\n"
7809 "Date: " (message-make-date (nth 5 atts)) 9274 "Date: " (message-make-date (nth 5 atts)) "\n"
7810 "\n"
7811 "Message-ID: " (message-make-message-id) "\n" 9275 "Message-ID: " (message-make-message-id) "\n"
7812 "Lines: " (int-to-string lines) "\n" 9276 "Lines: " (int-to-string lines) "\n"
7813 "Chars: " (int-to-string (nth 7 atts)) "\n\n")) 9277 "Chars: " (int-to-string (nth 7 atts)) "\n\n"))
7814 (gnus-request-accept-article group nil t) 9278 (setq group-art (gnus-request-accept-article group nil t))
7815 (kill-buffer (current-buffer))))) 9279 (kill-buffer (current-buffer)))
9280 (setq gnus-newsgroup-active (gnus-activate-group group))
9281 (forward-line 1)
9282 (gnus-summary-goto-article (cdr group-art) nil t)
9283 (when edit
9284 (gnus-summary-edit-article))))
9285
9286 (defun gnus-summary-create-article ()
9287 "Create an article in a mail newsgroup."
9288 (interactive)
9289 (let ((group gnus-newsgroup-name)
9290 (now (current-time))
9291 group-art)
9292 (unless (gnus-check-backend-function 'request-accept-article group)
9293 (error "%s does not support article importing" group))
9294 (save-excursion
9295 (set-buffer (gnus-get-buffer-create " *import file*"))
9296 (erase-buffer)
9297 (goto-char (point-min))
9298 ;; This doesn't look like an article, so we fudge some headers.
9299 (insert "From: " (read-string "From: ") "\n"
9300 "Subject: " (read-string "Subject: ") "\n"
9301 "Date: " (message-make-date now) "\n"
9302 "Message-ID: " (message-make-message-id) "\n")
9303 (setq group-art (gnus-request-accept-article group nil t))
9304 (kill-buffer (current-buffer)))
9305 (setq gnus-newsgroup-active (gnus-activate-group group))
9306 (forward-line 1)
9307 (gnus-summary-goto-article (cdr group-art) nil t)
9308 (gnus-summary-edit-article)))
7816 9309
7817 (defun gnus-summary-article-posted-p () 9310 (defun gnus-summary-article-posted-p ()
7818 "Say whether the current (mail) article is available from news as well. 9311 "Say whether the current (mail) article is available from news as well.
7819 This will be the case if the article has both been mailed and posted." 9312 This will be the case if the article has both been mailed and posted."
7820 (interactive) 9313 (interactive)
7828 nil))) 9321 nil)))
7829 9322
7830 (defun gnus-summary-expire-articles (&optional now) 9323 (defun gnus-summary-expire-articles (&optional now)
7831 "Expire all articles that are marked as expirable in the current group." 9324 "Expire all articles that are marked as expirable in the current group."
7832 (interactive) 9325 (interactive)
7833 (when (gnus-check-backend-function 9326 (when (and (not gnus-group-is-exiting-without-update-p)
7834 'request-expire-articles gnus-newsgroup-name) 9327 (gnus-check-backend-function
9328 'request-expire-articles gnus-newsgroup-name))
7835 ;; This backend supports expiry. 9329 ;; This backend supports expiry.
7836 (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name)) 9330 (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name))
7837 (expirable (if total 9331 (expirable (if total
7838 (progn 9332 (progn
7839 ;; We need to update the info for 9333 ;; We need to update the info for
7863 (let ((nnmail-expiry-wait-function nil) 9357 (let ((nnmail-expiry-wait-function nil)
7864 (nnmail-expiry-wait expiry-wait)) 9358 (nnmail-expiry-wait expiry-wait))
7865 (setq es (gnus-request-expire-articles 9359 (setq es (gnus-request-expire-articles
7866 expirable gnus-newsgroup-name))) 9360 expirable gnus-newsgroup-name)))
7867 (setq es (gnus-request-expire-articles 9361 (setq es (gnus-request-expire-articles
7868 expirable gnus-newsgroup-name)))) 9362 expirable gnus-newsgroup-name)))
7869 (unless total 9363 (unless total
7870 (setq gnus-newsgroup-expirable es)) 9364 (setq gnus-newsgroup-expirable es))
7871 ;; We go through the old list of expirable, and mark all 9365 ;; We go through the old list of expirable, and mark all
7872 ;; really expired articles as nonexistent. 9366 ;; really expired articles as nonexistent.
7873 (unless (eq es expirable) ;If nothing was expired, we don't mark. 9367 (unless (eq es expirable) ;If nothing was expired, we don't mark.
7874 (let ((gnus-use-cache nil)) 9368 (let ((gnus-use-cache nil))
7875 (while expirable 9369 (dolist (article expirable)
7876 (unless (memq (car expirable) es) 9370 (when (and (not (memq article es))
7877 (when (gnus-data-find (car expirable)) 9371 (gnus-data-find article))
7878 (gnus-summary-mark-article 9372 (gnus-summary-mark-article article gnus-canceled-mark)
7879 (car expirable) gnus-canceled-mark))) 9373 (run-hook-with-args 'gnus-summary-article-expire-hook
7880 (setq expirable (cdr expirable))))) 9374 'delete
9375 (gnus-data-header
9376 (assoc article (gnus-data-list nil)))
9377 gnus-newsgroup-name
9378 nil
9379 nil))))))
7881 (gnus-message 6 "Expiring articles...done"))))) 9380 (gnus-message 6 "Expiring articles...done")))))
7882 9381
7883 (defun gnus-summary-expire-articles-now () 9382 (defun gnus-summary-expire-articles-now ()
7884 "Expunge all expirable articles in the current group. 9383 "Expunge all expirable articles in the current group.
7885 This means that *all* articles that are marked as expirable will be 9384 This means that *all* articles that are marked as expirable will be
7895 (defun gnus-summary-delete-article (&optional n) 9394 (defun gnus-summary-delete-article (&optional n)
7896 "Delete the N next (mail) articles. 9395 "Delete the N next (mail) articles.
7897 This command actually deletes articles. This is not a marking 9396 This command actually deletes articles. This is not a marking
7898 command. The article will disappear forever from your life, never to 9397 command. The article will disappear forever from your life, never to
7899 return. 9398 return.
9399
7900 If N is negative, delete backwards. 9400 If N is negative, delete backwards.
7901 If N is nil and articles have been marked with the process mark, 9401 If N is nil and articles have been marked with the process mark,
7902 delete these instead." 9402 delete these instead.
9403
9404 If `gnus-novice-user' is non-nil you will be asked for
9405 confirmation before the articles are deleted."
7903 (interactive "P") 9406 (interactive "P")
7904 (unless (gnus-check-backend-function 'request-expire-articles 9407 (unless (gnus-check-backend-function 'request-expire-articles
7905 gnus-newsgroup-name) 9408 gnus-newsgroup-name)
7906 (error "The current newsgroup does not support article deletion")) 9409 (error "The current newsgroup does not support article deletion"))
7907 (unless (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name)) 9410 (unless (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
7908 (error "Couldn't open server")) 9411 (error "Couldn't open server"))
7909 ;; Compute the list of articles to delete. 9412 ;; Compute the list of articles to delete.
7910 (let ((articles (sort (copy-sequence (gnus-summary-work-articles n)) '<)) 9413 (let ((articles (sort (copy-sequence (gnus-summary-work-articles n)) '<))
9414 (nnmail-expiry-target 'delete)
7911 not-deleted) 9415 not-deleted)
7912 (if (and gnus-novice-user 9416 (if (and gnus-novice-user
7913 (not (gnus-yes-or-no-p 9417 (not (gnus-yes-or-no-p
7914 (format "Do you really want to delete %s forever? " 9418 (format "Do you really want to delete %s forever? "
7915 (if (> (length articles) 1) 9419 (if (> (length articles) 1)
7923 (gnus-summary-remove-process-mark (car articles)) 9427 (gnus-summary-remove-process-mark (car articles))
7924 ;; The backend might not have been able to delete the article 9428 ;; The backend might not have been able to delete the article
7925 ;; after all. 9429 ;; after all.
7926 (unless (memq (car articles) not-deleted) 9430 (unless (memq (car articles) not-deleted)
7927 (gnus-summary-mark-article (car articles) gnus-canceled-mark)) 9431 (gnus-summary-mark-article (car articles) gnus-canceled-mark))
9432 (let* ((article (car articles))
9433 (id (mail-header-id (gnus-data-header
9434 (assoc article (gnus-data-list nil))))))
9435 (run-hook-with-args 'gnus-summary-article-delete-hook
9436 'delete id gnus-newsgroup-name nil
9437 nil))
7928 (setq articles (cdr articles))) 9438 (setq articles (cdr articles)))
7929 (when not-deleted 9439 (when not-deleted
7930 (gnus-message 4 "Couldn't delete articles %s" not-deleted))) 9440 (gnus-message 4 "Couldn't delete articles %s" not-deleted)))
7931 (gnus-summary-position-point) 9441 (gnus-summary-position-point)
7932 (gnus-set-mode-line 'summary) 9442 (gnus-set-mode-line 'summary)
7936 "Edit the current article. 9446 "Edit the current article.
7937 This will have permanent effect only in mail groups. 9447 This will have permanent effect only in mail groups.
7938 If ARG is nil, edit the decoded articles. 9448 If ARG is nil, edit the decoded articles.
7939 If ARG is 1, edit the raw articles. 9449 If ARG is 1, edit the raw articles.
7940 If ARG is 2, edit the raw articles even in read-only groups. 9450 If ARG is 2, edit the raw articles even in read-only groups.
9451 If ARG is 3, edit the articles with the current handles.
7941 Otherwise, allow editing of articles even in read-only 9452 Otherwise, allow editing of articles even in read-only
7942 groups." 9453 groups."
7943 (interactive "P") 9454 (interactive "P")
7944 (let (force raw) 9455 (let (force raw current-handles)
7945 (cond 9456 (cond
7946 ((null arg)) 9457 ((null arg))
7947 ((eq arg 1) (setq raw t)) 9458 ((eq arg 1)
7948 ((eq arg 2) (setq raw t 9459 (setq raw t))
7949 force t)) 9460 ((eq arg 2)
7950 (t (setq force t))) 9461 (setq raw t
7951 (if (and raw (not force) (equal gnus-newsgroup-name "nndraft:drafts")) 9462 force t))
7952 (error "Can't edit the raw article in group nndraft:drafts")) 9463 ((eq arg 3)
9464 (setq current-handles
9465 (and (gnus-buffer-live-p gnus-article-buffer)
9466 (with-current-buffer gnus-article-buffer
9467 (prog1
9468 gnus-article-mime-handles
9469 (setq gnus-article-mime-handles nil))))))
9470 (t
9471 (setq force t)))
9472 (when (and raw (not force)
9473 (member gnus-newsgroup-name '("nndraft:delayed"
9474 "nndraft:drafts"
9475 "nndraft:queue")))
9476 (error "Can't edit the raw article in group %s"
9477 gnus-newsgroup-name))
7953 (save-excursion 9478 (save-excursion
7954 (set-buffer gnus-summary-buffer) 9479 (set-buffer gnus-summary-buffer)
7955 (let ((mail-parse-charset gnus-newsgroup-charset) 9480 (let ((mail-parse-charset gnus-newsgroup-charset)
7956 (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)) 9481 (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets))
7957 (gnus-set-global-variables) 9482 (gnus-set-global-variables)
7960 (error "The current newsgroup does not support article editing")) 9485 (error "The current newsgroup does not support article editing"))
7961 (gnus-summary-show-article t) 9486 (gnus-summary-show-article t)
7962 (when (and (not raw) (gnus-buffer-live-p gnus-article-buffer)) 9487 (when (and (not raw) (gnus-buffer-live-p gnus-article-buffer))
7963 (with-current-buffer gnus-article-buffer 9488 (with-current-buffer gnus-article-buffer
7964 (mm-enable-multibyte))) 9489 (mm-enable-multibyte)))
7965 (if (equal gnus-newsgroup-name "nndraft:drafts") 9490 (if (member gnus-newsgroup-name '("nndraft:delayed" "nndraft:drafts"))
7966 (setq raw t)) 9491 (setq raw t))
7967 (gnus-article-edit-article 9492 (gnus-article-edit-article
7968 (if raw 'ignore 9493 (if raw 'ignore
7969 #'(lambda () 9494 `(lambda ()
7970 (let ((mbl mml-buffer-list)) 9495 (let ((mbl mml-buffer-list))
7971 (setq mml-buffer-list nil) 9496 (setq mml-buffer-list nil)
7972 (mime-to-mml) 9497 (let ((rfc2047-quote-decoded-words-containing-tspecials t))
7973 (make-local-hook 'kill-buffer-hook) 9498 (mime-to-mml ,'current-handles))
7974 (let ((mml-buffer-list mml-buffer-list)) 9499 (let ((mbl1 mml-buffer-list))
7975 (setq mml-buffer-list mbl) 9500 (setq mml-buffer-list mbl)
7976 (make-local-variable 'mml-buffer-list)) 9501 (set (make-local-variable 'mml-buffer-list) mbl1))
7977 (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))) 9502 (gnus-make-local-hook 'kill-buffer-hook)
9503 (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))))
7978 `(lambda (no-highlight) 9504 `(lambda (no-highlight)
7979 (let ((mail-parse-charset ',gnus-newsgroup-charset) 9505 (let ((mail-parse-charset ',gnus-newsgroup-charset)
9506 (message-options message-options)
9507 (message-options-set-recipient)
7980 (mail-parse-ignored-charsets 9508 (mail-parse-ignored-charsets
7981 ',gnus-newsgroup-ignored-charsets)) 9509 ',gnus-newsgroup-ignored-charsets))
7982 ,(if (not raw) '(progn 9510 ,(if (not raw) '(progn
7983 (mml-to-mime) 9511 (mml-to-mime)
7984 (mml-destroy-buffers) 9512 (mml-destroy-buffers)
7994 9522
7995 (defun gnus-summary-edit-article-done (&optional references read-only buffer 9523 (defun gnus-summary-edit-article-done (&optional references read-only buffer
7996 no-highlight) 9524 no-highlight)
7997 "Make edits to the current article permanent." 9525 "Make edits to the current article permanent."
7998 (interactive) 9526 (interactive)
9527 (save-excursion
9528 ;; The buffer restriction contains the entire article if it exists.
9529 (when (article-goto-body)
9530 (let ((lines (count-lines (point) (point-max)))
9531 (length (- (point-max) (point)))
9532 (case-fold-search t)
9533 (body (copy-marker (point))))
9534 (goto-char (point-min))
9535 (when (re-search-forward "^content-length:[ \t]\\([0-9]+\\)" body t)
9536 (delete-region (match-beginning 1) (match-end 1))
9537 (insert (number-to-string length)))
9538 (goto-char (point-min))
9539 (when (re-search-forward
9540 "^x-content-length:[ \t]\\([0-9]+\\)" body t)
9541 (delete-region (match-beginning 1) (match-end 1))
9542 (insert (number-to-string length)))
9543 (goto-char (point-min))
9544 (when (re-search-forward "^lines:[ \t]\\([0-9]+\\)" body t)
9545 (delete-region (match-beginning 1) (match-end 1))
9546 (insert (number-to-string lines))))))
7999 ;; Replace the article. 9547 ;; Replace the article.
8000 (let ((buf (current-buffer))) 9548 (let ((buf (current-buffer)))
8001 (with-temp-buffer 9549 (with-temp-buffer
8002 (insert-buffer-substring buf) 9550 (insert-buffer-substring buf)
9551
8003 (if (and (not read-only) 9552 (if (and (not read-only)
8004 (not (gnus-request-replace-article 9553 (not (gnus-request-replace-article
8005 (cdr gnus-article-current) (car gnus-article-current) 9554 (cdr gnus-article-current) (car gnus-article-current)
8006 (current-buffer) t))) 9555 (current-buffer) t)))
8007 (error "Couldn't replace article") 9556 (error "Couldn't replace article")
8012 (or (message-fetch-field "references") "") " "))) 9561 (or (message-fetch-field "references") "") " ")))
8013 ;; We only have to update this line. 9562 ;; We only have to update this line.
8014 (save-excursion 9563 (save-excursion
8015 (save-restriction 9564 (save-restriction
8016 (message-narrow-to-head) 9565 (message-narrow-to-head)
8017 (let ((head (buffer-string)) 9566 (let ((head (buffer-substring-no-properties
9567 (point-min) (point-max)))
8018 header) 9568 header)
8019 (with-temp-buffer 9569 (with-temp-buffer
8020 (insert (format "211 %d Article retrieved.\n" 9570 (insert (format "211 %d Article retrieved.\n"
8021 (cdr gnus-article-current))) 9571 (cdr gnus-article-current)))
8022 (insert head) 9572 (insert head)
8023 (insert ".\n") 9573 (insert ".\n")
8024 (let ((nntp-server-buffer (current-buffer))) 9574 (let ((nntp-server-buffer (current-buffer)))
8025 (setq header (car (gnus-get-newsgroup-headers 9575 (setq header (car (gnus-get-newsgroup-headers
8026 (save-excursion 9576 nil t))))
8027 (set-buffer gnus-summary-buffer)
8028 gnus-newsgroup-dependencies)
8029 t))))
8030 (save-excursion 9577 (save-excursion
8031 (set-buffer gnus-summary-buffer) 9578 (set-buffer gnus-summary-buffer)
8032 (gnus-data-set-header 9579 (gnus-data-set-header
8033 (gnus-data-find (cdr gnus-article-current)) 9580 (gnus-data-find (cdr gnus-article-current))
8034 header) 9581 header)
8035 (gnus-summary-update-article-line 9582 (gnus-summary-update-article-line
8036 (cdr gnus-article-current) header)))))) 9583 (cdr gnus-article-current) header)
9584 (if (gnus-summary-goto-subject
9585 (cdr gnus-article-current) nil t)
9586 (gnus-summary-update-secondary-mark
9587 (cdr gnus-article-current))))))))
8037 ;; Update threads. 9588 ;; Update threads.
8038 (set-buffer (or buffer gnus-summary-buffer)) 9589 (set-buffer (or buffer gnus-summary-buffer))
8039 (gnus-summary-update-article (cdr gnus-article-current))) 9590 (gnus-summary-update-article (cdr gnus-article-current))
9591 (if (gnus-summary-goto-subject (cdr gnus-article-current) nil t)
9592 (gnus-summary-update-secondary-mark
9593 (cdr gnus-article-current))))
8040 ;; Prettify the article buffer again. 9594 ;; Prettify the article buffer again.
8041 (unless no-highlight 9595 (unless no-highlight
8042 (save-excursion 9596 (save-excursion
8043 (set-buffer gnus-article-buffer) 9597 (set-buffer gnus-article-buffer)
8044 ;;;!!! Fix this -- article should be rehighlighted. 9598 ;;;!!! Fix this -- article should be rehighlighted.
8070 (interactive) 9624 (interactive)
8071 (let (gnus-mark-article-hook) 9625 (let (gnus-mark-article-hook)
8072 (gnus-summary-select-article) 9626 (gnus-summary-select-article)
8073 (save-excursion 9627 (save-excursion
8074 (set-buffer gnus-original-article-buffer) 9628 (set-buffer gnus-original-article-buffer)
8075 (save-restriction 9629 (let ((groups (nnmail-article-group 'identity trace)))
8076 (message-narrow-to-head) 9630 (unless silent
8077 (let ((groups (nnmail-article-group 'identity trace))) 9631 (if groups
8078 (unless silent 9632 (message "This message would go to %s"
8079 (if groups 9633 (mapconcat 'car groups ", "))
8080 (message "This message would go to %s" 9634 (message "This message would go to no groups"))
8081 (mapconcat 'car groups ", ")) 9635 groups)))))
8082 (message "This message would go to no groups"))
8083 groups))))))
8084 9636
8085 (defun gnus-summary-respool-trace () 9637 (defun gnus-summary-respool-trace ()
8086 "Trace where the respool algorithm would put this article. 9638 "Trace where the respool algorithm would put this article.
8087 Display a buffer showing all fancy splitting patterns which matched." 9639 Display a buffer showing all fancy splitting patterns which matched."
8088 (interactive) 9640 (interactive)
8160 (defun gnus-summary-mark-as-processable (n &optional unmark) 9712 (defun gnus-summary-mark-as-processable (n &optional unmark)
8161 "Set the process mark on the next N articles. 9713 "Set the process mark on the next N articles.
8162 If N is negative, mark backward instead. If UNMARK is non-nil, remove 9714 If N is negative, mark backward instead. If UNMARK is non-nil, remove
8163 the process mark instead. The difference between N and the actual 9715 the process mark instead. The difference between N and the actual
8164 number of articles marked is returned." 9716 number of articles marked is returned."
8165 (interactive "p") 9717 (interactive "P")
8166 (let ((backward (< n 0)) 9718 (if (and (null n) (gnus-region-active-p))
8167 (n (abs n))) 9719 (gnus-uu-mark-region (region-beginning) (region-end) unmark)
8168 (while (and 9720 (setq n (prefix-numeric-value n))
8169 (> n 0) 9721 (let ((backward (< n 0))
8170 (if unmark 9722 (n (abs n)))
8171 (gnus-summary-remove-process-mark 9723 (while (and
8172 (gnus-summary-article-number)) 9724 (> n 0)
8173 (gnus-summary-set-process-mark (gnus-summary-article-number))) 9725 (if unmark
8174 (zerop (gnus-summary-next-subject (if backward -1 1) nil t))) 9726 (gnus-summary-remove-process-mark
8175 (setq n (1- n))) 9727 (gnus-summary-article-number))
8176 (when (/= 0 n) 9728 (gnus-summary-set-process-mark (gnus-summary-article-number)))
8177 (gnus-message 7 "No more articles")) 9729 (zerop (gnus-summary-next-subject (if backward -1 1) nil t)))
8178 (gnus-summary-recenter) 9730 (setq n (1- n)))
8179 (gnus-summary-position-point) 9731 (when (/= 0 n)
8180 n)) 9732 (gnus-message 7 "No more articles"))
9733 (gnus-summary-recenter)
9734 (gnus-summary-position-point)
9735 n)))
8181 9736
8182 (defun gnus-summary-unmark-as-processable (n) 9737 (defun gnus-summary-unmark-as-processable (n)
8183 "Remove the process mark from the next N articles. 9738 "Remove the process mark from the next N articles.
8184 If N is negative, unmark backward instead. The difference between N and 9739 If N is negative, unmark backward instead. The difference between N and
8185 the actual number of articles unmarked is returned." 9740 the actual number of articles unmarked is returned."
8186 (interactive "p") 9741 (interactive "P")
8187 (gnus-summary-mark-as-processable n t)) 9742 (gnus-summary-mark-as-processable n t))
8188 9743
8189 (defun gnus-summary-unmark-all-processable () 9744 (defun gnus-summary-unmark-all-processable ()
8190 "Remove the process mark from all articles." 9745 "Remove the process mark from all articles."
8191 (interactive) 9746 (interactive)
8192 (save-excursion 9747 (save-excursion
8193 (while gnus-newsgroup-processable 9748 (while gnus-newsgroup-processable
8194 (gnus-summary-remove-process-mark (car gnus-newsgroup-processable)))) 9749 (gnus-summary-remove-process-mark (car gnus-newsgroup-processable))))
8195 (gnus-summary-position-point)) 9750 (gnus-summary-position-point))
8196 9751
9752 (defun gnus-summary-add-mark (article type)
9753 "Mark ARTICLE with a mark of TYPE."
9754 (let ((vtype (car (assq type gnus-article-mark-lists)))
9755 var)
9756 (if (not vtype)
9757 (error "No such mark type: %s" type)
9758 (setq var (intern (format "gnus-newsgroup-%s" type)))
9759 (set var (cons article (symbol-value var)))
9760 (if (memq type '(processable cached replied forwarded recent saved))
9761 (gnus-summary-update-secondary-mark article)
9762 ;;; !!! This is bogus. We should find out what primary
9763 ;;; !!! mark we want to set.
9764 (gnus-summary-update-mark gnus-del-mark 'unread)))))
9765
8197 (defun gnus-summary-mark-as-expirable (n) 9766 (defun gnus-summary-mark-as-expirable (n)
8198 "Mark N articles forward as expirable. 9767 "Mark N articles forward as expirable.
8199 If N is negative, mark backward instead. The difference between N and 9768 If N is negative, mark backward instead. The difference between N and
8200 the actual number of articles marked is returned." 9769 the actual number of articles marked is returned."
8201 (interactive "p") 9770 (interactive "p")
8202 (gnus-summary-mark-forward n gnus-expirable-mark)) 9771 (gnus-summary-mark-forward n gnus-expirable-mark))
8203 9772
9773 (defun gnus-summary-mark-as-spam (n)
9774 "Mark N articles forward as spam.
9775 If N is negative, mark backward instead. The difference between N and
9776 the actual number of articles marked is returned."
9777 (interactive "p")
9778 (gnus-summary-mark-forward n gnus-spam-mark))
9779
8204 (defun gnus-summary-mark-article-as-replied (article) 9780 (defun gnus-summary-mark-article-as-replied (article)
8205 "Mark ARTICLE replied and update the summary line." 9781 "Mark ARTICLE as replied to and update the summary line.
8206 (push article gnus-newsgroup-replied) 9782 ARTICLE can also be a list of articles."
8207 (let ((buffer-read-only nil)) 9783 (interactive (list (gnus-summary-article-number)))
8208 (when (gnus-summary-goto-subject article nil t) 9784 (let ((articles (if (listp article) article (list article))))
8209 (gnus-summary-update-secondary-mark article)))) 9785 (dolist (article articles)
9786 (unless (numberp article)
9787 (error "%s is not a number" article))
9788 (push article gnus-newsgroup-replied)
9789 (let ((buffer-read-only nil))
9790 (when (gnus-summary-goto-subject article nil t)
9791 (gnus-summary-update-secondary-mark article))))))
9792
9793 (defun gnus-summary-mark-article-as-forwarded (article)
9794 "Mark ARTICLE as forwarded and update the summary line.
9795 ARTICLE can also be a list of articles."
9796 (let ((articles (if (listp article) article (list article))))
9797 (dolist (article articles)
9798 (push article gnus-newsgroup-forwarded)
9799 (let ((buffer-read-only nil))
9800 (when (gnus-summary-goto-subject article nil t)
9801 (gnus-summary-update-secondary-mark article))))))
8210 9802
8211 (defun gnus-summary-set-bookmark (article) 9803 (defun gnus-summary-set-bookmark (article)
8212 "Set a bookmark in current article." 9804 "Set a bookmark in current article."
8213 (interactive (list (gnus-summary-article-number))) 9805 (interactive (list (gnus-summary-article-number)))
8214 (when (or (not (get-buffer gnus-article-buffer)) 9806 (when (or (not (get-buffer gnus-article-buffer))
8215 (not gnus-current-article) 9807 (not gnus-current-article)
8216 (not gnus-article-current) 9808 (not gnus-article-current)
8217 (not (equal gnus-newsgroup-name (car gnus-article-current)))) 9809 (not (equal gnus-newsgroup-name (car gnus-article-current))))
8218 (error "No current article selected")) 9810 (error "No current article selected"))
8219 ;; Remove old bookmark, if one exists. 9811 ;; Remove old bookmark, if one exists.
8220 (let ((old (assq article gnus-newsgroup-bookmarks))) 9812 (gnus-pull article gnus-newsgroup-bookmarks)
8221 (when old
8222 (setq gnus-newsgroup-bookmarks
8223 (delq old gnus-newsgroup-bookmarks))))
8224 ;; Set the new bookmark, which is on the form 9813 ;; Set the new bookmark, which is on the form
8225 ;; (article-number . line-number-in-body). 9814 ;; (article-number . line-number-in-body).
8226 (push 9815 (push
8227 (cons article 9816 (cons article
8228 (save-excursion 9817 (save-excursion
8229 (set-buffer gnus-article-buffer) 9818 (set-buffer gnus-article-buffer)
8230 (count-lines 9819 (count-lines
8231 (min (point) 9820 (min (point)
8232 (save-excursion 9821 (save-excursion
8233 (goto-char (point-min)) 9822 (article-goto-body)
8234 (search-forward "\n\n" nil t)
8235 (point))) 9823 (point)))
8236 (point)))) 9824 (point))))
8237 gnus-newsgroup-bookmarks) 9825 gnus-newsgroup-bookmarks)
8238 (gnus-message 6 "A bookmark has been added to the current article.")) 9826 (gnus-message 6 "A bookmark has been added to the current article."))
8239 9827
8240 (defun gnus-summary-remove-bookmark (article) 9828 (defun gnus-summary-remove-bookmark (article)
8241 "Remove the bookmark from the current article." 9829 "Remove the bookmark from the current article."
8242 (interactive (list (gnus-summary-article-number))) 9830 (interactive (list (gnus-summary-article-number)))
8243 ;; Remove old bookmark, if one exists. 9831 ;; Remove old bookmark, if one exists.
8244 (let ((old (assq article gnus-newsgroup-bookmarks))) 9832 (if (not (assq article gnus-newsgroup-bookmarks))
8245 (if old 9833 (gnus-message 6 "No bookmark in current article.")
8246 (progn 9834 (gnus-pull article gnus-newsgroup-bookmarks)
8247 (setq gnus-newsgroup-bookmarks 9835 (gnus-message 6 "Removed bookmark.")))
8248 (delq old gnus-newsgroup-bookmarks))
8249 (gnus-message 6 "Removed bookmark."))
8250 (gnus-message 6 "No bookmark in current article."))))
8251 9836
8252 ;; Suggested by Daniel Quinlan <quinlan@best.com>. 9837 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
8253 (defun gnus-summary-mark-as-dormant (n) 9838 (defun gnus-summary-mark-as-dormant (n)
8254 "Mark N articles forward as dormant. 9839 "Mark N articles forward as dormant.
8255 If N is negative, mark backward instead. The difference between N and 9840 If N is negative, mark backward instead. The difference between N and
8291 (gnus-summary-show-thread) 9876 (gnus-summary-show-thread)
8292 (let ((backward (< n 0)) 9877 (let ((backward (< n 0))
8293 (gnus-summary-goto-unread 9878 (gnus-summary-goto-unread
8294 (and gnus-summary-goto-unread 9879 (and gnus-summary-goto-unread
8295 (not (eq gnus-summary-goto-unread 'never)) 9880 (not (eq gnus-summary-goto-unread 'never))
8296 (not (memq mark (list gnus-unread-mark 9881 (not (memq mark (list gnus-unread-mark gnus-spam-mark
8297 gnus-ticked-mark gnus-dormant-mark))))) 9882 gnus-ticked-mark gnus-dormant-mark)))))
8298 (n (abs n)) 9883 (n (abs n))
8299 (mark (or mark gnus-del-mark))) 9884 (mark (or mark gnus-del-mark)))
8300 (while (and (> n 0) 9885 (while (and (> n 0)
8301 (gnus-summary-mark-article nil mark no-expire) 9886 (gnus-summary-mark-article nil mark no-expire)
8315 (defun gnus-summary-mark-article-as-read (mark) 9900 (defun gnus-summary-mark-article-as-read (mark)
8316 "Mark the current article quickly as read with MARK." 9901 "Mark the current article quickly as read with MARK."
8317 (let ((article (gnus-summary-article-number))) 9902 (let ((article (gnus-summary-article-number)))
8318 (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) 9903 (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
8319 (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) 9904 (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
9905 (setq gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked))
8320 (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) 9906 (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
8321 (push (cons article mark) gnus-newsgroup-reads) 9907 (push (cons article mark) gnus-newsgroup-reads)
8322 ;; Possibly remove from cache, if that is used. 9908 ;; Possibly remove from cache, if that is used.
8323 (when gnus-use-cache 9909 (when gnus-use-cache
8324 (gnus-cache-enter-remove-article article)) 9910 (gnus-cache-enter-remove-article article))
8346 (if (<= article 0) 9932 (if (<= article 0)
8347 (progn 9933 (progn
8348 (gnus-error 1 "Can't mark negative article numbers") 9934 (gnus-error 1 "Can't mark negative article numbers")
8349 nil) 9935 nil)
8350 (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) 9936 (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
9937 (setq gnus-newsgroup-spam-marked
9938 (delq article gnus-newsgroup-spam-marked))
8351 (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) 9939 (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
8352 (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)) 9940 (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
8353 (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads)) 9941 (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads))
8354 (cond ((= mark gnus-ticked-mark) 9942 (cond ((= mark gnus-ticked-mark)
8355 (push article gnus-newsgroup-marked)) 9943 (setq gnus-newsgroup-marked
9944 (gnus-add-to-sorted-list gnus-newsgroup-marked
9945 article)))
9946 ((= mark gnus-spam-mark)
9947 (setq gnus-newsgroup-spam-marked
9948 (gnus-add-to-sorted-list gnus-newsgroup-spam-marked
9949 article)))
8356 ((= mark gnus-dormant-mark) 9950 ((= mark gnus-dormant-mark)
8357 (push article gnus-newsgroup-dormant)) 9951 (setq gnus-newsgroup-dormant
9952 (gnus-add-to-sorted-list gnus-newsgroup-dormant
9953 article)))
8358 (t 9954 (t
8359 (push article gnus-newsgroup-unreads))) 9955 (setq gnus-newsgroup-unreads
9956 (gnus-add-to-sorted-list gnus-newsgroup-unreads
9957 article))))
8360 (gnus-pull article gnus-newsgroup-reads) 9958 (gnus-pull article gnus-newsgroup-reads)
8361 9959
8362 ;; See whether the article is to be put in the cache. 9960 ;; See whether the article is to be put in the cache.
8363 (and gnus-use-cache 9961 (and gnus-use-cache
8364 (vectorp (gnus-summary-article-header article)) 9962 (vectorp (gnus-summary-article-header article))
8386 ;; If no mark is given, then we check auto-expiring. 9984 ;; If no mark is given, then we check auto-expiring.
8387 (when (null mark) 9985 (when (null mark)
8388 (setq mark gnus-del-mark)) 9986 (setq mark gnus-del-mark))
8389 (when (and (not no-expire) 9987 (when (and (not no-expire)
8390 gnus-newsgroup-auto-expire 9988 gnus-newsgroup-auto-expire
8391 (memq mark gnus-auto-expirable-marks)) 9989 (memq mark gnus-auto-expirable-marks))
8392 (setq mark gnus-expirable-mark)) 9990 (setq mark gnus-expirable-mark))
8393 (let ((article (or article (gnus-summary-article-number))) 9991 (let ((article (or article (gnus-summary-article-number)))
8394 (old-mark (gnus-summary-article-mark article))) 9992 (old-mark (gnus-summary-article-mark article)))
8395 ;; Allow the backend to change the mark. 9993 ;; Allow the backend to change the mark.
8396 (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark)) 9994 (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
8398 t 9996 t
8399 (unless article 9997 (unless article
8400 (error "No article on current line")) 9998 (error "No article on current line"))
8401 (if (not (if (or (= mark gnus-unread-mark) 9999 (if (not (if (or (= mark gnus-unread-mark)
8402 (= mark gnus-ticked-mark) 10000 (= mark gnus-ticked-mark)
10001 (= mark gnus-spam-mark)
8403 (= mark gnus-dormant-mark)) 10002 (= mark gnus-dormant-mark))
8404 (gnus-mark-article-as-unread article mark) 10003 (gnus-mark-article-as-unread article mark)
8405 (gnus-mark-article-as-read article mark))) 10004 (gnus-mark-article-as-read article mark)))
8406 t 10005 t
8407 ;; See whether the article is to be put in the cache. 10006 ;; See whether the article is to be put in the cache.
8428 gnus-process-mark) 10027 gnus-process-mark)
8429 ((memq article gnus-newsgroup-cached) 10028 ((memq article gnus-newsgroup-cached)
8430 gnus-cached-mark) 10029 gnus-cached-mark)
8431 ((memq article gnus-newsgroup-replied) 10030 ((memq article gnus-newsgroup-replied)
8432 gnus-replied-mark) 10031 gnus-replied-mark)
10032 ((memq article gnus-newsgroup-forwarded)
10033 gnus-forwarded-mark)
8433 ((memq article gnus-newsgroup-saved) 10034 ((memq article gnus-newsgroup-saved)
8434 gnus-saved-mark) 10035 gnus-saved-mark)
8435 (t gnus-unread-mark)) 10036 ((memq article gnus-newsgroup-recent)
10037 gnus-recent-mark)
10038 ((memq article gnus-newsgroup-unseen)
10039 gnus-unseen-mark)
10040 (t gnus-no-mark))
8436 'replied) 10041 'replied)
8437 (when (gnus-visual-p 'summary-highlight 'highlight) 10042 (when (gnus-visual-p 'summary-highlight 'highlight)
8438 (gnus-run-hooks 'gnus-summary-update-hook)) 10043 (gnus-run-hooks 'gnus-summary-update-hook))
8439 t) 10044 t)
8440 10045
10046 (defun gnus-summary-update-download-mark (article)
10047 "Update the download mark."
10048 (gnus-summary-update-mark
10049 (cond ((memq article gnus-newsgroup-undownloaded)
10050 gnus-undownloaded-mark)
10051 (gnus-newsgroup-agentized
10052 gnus-downloaded-mark)
10053 (t
10054 gnus-no-mark))
10055 'download)
10056 (gnus-summary-update-line t)
10057 t)
10058
8441 (defun gnus-summary-update-mark (mark type) 10059 (defun gnus-summary-update-mark (mark type)
8442 (let ((forward (cdr (assq type gnus-summary-mark-positions))) 10060 (let ((forward (cdr (assq type gnus-summary-mark-positions)))
8443 (buffer-read-only nil)) 10061 (buffer-read-only nil))
8444 (re-search-backward "[\n\r]" (gnus-point-at-bol) 'move-to-limit) 10062 (re-search-backward "[\n\r]" (gnus-point-at-bol) 'move-to-limit)
8445 (when forward 10063 (when forward
8446 (when (looking-at "\r") 10064 (when (looking-at "\r")
8447 (incf forward)) 10065 (incf forward))
8448 (when (<= (+ forward (point)) (point-max)) 10066 (when (<= (+ forward (point)) (point-max))
8458 10076
8459 (defun gnus-mark-article-as-read (article &optional mark) 10077 (defun gnus-mark-article-as-read (article &optional mark)
8460 "Enter ARTICLE in the pertinent lists and remove it from others." 10078 "Enter ARTICLE in the pertinent lists and remove it from others."
8461 ;; Make the article expirable. 10079 ;; Make the article expirable.
8462 (let ((mark (or mark gnus-del-mark))) 10080 (let ((mark (or mark gnus-del-mark)))
8463 (if (= mark gnus-expirable-mark) 10081 (setq gnus-newsgroup-expirable
8464 (push article gnus-newsgroup-expirable) 10082 (if (= mark gnus-expirable-mark)
8465 (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))) 10083 (gnus-add-to-sorted-list gnus-newsgroup-expirable article)
10084 (delq article gnus-newsgroup-expirable)))
8466 ;; Remove from unread and marked lists. 10085 ;; Remove from unread and marked lists.
8467 (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) 10086 (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
8468 (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) 10087 (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
10088 (setq gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked))
8469 (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) 10089 (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
8470 (push (cons article mark) gnus-newsgroup-reads) 10090 (push (cons article mark) gnus-newsgroup-reads)
8471 ;; Possibly remove from cache, if that is used. 10091 ;; Possibly remove from cache, if that is used.
8472 (when gnus-use-cache 10092 (when gnus-use-cache
8473 (gnus-cache-enter-remove-article article)) 10093 (gnus-cache-enter-remove-article article))
8479 (if (<= article 0) 10099 (if (<= article 0)
8480 (progn 10100 (progn
8481 (gnus-error 1 "Can't mark negative article numbers") 10101 (gnus-error 1 "Can't mark negative article numbers")
8482 nil) 10102 nil)
8483 (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked) 10103 (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)
10104 gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked)
8484 gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant) 10105 gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)
8485 gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable) 10106 gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)
8486 gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) 10107 gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
8487 10108
8488 ;; Unsuppress duplicates? 10109 ;; Unsuppress duplicates?
8489 (when gnus-suppress-duplicates 10110 (when gnus-suppress-duplicates
8490 (gnus-dup-unsuppress-article article)) 10111 (gnus-dup-unsuppress-article article))
8491 10112
8492 (cond ((= mark gnus-ticked-mark) 10113 (cond ((= mark gnus-ticked-mark)
8493 (push article gnus-newsgroup-marked)) 10114 (setq gnus-newsgroup-marked
10115 (gnus-add-to-sorted-list gnus-newsgroup-marked article)))
10116 ((= mark gnus-spam-mark)
10117 (setq gnus-newsgroup-spam-marked
10118 (gnus-add-to-sorted-list gnus-newsgroup-spam-marked
10119 article)))
8494 ((= mark gnus-dormant-mark) 10120 ((= mark gnus-dormant-mark)
8495 (push article gnus-newsgroup-dormant)) 10121 (setq gnus-newsgroup-dormant
10122 (gnus-add-to-sorted-list gnus-newsgroup-dormant article)))
8496 (t 10123 (t
8497 (push article gnus-newsgroup-unreads))) 10124 (setq gnus-newsgroup-unreads
10125 (gnus-add-to-sorted-list gnus-newsgroup-unreads article))))
8498 (gnus-pull article gnus-newsgroup-reads) 10126 (gnus-pull article gnus-newsgroup-reads)
8499 t))) 10127 t)))
8500 10128
8501 (defalias 'gnus-summary-mark-as-unread-forward 10129 (defalias 'gnus-summary-mark-as-unread-forward
8502 'gnus-summary-tick-article-forward) 10130 'gnus-summary-tick-article-forward)
8567 (defun gnus-summary-mark-unread-as-read () 10195 (defun gnus-summary-mark-unread-as-read ()
8568 "Intended to be used by `gnus-summary-mark-article-hook'." 10196 "Intended to be used by `gnus-summary-mark-article-hook'."
8569 (when (memq gnus-current-article gnus-newsgroup-unreads) 10197 (when (memq gnus-current-article gnus-newsgroup-unreads)
8570 (gnus-summary-mark-article gnus-current-article gnus-read-mark))) 10198 (gnus-summary-mark-article gnus-current-article gnus-read-mark)))
8571 10199
8572 (defun gnus-summary-mark-read-and-unread-as-read () 10200 (defun gnus-summary-mark-read-and-unread-as-read (&optional new-mark)
8573 "Intended to be used by `gnus-summary-mark-article-hook'." 10201 "Intended to be used by `gnus-summary-mark-article-hook'."
8574 (let ((mark (gnus-summary-article-mark))) 10202 (let ((mark (gnus-summary-article-mark)))
8575 (when (or (gnus-unread-mark-p mark) 10203 (when (or (gnus-unread-mark-p mark)
8576 (gnus-read-mark-p mark)) 10204 (gnus-read-mark-p mark))
8577 (gnus-summary-mark-article gnus-current-article gnus-read-mark)))) 10205 (gnus-summary-mark-article gnus-current-article
10206 (or new-mark gnus-read-mark)))))
10207
10208 (defun gnus-summary-mark-current-read-and-unread-as-read (&optional new-mark)
10209 "Intended to be used by `gnus-summary-mark-article-hook'."
10210 (let ((mark (gnus-summary-article-mark)))
10211 (when (or (gnus-unread-mark-p mark)
10212 (gnus-read-mark-p mark))
10213 (gnus-summary-mark-article (gnus-summary-article-number)
10214 (or new-mark gnus-read-mark)))))
10215
10216 (defun gnus-summary-mark-unread-as-ticked ()
10217 "Intended to be used by `gnus-summary-mark-article-hook'."
10218 (when (memq gnus-current-article gnus-newsgroup-unreads)
10219 (gnus-summary-mark-article gnus-current-article gnus-ticked-mark)))
8578 10220
8579 (defun gnus-summary-mark-region-as-read (point mark all) 10221 (defun gnus-summary-mark-region-as-read (point mark all)
8580 "Mark all unread articles between point and mark as read. 10222 "Mark all unread articles between point and mark as read.
8581 If given a prefix, mark all articles between point and mark as read, 10223 If given a prefix, mark all articles between point and mark as read,
8582 even ticked and dormant ones." 10224 even ticked and dormant ones."
8647 (interactive) 10289 (interactive)
8648 (let ((buffer-read-only nil)) 10290 (let ((buffer-read-only nil))
8649 (let ((scored gnus-newsgroup-scored) 10291 (let ((scored gnus-newsgroup-scored)
8650 headers h) 10292 headers h)
8651 (while scored 10293 (while scored
8652 (unless (gnus-summary-goto-subject (caar scored)) 10294 (unless (gnus-summary-article-header (caar scored))
8653 (and (setq h (gnus-summary-article-header (caar scored))) 10295 (and (setq h (gnus-number-to-header (caar scored)))
8654 (< (cdar scored) gnus-summary-expunge-below) 10296 (< (cdar scored) gnus-summary-expunge-below)
8655 (push h headers))) 10297 (push h headers)))
8656 (setq scored (cdr scored))) 10298 (setq scored (cdr scored)))
8657 (if (not headers) 10299 (if (not headers)
8658 (when (not no-error) 10300 (when (not no-error)
8659 (error "No expunged articles hidden")) 10301 (error "No expunged articles hidden"))
8660 (goto-char (point-min)) 10302 (goto-char (point-min))
10303 (push gnus-newsgroup-limit gnus-newsgroup-limits)
10304 (setq gnus-newsgroup-limit (copy-sequence gnus-newsgroup-limit))
10305 (mapcar (lambda (x) (push (mail-header-number x)
10306 gnus-newsgroup-limit))
10307 headers)
8661 (gnus-summary-prepare-unthreaded (nreverse headers)) 10308 (gnus-summary-prepare-unthreaded (nreverse headers))
8662 (goto-char (point-min)) 10309 (goto-char (point-min))
8663 (gnus-summary-position-point) 10310 (gnus-summary-position-point)
8664 t)))) 10311 t))))
8665 10312
8666 (defun gnus-summary-catchup (&optional all quietly to-here not-mark) 10313 (defun gnus-summary-catchup (&optional all quietly to-here not-mark reverse)
8667 "Mark all unread articles in this newsgroup as read. 10314 "Mark all unread articles in this newsgroup as read.
8668 If prefix argument ALL is non-nil, ticked and dormant articles will 10315 If prefix argument ALL is non-nil, ticked and dormant articles will
8669 also be marked as read. 10316 also be marked as read.
8670 If QUIETLY is non-nil, no questions will be asked. 10317 If QUIETLY is non-nil, no questions will be asked.
10318
8671 If TO-HERE is non-nil, it should be a point in the buffer. All 10319 If TO-HERE is non-nil, it should be a point in the buffer. All
8672 articles before this point will be marked as read. 10320 articles before (after, if REVERSE is set) this point will be marked
10321 as read.
10322
8673 Note that this function will only catch up the unread article 10323 Note that this function will only catch up the unread article
8674 in the current summary buffer limitation. 10324 in the current summary buffer limitation.
10325
8675 The number of articles marked as read is returned." 10326 The number of articles marked as read is returned."
8676 (interactive "P") 10327 (interactive "P")
8677 (prog1 10328 (prog1
8678 (save-excursion 10329 (save-excursion
8679 (when (or quietly 10330 (when (or quietly
8690 (or (not gnus-use-cache) 10341 (or (not gnus-use-cache)
8691 (eq gnus-use-cache 'passive))) 10342 (eq gnus-use-cache 'passive)))
8692 (progn 10343 (progn
8693 (when all 10344 (when all
8694 (setq gnus-newsgroup-marked nil 10345 (setq gnus-newsgroup-marked nil
10346 gnus-newsgroup-spam-marked nil
8695 gnus-newsgroup-dormant nil)) 10347 gnus-newsgroup-dormant nil))
8696 (setq gnus-newsgroup-unreads gnus-newsgroup-downloadable)) 10348 (setq gnus-newsgroup-unreads
10349 (gnus-sorted-nunion
10350 (gnus-intersection gnus-newsgroup-unreads
10351 gnus-newsgroup-downloadable)
10352 gnus-newsgroup-unfetched)))
8697 ;; We actually mark all articles as canceled, which we 10353 ;; We actually mark all articles as canceled, which we
8698 ;; have to do when using auto-expiry or adaptive scoring. 10354 ;; have to do when using auto-expiry or adaptive scoring.
8699 (gnus-summary-show-all-threads) 10355 (gnus-summary-show-all-threads)
8700 (when (gnus-summary-first-subject (not all) t) 10356 (if (and to-here reverse)
8701 (while (and 10357 (progn
8702 (if to-here (< (point) to-here) t) 10358 (goto-char to-here)
8703 (gnus-summary-mark-article-as-read gnus-catchup-mark) 10359 (gnus-summary-mark-current-read-and-unread-as-read
8704 (gnus-summary-find-next (not all) nil nil t)))) 10360 gnus-catchup-mark)
10361 (while (gnus-summary-find-next (not all))
10362 (gnus-summary-mark-article-as-read gnus-catchup-mark)))
10363 (when (gnus-summary-first-subject (not all))
10364 (while (and
10365 (if to-here (< (point) to-here) t)
10366 (gnus-summary-mark-article-as-read gnus-catchup-mark)
10367 (gnus-summary-find-next (not all))))))
8705 (gnus-set-mode-line 'summary)) 10368 (gnus-set-mode-line 'summary))
8706 t)) 10369 t))
8707 (gnus-summary-position-point))) 10370 (gnus-summary-position-point)))
8708 10371
8709 (defun gnus-summary-catchup-to-here (&optional all) 10372 (defun gnus-summary-catchup-to-here (&optional all)
8716 ;; We check that there are unread articles. 10379 ;; We check that there are unread articles.
8717 (when (or all (gnus-summary-find-prev)) 10380 (when (or all (gnus-summary-find-prev))
8718 (gnus-summary-catchup all t beg))))) 10381 (gnus-summary-catchup all t beg)))))
8719 (gnus-summary-position-point)) 10382 (gnus-summary-position-point))
8720 10383
10384 (defun gnus-summary-catchup-from-here (&optional all)
10385 "Mark all unticked articles after (and including) the current one as read.
10386 If ALL is non-nil, also mark ticked and dormant articles as read."
10387 (interactive "P")
10388 (save-excursion
10389 (gnus-save-hidden-threads
10390 (let ((beg (point)))
10391 ;; We check that there are unread articles.
10392 (when (or all (gnus-summary-find-next))
10393 (gnus-summary-catchup all t beg nil t)))))
10394 (gnus-summary-position-point))
10395
8721 (defun gnus-summary-catchup-all (&optional quietly) 10396 (defun gnus-summary-catchup-all (&optional quietly)
8722 "Mark all articles in this newsgroup as read." 10397 "Mark all articles in this newsgroup as read.
10398 This command is dangerous. Normally, you want \\[gnus-summary-catchup]
10399 instead, which marks only unread articles as read."
8723 (interactive "P") 10400 (interactive "P")
8724 (gnus-summary-catchup t quietly)) 10401 (gnus-summary-catchup t quietly))
8725 10402
8726 (defun gnus-summary-catchup-and-exit (&optional all quietly) 10403 (defun gnus-summary-catchup-and-exit (&optional all quietly)
8727 "Mark all unread articles in this group as read, then exit. 10404 "Mark all unread articles in this group as read, then exit.
8728 If prefix argument ALL is non-nil, all articles are marked as read." 10405 If prefix argument ALL is non-nil, all articles are marked as read.
10406 If QUIETLY is non-nil, no questions will be asked."
8729 (interactive "P") 10407 (interactive "P")
8730 (when (gnus-summary-catchup all quietly nil 'fast) 10408 (when (gnus-summary-catchup all quietly nil 'fast)
8731 ;; Select next newsgroup or exit. 10409 ;; Select next newsgroup or exit.
8732 (if (and (not (gnus-group-quit-config gnus-newsgroup-name)) 10410 (if (and (not (gnus-group-quit-config gnus-newsgroup-name))
8733 (eq gnus-auto-select-next 'quietly)) 10411 (eq gnus-auto-select-next 'quietly))
8734 (gnus-summary-next-group nil) 10412 (gnus-summary-next-group nil)
8735 (gnus-summary-exit)))) 10413 (gnus-summary-exit))))
8736 10414
8737 (defun gnus-summary-catchup-all-and-exit (&optional quietly) 10415 (defun gnus-summary-catchup-all-and-exit (&optional quietly)
8738 "Mark all articles in this newsgroup as read, and then exit." 10416 "Mark all articles in this newsgroup as read, and then exit.
10417 This command is dangerous. Normally, you want \\[gnus-summary-catchup-and-exit]
10418 instead, which marks only unread articles as read."
8739 (interactive "P") 10419 (interactive "P")
8740 (gnus-summary-catchup-and-exit t quietly)) 10420 (gnus-summary-catchup-and-exit t quietly))
8741 10421
8742 (defun gnus-summary-catchup-and-goto-next-group (&optional all) 10422 (defun gnus-summary-catchup-and-goto-next-group (&optional all)
8743 "Mark all articles in this group as read and select the next group. 10423 "Mark all articles in this group as read and select the next group.
8868 (insert " " message-id)) 10548 (insert " " message-id))
8869 (insert "References: " message-id "\n")))) 10549 (insert "References: " message-id "\n"))))
8870 (set-buffer gnus-summary-buffer) 10550 (set-buffer gnus-summary-buffer)
8871 (gnus-summary-unmark-all-processable) 10551 (gnus-summary-unmark-all-processable)
8872 (gnus-summary-update-article current-article) 10552 (gnus-summary-update-article current-article)
10553 (if (gnus-summary-goto-subject (cdr gnus-article-current) nil t)
10554 (gnus-summary-update-secondary-mark (cdr gnus-article-current)))
8873 (gnus-summary-rethread-current) 10555 (gnus-summary-rethread-current)
8874 (gnus-message 3 "Article %d is now the child of article %d" 10556 (gnus-message 3 "Article %d is now the child of article %d"
8875 current-article parent-article))))) 10557 current-article parent-article)))))
8876 10558
8877 (defun gnus-summary-toggle-threads (&optional arg) 10559 (defun gnus-summary-toggle-threads (&optional arg)
8899 "Show thread subtrees. 10581 "Show thread subtrees.
8900 Returns nil if no thread was there to be shown." 10582 Returns nil if no thread was there to be shown."
8901 (interactive) 10583 (interactive)
8902 (let ((buffer-read-only nil) 10584 (let ((buffer-read-only nil)
8903 (orig (point)) 10585 (orig (point))
8904 ;; first goto end then to beg, to have point at beg after let 10586 (end (gnus-point-at-eol))
8905 (end (progn (end-of-line) (point))) 10587 ;; Leave point at bol
8906 (beg (progn (beginning-of-line) (point)))) 10588 (beg (progn (beginning-of-line) (point))))
8907 (prog1 10589 (prog1
8908 ;; Any hidden lines here? 10590 ;; Any hidden lines here?
8909 (search-forward "\r" end t) 10591 (search-forward "\r" end t)
8910 (subst-char-in-region beg end ?\^M ?\n t) 10592 (subst-char-in-region beg end ?\^M ?\n t)
8911 (goto-char orig) 10593 (goto-char orig)
8912 (gnus-summary-position-point)))) 10594 (gnus-summary-position-point))))
8913 10595
8914 (defun gnus-summary-hide-all-threads () 10596 (defun gnus-summary-maybe-hide-threads ()
8915 "Hide all thread subtrees." 10597 "If requested, hide the threads that should be hidden."
10598 (when (and gnus-show-threads
10599 gnus-thread-hide-subtree)
10600 (gnus-summary-hide-all-threads
10601 (if (or (consp gnus-thread-hide-subtree)
10602 (functionp gnus-thread-hide-subtree))
10603 (gnus-make-predicate gnus-thread-hide-subtree)
10604 nil))))
10605
10606 ;;; Hiding predicates.
10607
10608 (defun gnus-article-unread-p (header)
10609 (memq (mail-header-number header) gnus-newsgroup-unreads))
10610
10611 (defun gnus-article-unseen-p (header)
10612 (memq (mail-header-number header) gnus-newsgroup-unseen))
10613
10614 (defun gnus-map-articles (predicate articles)
10615 "Map PREDICATE over ARTICLES and return non-nil if any predicate is non-nil."
10616 (apply 'gnus-or (mapcar predicate
10617 (mapcar 'gnus-summary-article-header articles))))
10618
10619 (defun gnus-summary-hide-all-threads (&optional predicate)
10620 "Hide all thread subtrees.
10621 If PREDICATE is supplied, threads that satisfy this predicate
10622 will not be hidden."
8916 (interactive) 10623 (interactive)
8917 (save-excursion 10624 (save-excursion
8918 (goto-char (point-min)) 10625 (goto-char (point-min))
8919 (gnus-summary-hide-thread) 10626 (let ((end nil))
8920 (while (zerop (gnus-summary-next-thread 1 t)) 10627 (while (not end)
8921 (gnus-summary-hide-thread))) 10628 (when (or (not predicate)
10629 (gnus-map-articles
10630 predicate (gnus-summary-article-children)))
10631 (gnus-summary-hide-thread))
10632 (setq end (not (zerop (gnus-summary-next-thread 1 t)))))))
8922 (gnus-summary-position-point)) 10633 (gnus-summary-position-point))
8923 10634
8924 (defun gnus-summary-hide-thread () 10635 (defun gnus-summary-hide-thread ()
8925 "Hide thread subtrees. 10636 "Hide thread subtrees.
10637 If PREDICATE is supplied, threads that satisfy this predicate
10638 will not be hidden.
8926 Returns nil if no threads were there to be hidden." 10639 Returns nil if no threads were there to be hidden."
8927 (interactive) 10640 (interactive)
8928 (let ((buffer-read-only nil) 10641 (let ((buffer-read-only nil)
8929 (start (point)) 10642 (start (point))
8930 (article (gnus-summary-article-number))) 10643 (article (gnus-summary-article-number)))
9018 (gnus-message 7 "Can't go further")) 10731 (gnus-message 7 "Can't go further"))
9019 n)) 10732 n))
9020 10733
9021 (defun gnus-summary-up-thread (n) 10734 (defun gnus-summary-up-thread (n)
9022 "Go up thread N steps. 10735 "Go up thread N steps.
9023 If N is negative, go up instead. 10736 If N is negative, go down instead.
9024 Returns the difference between N and how many steps down that were 10737 Returns the difference between N and how many steps down that were
9025 taken." 10738 taken."
9026 (interactive "p") 10739 (interactive "p")
9027 (gnus-summary-down-thread (- n))) 10740 (gnus-summary-down-thread (- n)))
9028 10741
9069 "Sort the summary buffer by article number. 10782 "Sort the summary buffer by article number.
9070 Argument REVERSE means reverse order." 10783 Argument REVERSE means reverse order."
9071 (interactive "P") 10784 (interactive "P")
9072 (gnus-summary-sort 'number reverse)) 10785 (gnus-summary-sort 'number reverse))
9073 10786
10787 (defun gnus-summary-sort-by-random (&optional reverse)
10788 "Randomize the order in the summary buffer.
10789 Argument REVERSE means to randomize in reverse order."
10790 (interactive "P")
10791 (gnus-summary-sort 'random reverse))
10792
9074 (defun gnus-summary-sort-by-author (&optional reverse) 10793 (defun gnus-summary-sort-by-author (&optional reverse)
9075 "Sort the summary buffer by author name alphabetically. 10794 "Sort the summary buffer by author name alphabetically.
9076 If `case-fold-search' is non-nil, case of letters is ignored. 10795 If `case-fold-search' is non-nil, case of letters is ignored.
9077 Argument REVERSE means reverse order." 10796 Argument REVERSE means reverse order."
9078 (interactive "P") 10797 (interactive "P")
9106 (defun gnus-summary-sort-by-chars (&optional reverse) 10825 (defun gnus-summary-sort-by-chars (&optional reverse)
9107 "Sort the summary buffer by article length. 10826 "Sort the summary buffer by article length.
9108 Argument REVERSE means reverse order." 10827 Argument REVERSE means reverse order."
9109 (interactive "P") 10828 (interactive "P")
9110 (gnus-summary-sort 'chars reverse)) 10829 (gnus-summary-sort 'chars reverse))
10830
10831 (defun gnus-summary-sort-by-original (&optional reverse)
10832 "Sort the summary buffer using the default sorting method.
10833 Argument REVERSE means reverse order."
10834 (interactive "P")
10835 (let* ((buffer-read-only)
10836 (gnus-summary-prepare-hook nil))
10837 ;; We do the sorting by regenerating the threads.
10838 (gnus-summary-prepare)
10839 ;; Hide subthreads if needed.
10840 (gnus-summary-maybe-hide-threads)))
9111 10841
9112 (defun gnus-summary-sort (predicate reverse) 10842 (defun gnus-summary-sort (predicate reverse)
9113 "Sort summary buffer by PREDICATE. REVERSE means reverse order." 10843 "Sort summary buffer by PREDICATE. REVERSE means reverse order."
9114 (let* ((thread (intern (format "gnus-thread-sort-by-%s" predicate))) 10844 (let* ((thread (intern (format "gnus-thread-sort-by-%s" predicate)))
9115 (article (intern (format "gnus-article-sort-by-%s" predicate))) 10845 (article (intern (format "gnus-article-sort-by-%s" predicate)))
9128 (buffer-read-only) 10858 (buffer-read-only)
9129 (gnus-summary-prepare-hook nil)) 10859 (gnus-summary-prepare-hook nil))
9130 ;; We do the sorting by regenerating the threads. 10860 ;; We do the sorting by regenerating the threads.
9131 (gnus-summary-prepare) 10861 (gnus-summary-prepare)
9132 ;; Hide subthreads if needed. 10862 ;; Hide subthreads if needed.
9133 (when (and gnus-show-threads gnus-thread-hide-subtree) 10863 (gnus-summary-maybe-hide-threads)))
9134 (gnus-summary-hide-all-threads))))
9135 10864
9136 ;; Summary saving commands. 10865 ;; Summary saving commands.
9137 10866
9138 (defun gnus-summary-save-article (&optional n not-saved) 10867 (defun gnus-summary-save-article (&optional n not-saved)
9139 "Save the current article using the default saver function. 10868 "Save the current article using the default saver function.
9171 (gnus-kill-buffer save-buffer) 10900 (gnus-kill-buffer save-buffer)
9172 (gnus-summary-position-point) 10901 (gnus-summary-position-point)
9173 (gnus-set-mode-line 'summary) 10902 (gnus-set-mode-line 'summary)
9174 n)) 10903 n))
9175 10904
9176 (defun gnus-summary-pipe-output (&optional arg) 10905 (defun gnus-summary-pipe-output (&optional arg headers)
9177 "Pipe the current article to a subprocess. 10906 "Pipe the current article to a subprocess.
9178 If N is a positive number, pipe the N next articles. 10907 If N is a positive number, pipe the N next articles.
9179 If N is a negative number, pipe the N previous articles. 10908 If N is a negative number, pipe the N previous articles.
9180 If N is nil and any articles have been marked with the process mark, 10909 If N is nil and any articles have been marked with the process mark,
9181 pipe those articles instead." 10910 pipe those articles instead.
9182 (interactive "P") 10911 If HEADERS (the symbolic prefix), include the headers, too."
10912 (interactive (gnus-interactive "P\ny"))
9183 (require 'gnus-art) 10913 (require 'gnus-art)
9184 (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe)) 10914 (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe)
10915 (gnus-save-all-headers (or headers gnus-save-all-headers)))
9185 (gnus-summary-save-article arg t)) 10916 (gnus-summary-save-article arg t))
9186 (gnus-configure-windows 'pipe)) 10917 (let ((buffer (get-buffer "*Shell Command Output*")))
10918 (when (and buffer
10919 (not (zerop (buffer-size buffer))))
10920 (gnus-configure-windows 'pipe))))
9187 10921
9188 (defun gnus-summary-save-article-mail (&optional arg) 10922 (defun gnus-summary-save-article-mail (&optional arg)
9189 "Append the current article to an mail file. 10923 "Append the current article to an mail file.
9190 If N is a positive number, save the N next articles. 10924 If N is a positive number, save the N next articles.
9191 If N is a negative number, save the N previous articles. 10925 If N is a negative number, save the N previous articles.
9238 (interactive "P") 10972 (interactive "P")
9239 (require 'gnus-art) 10973 (require 'gnus-art)
9240 (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file)) 10974 (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file))
9241 (gnus-summary-save-article arg))) 10975 (gnus-summary-save-article arg)))
9242 10976
10977 (defun gnus-summary-muttprint (&optional arg)
10978 "Print the current article using Muttprint.
10979 If N is a positive number, save the N next articles.
10980 If N is a negative number, save the N previous articles.
10981 If N is nil and any articles have been marked with the process mark,
10982 save those articles instead."
10983 (interactive "P")
10984 (require 'gnus-art)
10985 (let ((gnus-default-article-saver 'gnus-summary-pipe-to-muttprint))
10986 (gnus-summary-save-article arg t)))
10987
9243 (defun gnus-summary-pipe-message (program) 10988 (defun gnus-summary-pipe-message (program)
9244 "Pipe the current article through PROGRAM." 10989 "Pipe the current article through PROGRAM."
9245 (interactive "sProgram: ") 10990 (interactive "sProgram: ")
9246 (gnus-summary-select-article) 10991 (gnus-summary-select-article)
9247 (let ((mail-header-separator "")) 10992 (let ((mail-header-separator ""))
9248 (gnus-eval-in-buffer-window gnus-article-buffer 10993 (gnus-eval-in-buffer-window gnus-article-buffer
9249 (save-restriction 10994 (save-restriction
9250 (widen) 10995 (widen)
9251 (let ((start (window-start)) 10996 (let ((start (window-start))
9252 buffer-read-only) 10997 buffer-read-only)
9253 (message-pipe-buffer-body program) 10998 (message-pipe-buffer-body program)
9254 (set-window-start (get-buffer-window (current-buffer)) start)))))) 10999 (set-window-start (get-buffer-window (current-buffer)) start))))))
9255 11000
9256 (defun gnus-get-split-value (methods) 11001 (defun gnus-get-split-value (methods)
9257 "Return a value based on the split METHODS." 11002 "Return a value based on the split METHODS."
9258 (let (split-name method result match) 11003 (let (split-name method result match)
9259 (when methods 11004 (when methods
9268 (when (cond 11013 (when (cond
9269 ((stringp match) 11014 ((stringp match)
9270 ;; Regular expression. 11015 ;; Regular expression.
9271 (ignore-errors 11016 (ignore-errors
9272 (re-search-forward match nil t))) 11017 (re-search-forward match nil t)))
9273 ((gnus-functionp match) 11018 ((functionp match)
9274 ;; Function. 11019 ;; Function.
9275 (save-restriction 11020 (save-restriction
9276 (widen) 11021 (widen)
9277 (setq result (funcall match gnus-newsgroup-name)))) 11022 (setq result (funcall match gnus-newsgroup-name))))
9278 ((consp match) 11023 ((consp match)
9299 (defun gnus-read-move-group-name (prompt default articles prefix) 11044 (defun gnus-read-move-group-name (prompt default articles prefix)
9300 "Read a group name." 11045 "Read a group name."
9301 (let* ((split-name (gnus-get-split-value gnus-move-split-methods)) 11046 (let* ((split-name (gnus-get-split-value gnus-move-split-methods))
9302 (minibuffer-confirm-incomplete nil) ; XEmacs 11047 (minibuffer-confirm-incomplete nil) ; XEmacs
9303 (prom 11048 (prom
9304 (format "%s %s to:" 11049 (format "%s %s to"
9305 prompt 11050 prompt
9306 (if (> (length articles) 1) 11051 (if (> (length articles) 1)
9307 (format "these %d articles" (length articles)) 11052 (format "these %d articles" (length articles))
9308 "this article"))) 11053 "this article")))
9309 (to-newsgroup 11054 (to-newsgroup
9310 (cond 11055 (cond
9311 ((null split-name) 11056 ((null split-name)
9312 (gnus-completing-read default prom 11057 (gnus-completing-read-with-default
9313 gnus-active-hashtb 11058 default prom
9314 'gnus-valid-move-group-p 11059 gnus-active-hashtb
9315 nil prefix 11060 'gnus-valid-move-group-p
9316 'gnus-group-history)) 11061 nil prefix
11062 'gnus-group-history))
9317 ((= 1 (length split-name)) 11063 ((= 1 (length split-name))
9318 (gnus-completing-read (car split-name) prom 11064 (gnus-completing-read-with-default
9319 gnus-active-hashtb 11065 (car split-name) prom
9320 'gnus-valid-move-group-p 11066 gnus-active-hashtb
9321 nil nil 11067 'gnus-valid-move-group-p
9322 'gnus-group-history)) 11068 nil nil
11069 'gnus-group-history))
9323 (t 11070 (t
9324 (gnus-completing-read nil prom 11071 (gnus-completing-read-with-default
9325 (mapcar (lambda (el) (list el)) 11072 nil prom
9326 (nreverse split-name)) 11073 (mapcar (lambda (el) (list el))
9327 nil nil nil 11074 (nreverse split-name))
9328 'gnus-group-history)))) 11075 nil nil nil
9329 (to-method (gnus-server-to-method (gnus-group-method to-newsgroup)))) 11076 'gnus-group-history))))
11077 (to-method (gnus-server-to-method (gnus-group-method to-newsgroup))))
9330 (when to-newsgroup 11078 (when to-newsgroup
9331 (if (or (string= to-newsgroup "") 11079 (if (or (string= to-newsgroup "")
9332 (string= to-newsgroup prefix)) 11080 (string= to-newsgroup prefix))
9333 (setq to-newsgroup default)) 11081 (setq to-newsgroup default))
9334 (unless to-newsgroup 11082 (unless to-newsgroup
9363 (gnus-inhibit-treatment t)) 11111 (gnus-inhibit-treatment t))
9364 (gnus-summary-select-article)) 11112 (gnus-summary-select-article))
9365 (save-excursion 11113 (save-excursion
9366 (set-buffer gnus-article-buffer) 11114 (set-buffer gnus-article-buffer)
9367 (let ((handles (or gnus-article-mime-handles 11115 (let ((handles (or gnus-article-mime-handles
9368 (mm-dissect-buffer) (mm-uu-dissect)))) 11116 (mm-dissect-buffer nil gnus-article-loose-mime)
11117 (and gnus-article-emulate-mime
11118 (mm-uu-dissect)))))
9369 (when handles 11119 (when handles
9370 (gnus-summary-save-parts-1 type dir handles reverse) 11120 (gnus-summary-save-parts-1 type dir handles reverse)
9371 (unless gnus-article-mime-handles ;; Don't destroy this case. 11121 (unless gnus-article-mime-handles ;; Don't destroy this case.
9372 (mm-destroy-parts handles))))))) 11122 (mm-destroy-parts handles)))))))
9373 11123
9377 (cdr handle)) 11127 (cdr handle))
9378 (when (if reverse 11128 (when (if reverse
9379 (not (string-match type (mm-handle-media-type handle))) 11129 (not (string-match type (mm-handle-media-type handle)))
9380 (string-match type (mm-handle-media-type handle))) 11130 (string-match type (mm-handle-media-type handle)))
9381 (let ((file (expand-file-name 11131 (let ((file (expand-file-name
9382 (file-name-nondirectory 11132 (gnus-map-function
9383 (or 11133 mm-file-name-rewrite-functions
9384 (mail-content-type-get 11134 (file-name-nondirectory
9385 (mm-handle-disposition handle) 'filename) 11135 (or
9386 (concat gnus-newsgroup-name 11136 (mail-content-type-get
9387 "." (number-to-string 11137 (mm-handle-disposition handle) 'filename)
9388 (cdr gnus-article-current))))) 11138 (mail-content-type-get
11139 (mm-handle-type handle) 'name)
11140 (concat gnus-newsgroup-name
11141 "." (number-to-string
11142 (cdr gnus-article-current))))))
9389 dir))) 11143 dir)))
9390 (unless (file-exists-p file) 11144 (unless (file-exists-p file)
9391 (mm-save-part-to-file handle file)))))) 11145 (mm-save-part-to-file handle file))))))
9392 11146
9393 ;; Summary extract commands 11147 ;; Summary extract commands
9450 b (1- e) (list 'gnus-number gnus-reffed-article-number 11204 b (1- e) (list 'gnus-number gnus-reffed-article-number
9451 gnus-mouse-face-prop gnus-mouse-face)) 11205 gnus-mouse-face-prop gnus-mouse-face))
9452 (gnus-data-enter 11206 (gnus-data-enter
9453 after-article gnus-reffed-article-number 11207 after-article gnus-reffed-article-number
9454 gnus-unread-mark b (car pslist) 0 (- e b)) 11208 gnus-unread-mark b (car pslist) 0 (- e b))
9455 (push gnus-reffed-article-number gnus-newsgroup-unreads) 11209 (setq gnus-newsgroup-unreads
11210 (gnus-add-to-sorted-list gnus-newsgroup-unreads
11211 gnus-reffed-article-number))
9456 (setq gnus-reffed-article-number (1- gnus-reffed-article-number)) 11212 (setq gnus-reffed-article-number (1- gnus-reffed-article-number))
9457 (setq pslist (cdr pslist))))))) 11213 (setq pslist (cdr pslist)))))))
9458 11214
9459 (defun gnus-pseudos< (p1 p2) 11215 (defun gnus-pseudos< (p1 p2)
9460 (let ((c1 (cdr (assq 'action p1))) 11216 (let ((c1 (cdr (assq 'action p1)))
9516 (setq header (or header (gnus-summary-article-header id)))) 11272 (setq header (or header (gnus-summary-article-header id))))
9517 (if (and header 11273 (if (and header
9518 (not (gnus-summary-article-sparse-p (mail-header-number header)))) 11274 (not (gnus-summary-article-sparse-p (mail-header-number header))))
9519 ;; We have found the header. 11275 ;; We have found the header.
9520 header 11276 header
9521 ;; If this is a sparse article, we have to nix out its
9522 ;; previous entry in the thread hashtb.
9523 (when (and header
9524 (gnus-summary-article-sparse-p (mail-header-number header)))
9525 (let* ((parent (gnus-parent-id (mail-header-references header)))
9526 (thread (and parent (gnus-id-to-thread parent))))
9527 (when thread
9528 (delq (assq header thread) thread))))
9529 ;; We have to really fetch the header to this article. 11277 ;; We have to really fetch the header to this article.
9530 (save-excursion 11278 (save-excursion
9531 (set-buffer nntp-server-buffer) 11279 (set-buffer nntp-server-buffer)
9532 (when (setq where (gnus-request-head id group)) 11280 (when (setq where (gnus-request-head id group))
9533 (nnheader-fold-continuation-lines) 11281 (nnheader-fold-continuation-lines)
9581 (defun gnus-highlight-selected-summary () 11329 (defun gnus-highlight-selected-summary ()
9582 "Highlight selected article in summary buffer." 11330 "Highlight selected article in summary buffer."
9583 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>. 11331 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
9584 (when gnus-summary-selected-face 11332 (when gnus-summary-selected-face
9585 (save-excursion 11333 (save-excursion
9586 (let* ((beg (progn (beginning-of-line) (point))) 11334 (let* ((beg (gnus-point-at-bol))
9587 (end (progn (end-of-line) (point))) 11335 (end (gnus-point-at-eol))
9588 ;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>. 11336 ;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>.
9589 (from (if (get-text-property beg gnus-mouse-face-prop) 11337 (from (if (get-text-property beg gnus-mouse-face-prop)
9590 beg 11338 beg
9591 (or (next-single-property-change 11339 (or (next-single-property-change
9592 beg gnus-mouse-face-prop nil end) 11340 beg gnus-mouse-face-prop nil end)
9609 ;; Create new overlay. 11357 ;; Create new overlay.
9610 (gnus-overlay-put 11358 (gnus-overlay-put
9611 (setq gnus-newsgroup-selected-overlay (gnus-make-overlay from to)) 11359 (setq gnus-newsgroup-selected-overlay (gnus-make-overlay from to))
9612 'face gnus-summary-selected-face)))))) 11360 'face gnus-summary-selected-face))))))
9613 11361
9614 ;; New implementation by Christian Limpach <Christian.Limpach@nice.ch>. 11362 (defvar gnus-summary-highlight-line-cached nil)
11363 (defvar gnus-summary-highlight-line-trigger nil)
11364
11365 (defun gnus-summary-highlight-line-0 ()
11366 (if (and (eq gnus-summary-highlight-line-trigger
11367 gnus-summary-highlight)
11368 gnus-summary-highlight-line-cached)
11369 gnus-summary-highlight-line-cached
11370 (setq gnus-summary-highlight-line-trigger gnus-summary-highlight
11371 gnus-summary-highlight-line-cached
11372 (let* ((cond (list 'cond))
11373 (c cond)
11374 (list gnus-summary-highlight))
11375 (while list
11376 (setcdr c (cons (list (caar list) (list 'quote (cdar list)))
11377 nil))
11378 (setq c (cdr c)
11379 list (cdr list)))
11380 (gnus-byte-compile (list 'lambda nil cond))))))
11381
9615 (defun gnus-summary-highlight-line () 11382 (defun gnus-summary-highlight-line ()
9616 "Highlight current line according to `gnus-summary-highlight'." 11383 "Highlight current line according to `gnus-summary-highlight'."
9617 (let* ((list gnus-summary-highlight) 11384 (let* ((beg (gnus-point-at-bol))
9618 (p (point)) 11385 (article (or (gnus-summary-article-number) gnus-current-article))
9619 (end (progn (end-of-line) (point))) 11386 (score (or (cdr (assq article
9620 ;; now find out where the line starts and leave point there.
9621 (beg (progn (beginning-of-line) (point)))
9622 (article (gnus-summary-article-number))
9623 (score (or (cdr (assq (or article gnus-current-article)
9624 gnus-newsgroup-scored)) 11387 gnus-newsgroup-scored))
9625 gnus-summary-default-score 0)) 11388 gnus-summary-default-score 0))
9626 (mark (or (gnus-summary-article-mark) gnus-unread-mark)) 11389 (mark (or (gnus-summary-article-mark) gnus-unread-mark))
9627 (inhibit-read-only t)) 11390 (inhibit-read-only t)
9628 ;; Eval the cars of the lists until we find a match. 11391 (default gnus-summary-default-score)
9629 (let ((default gnus-summary-default-score)) 11392 (default-high gnus-summary-default-high-score)
9630 (while (and list 11393 (default-low gnus-summary-default-low-score)
9631 (not (eval (caar list)))) 11394 (uncached (and gnus-summary-use-undownloaded-faces
9632 (setq list (cdr list)))) 11395 (memq article gnus-newsgroup-undownloaded)
9633 (let ((face (cdar list))) 11396 (not (memq article gnus-newsgroup-cached)))))
11397 (let ((face (funcall (gnus-summary-highlight-line-0))))
9634 (unless (eq face (get-text-property beg 'face)) 11398 (unless (eq face (get-text-property beg 'face))
9635 (gnus-put-text-property-excluding-characters-with-faces 11399 (gnus-put-text-property-excluding-characters-with-faces
9636 beg end 'face 11400 beg (gnus-point-at-eol) 'face
9637 (setq face (if (boundp face) (symbol-value face) face))) 11401 (setq face (if (boundp face) (symbol-value face) face)))
9638 (when gnus-summary-highlight-line-function 11402 (when gnus-summary-highlight-line-function
9639 (funcall gnus-summary-highlight-line-function article face)))) 11403 (funcall gnus-summary-highlight-line-function article face))))))
9640 (goto-char p)))
9641 11404
9642 (defun gnus-update-read-articles (group unread &optional compute) 11405 (defun gnus-update-read-articles (group unread &optional compute)
9643 "Update the list of read articles in GROUP." 11406 "Update the list of read articles in GROUP.
11407 UNREAD is a sorted list."
9644 (let* ((active (or gnus-newsgroup-active (gnus-active group))) 11408 (let* ((active (or gnus-newsgroup-active (gnus-active group)))
9645 (entry (gnus-gethash group gnus-newsrc-hashtb)) 11409 (entry (gnus-gethash group gnus-newsrc-hashtb))
9646 (info (nth 2 entry)) 11410 (info (nth 2 entry))
9647 (prev 1) 11411 (prev 1)
9648 (unread (sort (copy-sequence unread) '<))
9649 read) 11412 read)
9650 (if (or (not info) (not active)) 11413 (if (or (not info) (not active))
9651 ;; There is no info on this group if it was, in fact, 11414 ;; There is no info on this group if it was, in fact,
9652 ;; killed. Gnus stores no information on killed groups, so 11415 ;; killed. Gnus stores no information on killed groups, so
9653 ;; there's nothing to be done. 11416 ;; there's nothing to be done.
9707 (gnus-get-unread-articles-in-group info (gnus-active group)) 11470 (gnus-get-unread-articles-in-group info (gnus-active group))
9708 t)))) 11471 t))))
9709 11472
9710 (defun gnus-offer-save-summaries () 11473 (defun gnus-offer-save-summaries ()
9711 "Offer to save all active summary buffers." 11474 "Offer to save all active summary buffers."
9712 (save-excursion 11475 (let (buffers)
9713 (let ((buflist (buffer-list)) 11476 ;; Go through all buffers and find all summaries.
9714 buffers bufname) 11477 (dolist (buffer (buffer-list))
9715 ;; Go through all buffers and find all summaries. 11478 (when (and (setq buffer (buffer-name buffer))
9716 (while buflist 11479 (string-match "Summary" buffer)
9717 (and (setq bufname (buffer-name (car buflist))) 11480 (save-excursion
9718 (string-match "Summary" bufname) 11481 (set-buffer buffer)
9719 (save-excursion 11482 ;; We check that this is, indeed, a summary buffer.
9720 (set-buffer bufname) 11483 (and (eq major-mode 'gnus-summary-mode)
9721 ;; We check that this is, indeed, a summary buffer. 11484 ;; Also make sure this isn't bogus.
9722 (and (eq major-mode 'gnus-summary-mode) 11485 gnus-newsgroup-prepared
9723 ;; Also make sure this isn't bogus. 11486 ;; Also make sure that this isn't a
9724 gnus-newsgroup-prepared 11487 ;; dead summary buffer.
9725 ;; Also make sure that this isn't a dead summary buffer. 11488 (not gnus-dead-summary-mode))))
9726 (not gnus-dead-summary-mode))) 11489 (push buffer buffers)))
9727 (push bufname buffers)) 11490 ;; Go through all these summary buffers and offer to save them.
9728 (setq buflist (cdr buflist))) 11491 (when buffers
9729 ;; Go through all these summary buffers and offer to save them. 11492 (save-excursion
9730 (when buffers
9731 (map-y-or-n-p 11493 (map-y-or-n-p
9732 "Update summary buffer %s? " 11494 "Update summary buffer %s? "
9733 (lambda (buf) 11495 (lambda (buf)
9734 (switch-to-buffer buf) 11496 (switch-to-buffer buf)
9735 (gnus-summary-exit)) 11497 (gnus-summary-exit))
9736 buffers))))) 11498 buffers)))))
9737 11499
9738 (defun gnus-summary-setup-default-charset () 11500 (defun gnus-summary-setup-default-charset ()
9739 "Setup newsgroup default charset." 11501 "Setup newsgroup default charset."
9740 (if (equal gnus-newsgroup-name "nndraft:drafts") 11502 (if (member gnus-newsgroup-name '("nndraft:delayed" "nndraft:drafts"))
9741 (setq gnus-newsgroup-charset nil) 11503 (setq gnus-newsgroup-charset nil)
9742 (let* ((name (and gnus-newsgroup-name 11504 (let* ((ignored-charsets
9743 (gnus-group-real-name gnus-newsgroup-name)))
9744 (ignored-charsets
9745 (or gnus-newsgroup-ephemeral-ignored-charsets 11505 (or gnus-newsgroup-ephemeral-ignored-charsets
9746 (append 11506 (append
9747 (and gnus-newsgroup-name 11507 (and gnus-newsgroup-name
9748 (or (gnus-group-find-parameter gnus-newsgroup-name 11508 (gnus-parameter-ignored-charsets gnus-newsgroup-name))
9749 'ignored-charsets t)
9750 (let ((alist gnus-group-ignored-charsets-alist)
9751 elem (charsets nil))
9752 (while (setq elem (pop alist))
9753 (when (and name
9754 (string-match (car elem) name))
9755 (setq alist nil
9756 charsets (cdr elem))))
9757 charsets)))
9758 gnus-newsgroup-ignored-charsets)))) 11509 gnus-newsgroup-ignored-charsets))))
9759 (setq gnus-newsgroup-charset 11510 (setq gnus-newsgroup-charset
9760 (or gnus-newsgroup-ephemeral-charset 11511 (or gnus-newsgroup-ephemeral-charset
9761 (and gnus-newsgroup-name 11512 (and gnus-newsgroup-name
9762 (or (gnus-group-find-parameter gnus-newsgroup-name 'charset) 11513 (gnus-parameter-charset gnus-newsgroup-name))
9763 (let ((alist gnus-group-charset-alist)
9764 elem charset)
9765 (while (setq elem (pop alist))
9766 (when (and name
9767 (string-match (car elem) name))
9768 (setq alist nil
9769 charset (cadr elem))))
9770 charset)))
9771 gnus-default-charset)) 11514 gnus-default-charset))
9772 (set (make-local-variable 'gnus-newsgroup-ignored-charsets) 11515 (set (make-local-variable 'gnus-newsgroup-ignored-charsets)
9773 ignored-charsets)))) 11516 ignored-charsets))))
9774 11517
9775 ;;; 11518 ;;;
9789 (defun gnus-summary-repair-multipart (article) 11532 (defun gnus-summary-repair-multipart (article)
9790 "Add a Content-Type header to a multipart article without one." 11533 "Add a Content-Type header to a multipart article without one."
9791 (interactive (list (gnus-summary-article-number))) 11534 (interactive (list (gnus-summary-article-number)))
9792 (gnus-with-article article 11535 (gnus-with-article article
9793 (message-narrow-to-head) 11536 (message-narrow-to-head)
11537 (message-remove-header "Mime-Version")
9794 (goto-char (point-max)) 11538 (goto-char (point-max))
11539 (insert "Mime-Version: 1.0\n")
9795 (widen) 11540 (widen)
9796 (when (search-forward "\n--" nil t) 11541 (when (search-forward "\n--" nil t)
9797 (let ((separator (buffer-substring (point) (gnus-point-at-eol)))) 11542 (let ((separator (buffer-substring (point) (gnus-point-at-eol))))
9798 (message-narrow-to-head) 11543 (message-narrow-to-head)
9799 (message-remove-header "Mime-Version")
9800 (message-remove-header "Content-Type") 11544 (message-remove-header "Content-Type")
9801 (goto-char (point-max)) 11545 (goto-char (point-max))
9802 (insert (format "Content-Type: multipart/mixed; boundary=\"%s\"\n" 11546 (insert (format "Content-Type: multipart/mixed; boundary=\"%s\"\n"
9803 separator)) 11547 separator))
9804 (insert "Mime-Version: 1.0\n")
9805 (widen)))) 11548 (widen))))
9806 (let (gnus-mark-article-hook) 11549 (let (gnus-mark-article-hook)
9807 (gnus-summary-select-article t t nil article))) 11550 (gnus-summary-select-article t t nil article)))
9808 11551
9809 (defun gnus-summary-toggle-display-buttonized () 11552 (defun gnus-summary-toggle-display-buttonized ()
9890 (gnus-summary-recenter) 11633 (gnus-summary-recenter)
9891 (gnus-summary-position-point) 11634 (gnus-summary-position-point)
9892 (gnus-set-mode-line 'summary) 11635 (gnus-set-mode-line 'summary)
9893 n)) 11636 n))
9894 11637
11638 (defun gnus-summary-insert-articles (articles)
11639 (when (setq articles
11640 (gnus-sorted-difference articles
11641 (mapcar (lambda (h)
11642 (mail-header-number h))
11643 gnus-newsgroup-headers)))
11644 (setq gnus-newsgroup-headers
11645 (gnus-merge 'list
11646 gnus-newsgroup-headers
11647 (gnus-fetch-headers articles)
11648 'gnus-article-sort-by-number))
11649 ;; Suppress duplicates?
11650 (when gnus-suppress-duplicates
11651 (gnus-dup-suppress-articles))
11652
11653 ;; We might want to build some more threads first.
11654 (when (and gnus-fetch-old-headers
11655 (eq gnus-headers-retrieved-by 'nov))
11656 (if (eq gnus-fetch-old-headers 'invisible)
11657 (gnus-build-all-threads)
11658 (gnus-build-old-threads)))
11659 ;; Let the Gnus agent mark articles as read.
11660 (when gnus-agent
11661 (gnus-agent-get-undownloaded-list))
11662 ;; Remove list identifiers from subject
11663 (when gnus-list-identifiers
11664 (gnus-summary-remove-list-identifiers))
11665 ;; First and last article in this newsgroup.
11666 (when gnus-newsgroup-headers
11667 (setq gnus-newsgroup-begin
11668 (mail-header-number (car gnus-newsgroup-headers))
11669 gnus-newsgroup-end
11670 (mail-header-number
11671 (gnus-last-element gnus-newsgroup-headers))))
11672 (when gnus-use-scoring
11673 (gnus-possibly-score-headers))))
11674
11675 (defun gnus-summary-insert-old-articles (&optional all)
11676 "Insert all old articles in this group.
11677 If ALL is non-nil, already read articles become readable.
11678 If ALL is a number, fetch this number of articles."
11679 (interactive "P")
11680 (prog1
11681 (let ((old (sort (mapcar 'car gnus-newsgroup-data) '<))
11682 older len)
11683 (setq older
11684 ;; Some nntp servers lie about their active range. When
11685 ;; this happens, the active range can be in the millions.
11686 ;; Use a compressed range to avoid creating a huge list.
11687 (gnus-range-difference (list gnus-newsgroup-active) old))
11688 (setq len (gnus-range-length older))
11689 (cond
11690 ((null older) nil)
11691 ((numberp all)
11692 (if (< all len)
11693 (let ((older-range (nreverse older)))
11694 (setq older nil)
11695
11696 (while (> all 0)
11697 (let* ((r (pop older-range))
11698 (min (if (numberp r) r (car r)))
11699 (max (if (numberp r) r (cdr r))))
11700 (while (and (<= min max)
11701 (> all 0))
11702 (push max older)
11703 (setq all (1- all)
11704 max (1- max))))))
11705 (setq older (gnus-uncompress-range older))))
11706 (all
11707 (setq older (gnus-uncompress-range older)))
11708 (t
11709 (when (and (numberp gnus-large-newsgroup)
11710 (> len gnus-large-newsgroup))
11711 (let* ((cursor-in-echo-area nil)
11712 (initial (gnus-parameter-large-newsgroup-initial
11713 gnus-newsgroup-name))
11714 (input
11715 (read-string
11716 (format
11717 "How many articles from %s (%s %d): "
11718 (gnus-limit-string
11719 (gnus-group-decoded-name gnus-newsgroup-name) 35)
11720 (if initial "max" "default")
11721 len)
11722 (if initial
11723 (cons (number-to-string initial)
11724 0)))))
11725 (unless (string-match "^[ \t]*$" input)
11726 (setq all (string-to-number input))
11727 (if (< all len)
11728 (let ((older-range (nreverse older)))
11729 (setq older nil)
11730
11731 (while (> all 0)
11732 (let* ((r (pop older-range))
11733 (min (if (numberp r) r (car r)))
11734 (max (if (numberp r) r (cdr r))))
11735 (while (and (<= min max)
11736 (> all 0))
11737 (push max older)
11738 (setq all (1- all)
11739 max (1- max))))))))))
11740 (setq older (gnus-uncompress-range older))))
11741 (if (not older)
11742 (message "No old news.")
11743 (gnus-summary-insert-articles older)
11744 (gnus-summary-limit (gnus-sorted-nunion old older))))
11745 (gnus-summary-position-point)))
11746
11747 (defun gnus-summary-insert-new-articles ()
11748 "Insert all new articles in this group."
11749 (interactive)
11750 (prog1
11751 (let ((old (sort (mapcar 'car gnus-newsgroup-data) '<))
11752 (old-active gnus-newsgroup-active)
11753 (nnmail-fetched-sources (list t))
11754 i new)
11755 (setq gnus-newsgroup-active
11756 (gnus-activate-group gnus-newsgroup-name 'scan))
11757 (setq i (cdr gnus-newsgroup-active))
11758 (while (> i (cdr old-active))
11759 (push i new)
11760 (decf i))
11761 (if (not new)
11762 (message "No gnus is bad news.")
11763 (gnus-summary-insert-articles new)
11764 (setq gnus-newsgroup-unreads
11765 (gnus-sorted-nunion gnus-newsgroup-unreads new))
11766 (gnus-summary-limit (gnus-sorted-nunion old new))))
11767 (gnus-summary-position-point)))
11768
9895 (gnus-summary-make-all-marking-commands) 11769 (gnus-summary-make-all-marking-commands)
9896 11770
9897 (gnus-ems-redefine) 11771 (gnus-ems-redefine)
9898 11772
9899 (provide 'gnus-sum) 11773 (provide 'gnus-sum)
9900 11774
9901 (run-hooks 'gnus-sum-load-hook) 11775 (run-hooks 'gnus-sum-load-hook)
9902 11776
11777 ;; Local Variables:
11778 ;; coding: iso-8859-1
11779 ;; End:
11780
11781 ;; arch-tag: 17c6748f-6d00-4d36-bf01-835c42f31235
9903 ;;; gnus-sum.el ends here 11782 ;;; gnus-sum.el ends here