git.chise.org Git - elisp/gnus.git-/blob - lisp/gnus-sum.el

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