cgit.sxemacs.org Git - gnus/blob - lisp/gnus-sum.el

   1 ;;; gnus-sum.el --- summary mode commands for Gnus
   2
   3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
   4 ;;   2005, 2006, 2007 Free Software Foundation, Inc.
   5
   6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   7 ;; Keywords: news
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27
  28 ;;; Code:
  29
  30 (eval-when-compile
  31   (require 'cl)
  32   (defvar tool-bar-mode))
  33
  34 (require 'gnus)
  35 (require 'gnus-group)
  36 (require 'gnus-spec)
  37 (require 'gnus-range)
  38 (require 'gnus-int)
  39 (require 'gnus-undo)
  40 (require 'gnus-util)
  41 (require 'gmm-utils)
  42 (require 'mm-decode)
  43 (require 'nnoo)
  44
  45 (autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t)
  46 (autoload 'gnus-cache-write-active "gnus-cache")
  47 (autoload 'gnus-mailing-list-insinuate "gnus-ml" nil t)
  48 (autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" nil t)
  49 (autoload 'gnus-pick-line-number "gnus-salt" nil t)
  50 (autoload 'mm-uu-dissect "mm-uu")
  51 (autoload 'gnus-article-outlook-deuglify-article "deuglify"
  52   "Deuglify broken Outlook (Express) articles and redisplay."
  53   t)
  54 (autoload 'gnus-article-outlook-unwrap-lines "deuglify" nil t)
  55 (autoload 'gnus-article-outlook-repair-attribution "deuglify" nil t)
  56 (autoload 'gnus-article-outlook-rearrange-citation "deuglify" nil t)
  57
  58 (defcustom gnus-kill-summary-on-exit t
  59   "*If non-nil, kill the summary buffer when you exit from it.
  60 If nil, the summary will become a \"*Dead Summary*\" buffer, and
  61 it will be killed sometime later."
  62   :group 'gnus-summary-exit
  63   :type 'boolean)
  64
  65 (defcustom gnus-fetch-old-headers nil
  66   "*Non-nil means that Gnus will try to build threads by grabbing old headers.
  67 If an unread article in the group refers to an older, already
  68 read (or just marked as read) article, the old article will not
  69 normally be displayed in the Summary buffer.  If this variable is
  70 t, Gnus will attempt to grab the headers to the old articles, and
  71 thereby build complete threads.  If it has the value `some', all
  72 old headers will be fetched but only enough headers to connect
  73 otherwise loose threads will be displayed.  This variable can
  74 also be a number.  In that case, no more than that number of old
  75 headers will be fetched.  If it has the value `invisible', all
  76 old headers will be fetched, but none will be displayed.
  77
  78 The server has to support NOV for any of this to work.
  79
  80 This feature can seriously impact performance it ignores all
  81 locally cached header entries."
  82   :group 'gnus-thread
  83   :type '(choice (const :tag "off" nil)
  84                  (const :tag "on" t)
  85                  (const some)
  86                  (const invisible)
  87                  number
  88                  (sexp :menu-tag "other" t)))
  89
  90 (defcustom gnus-refer-thread-limit 500
  91   "*The number of old headers to fetch when doing \\<gnus-summary-mode-map>\\[gnus-summary-refer-thread].
  92 If t, fetch all the available old headers."
  93   :group 'gnus-thread
  94   :type '(choice number
  95                  (sexp :menu-tag "other" t)))
  96
  97 (defcustom gnus-summary-make-false-root 'adopt
  98   "*nil means that Gnus won't gather loose threads.
  99 If the root of a thread has expired or been read in a previous
 100 session, the information necessary to build a complete thread has been
 101 lost.  Instead of having many small sub-threads from this original thread
 102 scattered all over the summary buffer, Gnus can gather them.
 103
 104 If non-nil, Gnus will try to gather all loose sub-threads from an
 105 original thread into one large thread.
 106
 107 If this variable is non-nil, it should be one of `none', `adopt',
 108 `dummy' or `empty'.
 109
 110 If this variable is `none', Gnus will not make a false root, but just
 111 present the sub-threads after another.
 112 If this variable is `dummy', Gnus will create a dummy root that will
 113 have all the sub-threads as children.
 114 If this variable is `adopt', Gnus will make one of the \"children\"
 115 the parent and mark all the step-children as such.
 116 If this variable is `empty', the \"children\" are printed with empty
 117 subject fields.  (Or rather, they will be printed with a string
 118 given by the `gnus-summary-same-subject' variable.)"
 119   :group 'gnus-thread
 120   :type '(choice (const :tag "off" nil)
 121                  (const none)
 122                  (const dummy)
 123                  (const adopt)
 124                  (const empty)))
 125
 126 (defcustom gnus-summary-make-false-root-always nil
 127   "Always make a false dummy root."
 128   :version "22.1"
 129   :group 'gnus-thread
 130   :type 'boolean)
 131
 132 (defcustom gnus-summary-gather-exclude-subject "^ *$\\|^(none)$"
 133   "*A regexp to match subjects to be excluded from loose thread gathering.
 134 As loose thread gathering is done on subjects only, that means that
 135 there can be many false gatherings performed.  By rooting out certain
 136 common subjects, gathering might become saner."
 137   :group 'gnus-thread
 138   :type 'regexp)
 139
 140 (defcustom gnus-summary-gather-subject-limit nil
 141   "*Maximum length of subject comparisons when gathering loose threads.
 142 Use nil to compare full subjects.  Setting this variable to a low
 143 number will help gather threads that have been corrupted by
 144 newsreaders chopping off subject lines, but it might also mean that
 145 unrelated articles that have subject that happen to begin with the
 146 same few characters will be incorrectly gathered.
 147
 148 If this variable is `fuzzy', Gnus will use a fuzzy algorithm when
 149 comparing subjects."
 150   :group 'gnus-thread
 151   :type '(choice (const :tag "off" nil)
 152                  (const fuzzy)
 153                  (sexp :menu-tag "on" t)))
 154
 155 (defcustom gnus-simplify-subject-functions nil
 156   "List of functions taking a string argument that simplify subjects.
 157 The functions are applied recursively.
 158
 159 Useful functions to put in this list include:
 160 `gnus-simplify-subject-re', `gnus-simplify-subject-fuzzy',
 161 `gnus-simplify-whitespace', and `gnus-simplify-all-whitespace'."
 162   :group 'gnus-thread
 163   :type '(repeat function))
 164
 165 (defcustom gnus-simplify-ignored-prefixes nil
 166   "*Remove matches for this regexp from subject lines when simplifying fuzzily."
 167   :group 'gnus-thread
 168   :type '(choice (const :tag "off" nil)
 169                  regexp))
 170
 171 (defcustom gnus-build-sparse-threads nil
 172   "*If non-nil, fill in the gaps in threads.
 173 If `some', only fill in the gaps that are needed to tie loose threads
 174 together.  If `more', fill in all leaf nodes that Gnus can find.  If
 175 non-nil and non-`some', fill in all gaps that Gnus manages to guess."
 176   :group 'gnus-thread
 177   :type '(choice (const :tag "off" nil)
 178                  (const some)
 179                  (const more)
 180                  (sexp :menu-tag "all" t)))
 181
 182 (defcustom gnus-summary-thread-gathering-function
 183   'gnus-gather-threads-by-subject
 184   "*Function used for gathering loose threads.
 185 There are two pre-defined functions: `gnus-gather-threads-by-subject',
 186 which only takes Subjects into consideration; and
 187 `gnus-gather-threads-by-references', which compared the References
 188 headers of the articles to find matches."
 189   :group 'gnus-thread
 190   :type '(radio (function-item gnus-gather-threads-by-subject)
 191                 (function-item gnus-gather-threads-by-references)
 192                 (function :tag "other")))
 193
 194 (defcustom gnus-summary-same-subject ""
 195   "*String indicating that the current article has the same subject as the previous.
 196 This variable will only be used if the value of
 197 `gnus-summary-make-false-root' is `empty'."
 198   :group 'gnus-summary-format
 199   :type 'string)
 200
 201 (defcustom gnus-summary-goto-unread t
 202   "*If t, many commands will go to the next unread article.
 203 This applies to marking commands as well as other commands that
 204 \"naturally\" select the next article, like, for instance, `SPC' at
 205 the end of an article.
 206
 207 If nil, the marking commands do NOT go to the next unread article
 208 \(they go to the next article instead).  If `never', commands that
 209 usually go to the next unread article, will go to the next article,
 210 whether it is read or not."
 211   :group 'gnus-summary-marks
 212   :link '(custom-manual "(gnus)Setting Marks")
 213   :type '(choice (const :tag "off" nil)
 214                  (const never)
 215                  (sexp :menu-tag "on" t)))
 216
 217 (defcustom gnus-summary-default-score 0
 218   "*Default article score level.
 219 All scores generated by the score files will be added to this score.
 220 If this variable is nil, scoring will be disabled."
 221   :group 'gnus-score-default
 222   :type '(choice (const :tag "disable")
 223                  integer))
 224
 225 (defcustom gnus-summary-default-high-score 0
 226   "*Default threshold for a high scored article.
 227 An article will be highlighted as high scored if its score is greater
 228 than this score."
 229   :version "22.1"
 230   :group 'gnus-score-default
 231   :type 'integer)
 232
 233 (defcustom gnus-summary-default-low-score 0
 234   "*Default threshold for a low scored article.
 235 An article will be highlighted as low scored if its score is smaller
 236 than this score."
 237   :version "22.1"
 238   :group 'gnus-score-default
 239   :type 'integer)
 240
 241 (defcustom gnus-summary-zcore-fuzz 0
 242   "*Fuzziness factor for the zcore in the summary buffer.
 243 Articles with scores closer than this to `gnus-summary-default-score'
 244 will not be marked."
 245   :group 'gnus-summary-format
 246   :type 'integer)
 247
 248 (defcustom gnus-simplify-subject-fuzzy-regexp nil
 249   "*Strings to be removed when doing fuzzy matches.
 250 This can either be a regular expression or list of regular expressions
 251 that will be removed from subject strings if fuzzy subject
 252 simplification is selected."
 253   :group 'gnus-thread
 254   :type '(repeat regexp))
 255
 256 (defcustom gnus-show-threads t
 257   "*If non-nil, display threads in summary mode."
 258   :group 'gnus-thread
 259   :type 'boolean)
 260
 261 (defcustom gnus-thread-hide-subtree nil
 262   "*If non-nil, hide all threads initially.
 263 This can be a predicate specifier which says which threads to hide.
 264 If threads are hidden, you have to run the command
 265 `gnus-summary-show-thread' by hand or select an article."
 266   :group 'gnus-thread
 267   :type '(radio (sexp :format "Non-nil\n"
 268                       :match (lambda (widget value)
 269                                (not (or (consp value) (functionp value))))
 270                       :value t)
 271                 (const nil)
 272                 (sexp :tag "Predicate specifier")))
 273
 274 (defcustom gnus-thread-hide-killed t
 275   "*If non-nil, hide killed threads automatically."
 276   :group 'gnus-thread
 277   :type 'boolean)
 278
 279 (defcustom gnus-thread-ignore-subject t
 280   "*If non-nil, which is the default, ignore subjects and do all threading based on the Reference header.
 281 If nil, articles that have different subjects from their parents will
 282 start separate threads."
 283   :group 'gnus-thread
 284   :type 'boolean)
 285
 286 (defcustom gnus-thread-operation-ignore-subject t
 287   "*If non-nil, subjects will be ignored when doing thread commands.
 288 This affects commands like `gnus-summary-kill-thread' and
 289 `gnus-summary-lower-thread'.
 290
 291 If this variable is nil, articles in the same thread with different
 292 subjects will not be included in the operation in question.  If this
 293 variable is `fuzzy', only articles that have subjects that are fuzzily
 294 equal will be included."
 295   :group 'gnus-thread
 296   :type '(choice (const :tag "off" nil)
 297                  (const fuzzy)
 298                  (sexp :tag "on" t)))
 299
 300 (defcustom gnus-thread-indent-level 4
 301   "*Number that says how much each sub-thread should be indented."
 302   :group 'gnus-thread
 303   :type 'integer)
 304
 305 (defcustom gnus-auto-extend-newsgroup t
 306   "*If non-nil, extend newsgroup forward and backward when requested."
 307   :group 'gnus-summary-choose
 308   :type 'boolean)
 309
 310 (defcustom gnus-auto-select-first t
 311   "If non-nil, select an article on group entry.
 312 An article is selected automatically when entering a group
 313 e.g. with \\<gnus-group-mode-map>\\[gnus-group-read-group], or via `gnus-summary-next-page' or
 314 `gnus-summary-catchup-and-goto-next-group'.
 315
 316 Which article is selected is controlled by the variable
 317 `gnus-auto-select-subject'.
 318
 319 If you want to prevent automatic selection of articles in some
 320 newsgroups, set the variable to nil in `gnus-select-group-hook'."
 321   ;; Commands include...
 322   ;; \\<gnus-group-mode-map>\\[gnus-group-read-group]
 323   ;; \\<gnus-summary-mode-map>\\[gnus-summary-next-page]
 324   ;; \\<gnus-summary-mode-map>\\[gnus-summary-catchup-and-goto-next-group]
 325   :group 'gnus-group-select
 326   :type '(choice (const :tag "none" nil)
 327                  (sexp :menu-tag "first" t)))
 328
 329 (defcustom gnus-auto-select-subject 'unread
 330   "*Says what subject to place under point when entering a group.
 331
 332 This variable can either be the symbols `first' (place point on the
 333 first subject), `unread' (place point on the subject line of the first
 334 unread article), `best' (place point on the subject line of the
 335 higest-scored article), `unseen' (place point on the subject line of
 336 the first unseen article), `unseen-or-unread' (place point on the subject
 337 line of the first unseen article or, if all article have been seen, on the
 338 subject line of the first unread article), or a function to be called to
 339 place point on some subject line."
 340   :version "22.1"
 341   :group 'gnus-group-select
 342   :type '(choice (const best)
 343                  (const unread)
 344                  (const first)
 345                  (const unseen)
 346                  (const unseen-or-unread)))
 347
 348 (defcustom gnus-auto-select-next t
 349   "*If non-nil, offer to go to the next group from the end of the previous.
 350 If the value is t and the next newsgroup is empty, Gnus will exit
 351 summary mode and go back to group mode.  If the value is neither nil
 352 nor t, Gnus will select the following unread newsgroup.  In
 353 particular, if the value is the symbol `quietly', the next unread
 354 newsgroup will be selected without any confirmation, and if it is
 355 `almost-quietly', the next group will be selected without any
 356 confirmation if you are located on the last article in the group.
 357 Finally, if this variable is `slightly-quietly', the `\\<gnus-summary-mode-map>\\[gnus-summary-catchup-and-goto-next-group]' command
 358 will go to the next group without confirmation."
 359   :group 'gnus-summary-maneuvering
 360   :type '(choice (const :tag "off" nil)
 361                  (const quietly)
 362                  (const almost-quietly)
 363                  (const slightly-quietly)
 364                  (sexp :menu-tag "on" t)))
 365
 366 (defcustom gnus-auto-select-same nil
 367   "*If non-nil, select the next article with the same subject.
 368 If there are no more articles with the same subject, go to
 369 the first unread article."
 370   :group 'gnus-summary-maneuvering
 371   :type 'boolean)
 372
 373 (defcustom gnus-auto-goto-ignores 'unfetched
 374   "*Says how to handle unfetched articles when maneuvering.
 375
 376 This variable can either be the symbols nil (maneuver to any
 377 article), `undownloaded' (maneuvering while unplugged ignores articles
 378 that have not been fetched), `always-undownloaded' (maneuvering always
 379 ignores articles that have not been fetched), `unfetched' (maneuvering
 380 ignores articles whose headers have not been fetched).
 381
 382 NOTE: The list of unfetched articles will always be nil when plugged
 383 and, when unplugged, a subset of the undownloaded article list."
 384   :version "22.1"
 385   :group 'gnus-summary-maneuvering
 386   :type '(choice (const :tag "None" nil)
 387                  (const :tag "Undownloaded when unplugged" undownloaded)
 388                  (const :tag "Undownloaded" always-undownloaded)
 389                  (const :tag "Unfetched" unfetched)))
 390
 391 (defcustom gnus-summary-check-current nil
 392   "*If non-nil, consider the current article when moving.
 393 The \"unread\" movement commands will stay on the same line if the
 394 current article is unread."
 395   :group 'gnus-summary-maneuvering
 396   :type 'boolean)
 397
 398 (defcustom gnus-auto-center-summary 2
 399   "*If non-nil, always center the current summary buffer.
 400 In particular, if `vertical' do only vertical recentering.  If non-nil
 401 and non-`vertical', do both horizontal and vertical recentering."
 402   :group 'gnus-summary-maneuvering
 403   :type '(choice (const :tag "none" nil)
 404                  (const vertical)
 405                  (integer :tag "height")
 406                  (sexp :menu-tag "both" t)))
 407
 408 (defvar gnus-auto-center-group t
 409   "*If non-nil, always center the group buffer.")
 410
 411 (defcustom gnus-show-all-headers nil
 412   "*If non-nil, don't hide any headers."
 413   :group 'gnus-article-hiding
 414   :group 'gnus-article-headers
 415   :type 'boolean)
 416
 417 (defcustom gnus-summary-ignore-duplicates nil
 418   "*If non-nil, ignore articles with identical Message-ID headers."
 419   :group 'gnus-summary
 420   :type 'boolean)
 421
 422 (defcustom gnus-single-article-buffer t
 423   "*If non-nil, display all articles in the same buffer.
 424 If nil, each group will get its own article buffer."
 425   :group 'gnus-article-various
 426   :type 'boolean)
 427
 428 (defcustom gnus-break-pages t
 429   "*If non-nil, do page breaking on articles.
 430 The page delimiter is specified by the `gnus-page-delimiter'
 431 variable."
 432   :group 'gnus-article-various
 433   :type 'boolean)
 434
 435 (defcustom gnus-move-split-methods nil
 436   "*Variable used to suggest where articles are to be moved to.
 437 It uses the same syntax as the `gnus-split-methods' variable.
 438 However, whereas `gnus-split-methods' specifies file names as targets,
 439 this variable specifies group names."
 440   :group 'gnus-summary-mail
 441   :type '(repeat (choice (list :value (fun) function)
 442                          (cons :value ("" "") regexp (repeat string))
 443                          (sexp :value nil))))
 444
 445 (defcustom gnus-move-group-prefix-function 'gnus-group-real-prefix
 446   "Function used to compute default prefix for article move/copy/etc prompts.
 447 The function should take one argument, a group name, and return a
 448 string with the suggested prefix."
 449   :group 'gnus-summary-mail
 450   :type 'function)
 451
 452 ;; FIXME: Although the custom type is `character' for the following variables,
 453 ;; using multibyte characters (Latin-1, UTF-8) doesn't work.  -- rs
 454
 455 (defcustom gnus-unread-mark ?           ;Whitespace
 456   "*Mark used for unread articles."
 457   :group 'gnus-summary-marks
 458   :type 'character)
 459
 460 (defcustom gnus-ticked-mark ?!
 461   "*Mark used for ticked articles."
 462   :group 'gnus-summary-marks
 463   :type 'character)
 464
 465 (defcustom gnus-dormant-mark ??
 466   "*Mark used for dormant articles."
 467   :group 'gnus-summary-marks
 468   :type 'character)
 469
 470 (defcustom gnus-del-mark ?r
 471   "*Mark used for del'd articles."
 472   :group 'gnus-summary-marks
 473   :type 'character)
 474
 475 (defcustom gnus-read-mark ?R
 476   "*Mark used for read articles."
 477   :group 'gnus-summary-marks
 478   :type 'character)
 479
 480 (defcustom gnus-expirable-mark ?E
 481   "*Mark used for expirable articles."
 482   :group 'gnus-summary-marks
 483   :type 'character)
 484
 485 (defcustom gnus-killed-mark ?K
 486   "*Mark used for killed articles."
 487   :group 'gnus-summary-marks
 488   :type 'character)
 489
 490 (defcustom gnus-spam-mark ?$
 491   "*Mark used for spam articles."
 492   :version "22.1"
 493   :group 'gnus-summary-marks
 494   :type 'character)
 495
 496 (defcustom gnus-souped-mark ?F
 497   "*Mark used for souped articles."
 498   :group 'gnus-summary-marks
 499   :type 'character)
 500
 501 (defcustom gnus-kill-file-mark ?X
 502   "*Mark used for articles killed by kill files."
 503   :group 'gnus-summary-marks
 504   :type 'character)
 505
 506 (defcustom gnus-low-score-mark ?Y
 507   "*Mark used for articles with a low score."
 508   :group 'gnus-summary-marks
 509   :type 'character)
 510
 511 (defcustom gnus-catchup-mark ?C
 512   "*Mark used for articles that are caught up."
 513   :group 'gnus-summary-marks
 514   :type 'character)
 515
 516 (defcustom gnus-replied-mark ?A
 517   "*Mark used for articles that have been replied to."
 518   :group 'gnus-summary-marks
 519   :type 'character)
 520
 521 (defcustom gnus-forwarded-mark ?F
 522   "*Mark used for articles that have been forwarded."
 523   :version "22.1"
 524   :group 'gnus-summary-marks
 525   :type 'character)
 526
 527 (defcustom gnus-recent-mark ?N
 528   "*Mark used for articles that are recent."
 529   :version "22.1"
 530   :group 'gnus-summary-marks
 531   :type 'character)
 532
 533 (defcustom gnus-cached-mark ?*
 534   "*Mark used for articles that are in the cache."
 535   :group 'gnus-summary-marks
 536   :type 'character)
 537
 538 (defcustom gnus-saved-mark ?S
 539   "*Mark used for articles that have been saved."
 540   :group 'gnus-summary-marks
 541   :type 'character)
 542
 543 (defcustom gnus-unseen-mark ?.
 544   "*Mark used for articles that haven't been seen."
 545   :version "22.1"
 546   :group 'gnus-summary-marks
 547   :type 'character)
 548
 549 (defcustom gnus-no-mark ?               ;Whitespace
 550   "*Mark used for articles that have no other secondary mark."
 551   :version "22.1"
 552   :group 'gnus-summary-marks
 553   :type 'character)
 554
 555 (defcustom gnus-ancient-mark ?O
 556   "*Mark used for ancient articles."
 557   :group 'gnus-summary-marks
 558   :type 'character)
 559
 560 (defcustom gnus-sparse-mark ?Q
 561   "*Mark used for sparsely reffed articles."
 562   :group 'gnus-summary-marks
 563   :type 'character)
 564
 565 (defcustom gnus-canceled-mark ?G
 566   "*Mark used for canceled articles."
 567   :group 'gnus-summary-marks
 568   :type 'character)
 569
 570 (defcustom gnus-duplicate-mark ?M
 571   "*Mark used for duplicate articles."
 572   :group 'gnus-summary-marks
 573   :type 'character)
 574
 575 (defcustom gnus-undownloaded-mark ?-
 576   "*Mark used for articles that weren't downloaded."
 577   :version "22.1"
 578   :group 'gnus-summary-marks
 579   :type 'character)
 580
 581 (defcustom gnus-downloaded-mark ?+
 582   "*Mark used for articles that were downloaded."
 583   :group 'gnus-summary-marks
 584   :type 'character)
 585
 586 (defcustom gnus-downloadable-mark ?%
 587   "*Mark used for articles that are to be downloaded."
 588   :group 'gnus-summary-marks
 589   :type 'character)
 590
 591 (defcustom gnus-unsendable-mark ?=
 592   "*Mark used for articles that won't be sent."
 593   :group 'gnus-summary-marks
 594   :type 'character)
 595
 596 (defcustom gnus-score-over-mark ?+
 597   "*Score mark used for articles with high scores."
 598   :group 'gnus-summary-marks
 599   :type 'character)
 600
 601 (defcustom gnus-score-below-mark ?-
 602   "*Score mark used for articles with low scores."
 603   :group 'gnus-summary-marks
 604   :type 'character)
 605
 606 (defcustom gnus-empty-thread-mark ?     ;Whitespace
 607   "*There is no thread under the article."
 608   :group 'gnus-summary-marks
 609   :type 'character)
 610
 611 (defcustom gnus-not-empty-thread-mark ?=
 612   "*There is a thread under the article."
 613   :group 'gnus-summary-marks
 614   :type 'character)
 615
 616 (defcustom gnus-view-pseudo-asynchronously nil
 617   "*If non-nil, Gnus will view pseudo-articles asynchronously."
 618   :group 'gnus-extract-view
 619   :type 'boolean)
 620
 621 (defcustom gnus-auto-expirable-marks
 622   (list gnus-killed-mark gnus-del-mark gnus-catchup-mark
 623         gnus-low-score-mark gnus-ancient-mark gnus-read-mark
 624         gnus-souped-mark gnus-duplicate-mark)
 625   "*The list of marks converted into expiration if a group is auto-expirable."
 626   :version "21.1"
 627   :group 'gnus-summary
 628   :type '(repeat character))
 629
 630 (defcustom gnus-inhibit-user-auto-expire t
 631   "*If non-nil, user marking commands will not mark an article as expirable, even if the group has auto-expire turned on."
 632   :version "21.1"
 633   :group 'gnus-summary
 634   :type 'boolean)
 635
 636 (defcustom gnus-view-pseudos nil
 637   "*If `automatic', pseudo-articles will be viewed automatically.
 638 If `not-confirm', pseudos will be viewed automatically, and the user
 639 will not be asked to confirm the command."
 640   :group 'gnus-extract-view
 641   :type '(choice (const :tag "off" nil)
 642                  (const automatic)
 643                  (const not-confirm)))
 644
 645 (defcustom gnus-view-pseudos-separately t
 646   "*If non-nil, one pseudo-article will be created for each file to be viewed.
 647 If nil, all files that use the same viewing command will be given as a
 648 list of parameters to that command."
 649   :group 'gnus-extract-view
 650   :type 'boolean)
 651
 652 (defcustom gnus-insert-pseudo-articles t
 653   "*If non-nil, insert pseudo-articles when decoding articles."
 654   :group 'gnus-extract-view
 655   :type 'boolean)
 656
 657 (defcustom gnus-summary-dummy-line-format
 658   "   %(:                             :%) %S\n"
 659   "*The format specification for the dummy roots in the summary buffer.
 660 It works along the same lines as a normal formatting string,
 661 with some simple extensions.
 662
 663 %S  The subject
 664
 665 General format specifiers can also be used.
 666 See `(gnus)Formatting Variables'."
 667   :link '(custom-manual "(gnus)Formatting Variables")
 668   :group 'gnus-threading
 669   :type 'string)
 670
 671 (defcustom gnus-summary-mode-line-format "Gnus: %g [%A] %Z"
 672   "*The format specification for the summary mode line.
 673 It works along the same lines as a normal formatting string,
 674 with some simple extensions:
 675
 676 %G  Group name
 677 %p  Unprefixed group name
 678 %A  Current article number
 679 %z  Current article score
 680 %V  Gnus version
 681 %U  Number of unread articles in the group
 682 %e  Number of unselected articles in the group
 683 %Z  A string with unread/unselected article counts
 684 %g  Shortish group name
 685 %S  Subject of the current article
 686 %u  User-defined spec
 687 %s  Current score file name
 688 %d  Number of dormant articles
 689 %r  Number of articles that have been marked as read in this session
 690 %E  Number of articles expunged by the score files"
 691   :group 'gnus-summary-format
 692   :type 'string)
 693
 694 (defcustom gnus-list-identifiers nil
 695   "Regexp that matches list identifiers to be removed from subject.
 696 This can also be a list of regexps."
 697   :version "21.1"
 698   :group 'gnus-summary-format
 699   :group 'gnus-article-hiding
 700   :type '(choice (const :tag "none" nil)
 701                  (regexp :value ".*")
 702                  (repeat :value (".*") regexp)))
 703
 704 (defcustom gnus-summary-mark-below 0
 705   "*Mark all articles with a score below this variable as read.
 706 This variable is local to each summary buffer and usually set by the
 707 score file."
 708   :group 'gnus-score-default
 709   :type 'integer)
 710
 711 (defun gnus-widget-reversible-match (widget value)
 712   "Ignoring WIDGET, convert VALUE to internal form.
 713 VALUE should have the form `FOO' or `(not FOO)', where FOO is an symbol."
 714   ;; (debug value)
 715   (or (symbolp value)
 716       (and (listp value)
 717            (eq (length value) 2)
 718            (eq (nth 0 value) 'not)
 719            (symbolp (nth 1 value)))))
 720
 721 (defun gnus-widget-reversible-to-internal (widget value)
 722   "Ignoring WIDGET, convert VALUE to internal form.
 723 VALUE should have the form `FOO' or `(not FOO)', where FOO is an atom.
 724 FOO is converted to (FOO nil) and (not FOO) is converted to (FOO t)."
 725   ;; (debug value)
 726   (if (atom value)
 727       (list value nil)
 728     (list (nth 1 value) t)))
 729
 730 (defun gnus-widget-reversible-to-external (widget value)
 731   "Ignoring WIDGET, convert VALUE to external form.
 732 VALUE should have the form `(FOO nil)' or `(FOO t)', where FOO is an atom.
 733 \(FOO  nil) is converted to FOO and (FOO t) is converted to (not FOO)."
 734   ;; (debug value)
 735   (if (nth 1 value)
 736       (list 'not (nth 0 value))
 737     (nth 0 value)))
 738
 739 (define-widget 'gnus-widget-reversible 'group
 740   "A `group' that convert values."
 741   :match 'gnus-widget-reversible-match
 742   :value-to-internal 'gnus-widget-reversible-to-internal
 743   :value-to-external 'gnus-widget-reversible-to-external)
 744
 745 (defcustom gnus-article-sort-functions '(gnus-article-sort-by-number)
 746   "*List of functions used for sorting articles in the summary buffer.
 747
 748 Each function takes two articles and returns non-nil if the first
 749 article should be sorted before the other.  If you use more than one
 750 function, the primary sort function should be the last.  You should
 751 probably always include `gnus-article-sort-by-number' in the list of
 752 sorting functions -- preferably first.  Also note that sorting by date
 753 is often much slower than sorting by number, and the sorting order is
 754 very similar.  (Sorting by date means sorting by the time the message
 755 was sent, sorting by number means sorting by arrival time.)
 756
 757 Each item can also be a list `(not F)' where F is a function;
 758 this reverses the sort order.
 759
 760 Ready-made functions include `gnus-article-sort-by-number',
 761 `gnus-article-sort-by-author', `gnus-article-sort-by-subject',
 762 `gnus-article-sort-by-date', `gnus-article-sort-by-random'
 763 and `gnus-article-sort-by-score'.
 764
 765 When threading is turned on, the variable `gnus-thread-sort-functions'
 766 controls how articles are sorted."
 767   :group 'gnus-summary-sort
 768   :type '(repeat (gnus-widget-reversible
 769                   (choice (function-item gnus-article-sort-by-number)
 770                           (function-item gnus-article-sort-by-author)
 771                           (function-item gnus-article-sort-by-subject)
 772                           (function-item gnus-article-sort-by-date)
 773                           (function-item gnus-article-sort-by-score)
 774                           (function-item gnus-article-sort-by-random)
 775                           (function :tag "other"))
 776                   (boolean :tag "Reverse order"))))
 777
 778
 779 (defcustom gnus-thread-sort-functions '(gnus-thread-sort-by-number)
 780   "*List of functions used for sorting threads in the summary buffer.
 781 By default, threads are sorted by article number.
 782
 783 Each function takes two threads and returns non-nil if the first
 784 thread should be sorted before the other.  If you use more than one
 785 function, the primary sort function should be the last.  You should
 786 probably always include `gnus-thread-sort-by-number' in the list of
 787 sorting functions -- preferably first.  Also note that sorting by date
 788 is often much slower than sorting by number, and the sorting order is
 789 very similar.  (Sorting by date means sorting by the time the message
 790 was sent, sorting by number means sorting by arrival time.)
 791
 792 Each list item can also be a list `(not F)' where F is a
 793 function; this specifies reversed sort order.
 794
 795 Ready-made functions include `gnus-thread-sort-by-number',
 796 `gnus-thread-sort-by-author', `gnus-thread-sort-by-recipient'
 797 `gnus-thread-sort-by-subject', `gnus-thread-sort-by-date',
 798 `gnus-thread-sort-by-score', `gnus-thread-sort-by-most-recent-number',
 799 `gnus-thread-sort-by-most-recent-date', `gnus-thread-sort-by-random',
 800 and `gnus-thread-sort-by-total-score' (see
 801 `gnus-thread-score-function').
 802
 803 When threading is turned off, the variable
 804 `gnus-article-sort-functions' controls how articles are sorted."
 805   :group 'gnus-summary-sort
 806   :type '(repeat
 807           (gnus-widget-reversible
 808            (choice (function-item gnus-thread-sort-by-number)
 809                    (function-item gnus-thread-sort-by-author)
 810                    (function-item gnus-thread-sort-by-recipient)
 811                    (function-item gnus-thread-sort-by-subject)
 812                    (function-item gnus-thread-sort-by-date)
 813                    (function-item gnus-thread-sort-by-score)
 814                    (function-item gnus-thread-sort-by-most-recent-number)
 815                    (function-item gnus-thread-sort-by-most-recent-date)
 816                    (function-item gnus-thread-sort-by-random)
 817                    (function-item gnus-thread-sort-by-total-score)
 818                    (function :tag "other"))
 819            (boolean :tag "Reverse order"))))
 820
 821 (defcustom gnus-thread-score-function '+
 822   "*Function used for calculating the total score of a thread.
 823
 824 The function is called with the scores of the article and each
 825 subthread and should then return the score of the thread.
 826
 827 Some functions you can use are `+', `max', or `min'."
 828   :group 'gnus-summary-sort
 829   :type 'function)
 830
 831 (defcustom gnus-summary-expunge-below nil
 832   "All articles that have a score less than this variable will be expunged.
 833 This variable is local to the summary buffers."
 834   :group 'gnus-score-default
 835   :type '(choice (const :tag "off" nil)
 836                  integer))
 837
 838 (defcustom gnus-thread-expunge-below nil
 839   "All threads that have a total score less than this variable will be expunged.
 840 See `gnus-thread-score-function' for en explanation of what a
 841 \"thread score\" is.
 842
 843 This variable is local to the summary buffers."
 844   :group 'gnus-threading
 845   :group 'gnus-score-default
 846   :type '(choice (const :tag "off" nil)
 847                  integer))
 848
 849 (defcustom gnus-summary-mode-hook nil
 850   "*A hook for Gnus summary mode.
 851 This hook is run before any variables are set in the summary buffer."
 852   :options '(turn-on-gnus-mailing-list-mode gnus-pick-mode)
 853   :group 'gnus-summary-various
 854   :type 'hook)
 855
 856 ;; Extracted from gnus-xmas-redefine in order to preserve user settings
 857 (when (featurep 'xemacs)
 858   (add-hook 'gnus-summary-mode-hook 'gnus-xmas-summary-menu-add)
 859   (add-hook 'gnus-summary-mode-hook 'gnus-xmas-setup-summary-toolbar)
 860   (add-hook 'gnus-summary-mode-hook
 861             'gnus-xmas-switch-horizontal-scrollbar-off))
 862
 863 (defcustom gnus-summary-menu-hook nil
 864   "*Hook run after the creation of the summary mode menu."
 865   :group 'gnus-summary-visual
 866   :type 'hook)
 867
 868 (defcustom gnus-summary-exit-hook nil
 869   "*A hook called on exit from the summary buffer.
 870 It will be called with point in the group buffer."
 871   :group 'gnus-summary-exit
 872   :type 'hook)
 873
 874 (defcustom gnus-summary-prepare-hook nil
 875   "*A hook called after the summary buffer has been generated.
 876 If you want to modify the summary buffer, you can use this hook."
 877   :group 'gnus-summary-various
 878   :type 'hook)
 879
 880 (defcustom gnus-summary-prepared-hook nil
 881   "*A hook called as the last thing after the summary buffer has been generated."
 882   :group 'gnus-summary-various
 883   :type 'hook)
 884
 885 (defcustom gnus-summary-generate-hook nil
 886   "*A hook run just before generating the summary buffer.
 887 This hook is commonly used to customize threading variables and the
 888 like."
 889   :group 'gnus-summary-various
 890   :type 'hook)
 891
 892 (defcustom gnus-select-group-hook nil
 893   "*A hook called when a newsgroup is selected.
 894
 895 If you'd like to simplify subjects like the
 896 `gnus-summary-next-same-subject' command does, you can use the
 897 following hook:
 898
 899  (add-hook gnus-select-group-hook
 900            (lambda ()
 901              (mapcar (lambda (header)
 902                        (mail-header-set-subject
 903                         header
 904                         (gnus-simplify-subject
 905                          (mail-header-subject header) 're-only)))
 906                      gnus-newsgroup-headers)))"
 907   :group 'gnus-group-select
 908   :type 'hook)
 909
 910 (defcustom gnus-select-article-hook nil
 911   "*A hook called when an article is selected."
 912   :group 'gnus-summary-choose
 913   :options '(gnus-agent-fetch-selected-article)
 914   :type 'hook)
 915
 916 (defcustom gnus-visual-mark-article-hook
 917   (list 'gnus-highlight-selected-summary)
 918   "*Hook run after selecting an article in the summary buffer.
 919 It is meant to be used for highlighting the article in some way.  It
 920 is not run if `gnus-visual' is nil."
 921   :group 'gnus-summary-visual
 922   :type 'hook)
 923
 924 (defcustom gnus-parse-headers-hook nil
 925   "*A hook called before parsing the headers."
 926   :group 'gnus-various
 927   :type 'hook)
 928
 929 (defcustom gnus-exit-group-hook nil
 930   "*A hook called when exiting summary mode.
 931 This hook is not called from the non-updating exit commands like `Q'."
 932   :group 'gnus-various
 933   :type 'hook)
 934
 935 (defcustom gnus-summary-update-hook
 936   (list 'gnus-summary-highlight-line)
 937   "*A hook called when a summary line is changed.
 938 The hook will not be called if `gnus-visual' is nil.
 939
 940 The default function `gnus-summary-highlight-line' will
 941 highlight the line according to the `gnus-summary-highlight'
 942 variable."
 943   :group 'gnus-summary-visual
 944   :type 'hook)
 945
 946 (defcustom gnus-mark-article-hook '(gnus-summary-mark-read-and-unread-as-read)
 947   "*A hook called when an article is selected for the first time.
 948 The hook is intended to mark an article as read (or unread)
 949 automatically when it is selected."
 950   :group 'gnus-summary-choose
 951   :type 'hook)
 952
 953 (defcustom gnus-group-no-more-groups-hook nil
 954   "*A hook run when returning to group mode having no more (unread) groups."
 955   :group 'gnus-group-select
 956   :type 'hook)
 957
 958 (defcustom gnus-ps-print-hook nil
 959   "*A hook run before ps-printing something from Gnus."
 960   :group 'gnus-summary
 961   :type 'hook)
 962
 963 (defcustom gnus-summary-article-move-hook nil
 964   "*A hook called after an article is moved, copied, respooled, or crossposted."
 965   :version "22.1"
 966   :group 'gnus-summary
 967   :type 'hook)
 968
 969 (defcustom gnus-summary-article-delete-hook nil
 970   "*A hook called after an article is deleted."
 971   :version "22.1"
 972   :group 'gnus-summary
 973   :type 'hook)
 974
 975 (defcustom gnus-summary-article-expire-hook nil
 976   "*A hook called after an article is expired."
 977   :version "22.1"
 978   :group 'gnus-summary
 979   :type 'hook)
 980
 981 (defcustom gnus-summary-display-arrow
 982   (and (fboundp 'display-graphic-p)
 983        (display-graphic-p))
 984   "*If non-nil, display an arrow highlighting the current article."
 985   :version "22.1"
 986   :group 'gnus-summary
 987   :type 'boolean)
 988
 989 (defcustom gnus-summary-selected-face 'gnus-summary-selected
 990   "Face used for highlighting the current article in the summary buffer."
 991   :group 'gnus-summary-visual
 992   :type 'face)
 993
 994 (defvar gnus-tmp-downloaded nil)
 995
 996 (defcustom gnus-summary-highlight
 997   '(((eq mark gnus-canceled-mark)
 998      . gnus-summary-cancelled)
 999     ((and uncached (> score default-high))
1000      . gnus-summary-high-undownloaded)
1001     ((and uncached (< score default-low))
1002      . gnus-summary-low-undownloaded)
1003     (uncached
1004      . gnus-summary-normal-undownloaded)
1005     ((and (> score default-high)
1006           (or (eq mark gnus-dormant-mark)
1007               (eq mark gnus-ticked-mark)))
1008      . gnus-summary-high-ticked)
1009     ((and (< score default-low)
1010           (or (eq mark gnus-dormant-mark)
1011               (eq mark gnus-ticked-mark)))
1012      . gnus-summary-low-ticked)
1013     ((or (eq mark gnus-dormant-mark)
1014          (eq mark gnus-ticked-mark))
1015      . gnus-summary-normal-ticked)
1016     ((and (> score default-high) (eq mark gnus-ancient-mark))
1017      . gnus-summary-high-ancient)
1018     ((and (< score default-low) (eq mark gnus-ancient-mark))
1019      . gnus-summary-low-ancient)
1020     ((eq mark gnus-ancient-mark)
1021      . gnus-summary-normal-ancient)
1022     ((and (> score default-high) (eq mark gnus-unread-mark))
1023      . gnus-summary-high-unread)
1024     ((and (< score default-low) (eq mark gnus-unread-mark))
1025      . gnus-summary-low-unread)
1026     ((eq mark gnus-unread-mark)
1027      . gnus-summary-normal-unread)
1028     ((> score default-high)
1029      . gnus-summary-high-read)
1030     ((< score default-low)
1031      . gnus-summary-low-read)
1032     (t
1033      . gnus-summary-normal-read))
1034   "*Controls the highlighting of summary buffer lines.
1035
1036 A list of (FORM . FACE) pairs.  When deciding how a a particular
1037 summary line should be displayed, each form is evaluated.  The content
1038 of the face field after the first true form is used.  You can change
1039 how those summary lines are displayed, by editing the face field.
1040
1041 You can use the following variables in the FORM field.
1042
1043 score:        The article's score
1044 default:      The default article score.
1045 default-high: The default score for high scored articles.
1046 default-low:  The default score for low scored articles.
1047 below:        The score below which articles are automatically marked as read.
1048 mark:         The article's mark.
1049 uncached:     Non-nil if the article is uncached."
1050   :group 'gnus-summary-visual
1051   :type '(repeat (cons (sexp :tag "Form" nil)
1052                        face)))
1053
1054 (defcustom gnus-alter-header-function nil
1055   "Function called to allow alteration of article header structures.
1056 The function is called with one parameter, the article header vector,
1057 which it may alter in any way."
1058   :type '(choice (const :tag "None" nil)
1059                  function)
1060   :group 'gnus-summary)
1061
1062 (defvar gnus-decode-encoded-word-function 'mail-decode-encoded-word-string
1063   "Function used to decode a string with encoded words.")
1064
1065 (defvar gnus-decode-encoded-address-function
1066   'mail-decode-encoded-address-string
1067   "Function used to decode addresses with encoded words.")
1068
1069 (defcustom gnus-extra-headers '(To Newsgroups)
1070   "*Extra headers to parse."
1071   :version "21.1"
1072   :group 'gnus-summary
1073   :type '(repeat symbol))
1074
1075 (defcustom gnus-ignored-from-addresses
1076   (and user-mail-address
1077        (not (string= user-mail-address ""))
1078        (regexp-quote user-mail-address))
1079   "*Regexp of From headers that may be suppressed in favor of To headers."
1080   :version "21.1"
1081   :group 'gnus-summary
1082   :type 'regexp)
1083
1084 (defcustom gnus-summary-to-prefix "-> "
1085   "*String prefixed to the To field in the summary line when
1086 using `gnus-ignored-from-addresses'."
1087   :version "22.1"
1088   :group 'gnus-summary
1089   :type 'string)
1090
1091 (defcustom gnus-summary-newsgroup-prefix "=> "
1092   "*String prefixed to the Newsgroup field in the summary
1093 line when using `gnus-ignored-from-addresses'."
1094   :version "22.1"
1095   :group 'gnus-summary
1096   :type 'string)
1097
1098 (defcustom gnus-newsgroup-ignored-charsets '(unknown-8bit x-unknown)
1099   "List of charsets that should be ignored.
1100 When these charsets are used in the \"charset\" parameter, the
1101 default charset will be used instead."
1102   :version "21.1"
1103   :type '(repeat symbol)
1104   :group 'gnus-charset)
1105
1106 (gnus-define-group-parameter
1107  ignored-charsets
1108  :type list
1109  :function-document
1110  "Return the ignored charsets of GROUP."
1111  :variable gnus-group-ignored-charsets-alist
1112  :variable-default
1113  '(("alt\\.chinese\\.text" iso-8859-1))
1114  :variable-document
1115  "Alist of regexps (to match group names) and charsets that should be ignored.
1116 When these charsets are used in the \"charset\" parameter, the
1117 default charset will be used instead."
1118  :variable-group gnus-charset
1119  :variable-type '(repeat (cons (regexp :tag "Group")
1120                                (repeat symbol)))
1121  :parameter-type '(choice :tag "Ignored charsets"
1122                           :value nil
1123                           (repeat (symbol)))
1124  :parameter-document       "\
1125 List of charsets that should be ignored.
1126
1127 When these charsets are used in the \"charset\" parameter, the
1128 default charset will be used instead.")
1129
1130 (defcustom gnus-group-highlight-words-alist nil
1131   "Alist of group regexps and highlight regexps.
1132 This variable uses the same syntax as `gnus-emphasis-alist'."
1133   :version "21.1"
1134   :type '(repeat (cons (regexp :tag "Group")
1135                        (repeat (list (regexp :tag "Highlight regexp")
1136                                      (number :tag "Group for entire word" 0)
1137                                      (number :tag "Group for displayed part" 0)
1138                                      (symbol :tag "Face"
1139                                              gnus-emphasis-highlight-words)))))
1140   :group 'gnus-summary-visual)
1141
1142 (defcustom gnus-summary-show-article-charset-alist
1143   nil
1144   "Alist of number and charset.
1145 The article will be shown with the charset corresponding to the
1146 numbered argument.
1147 For example: ((1 . cn-gb-2312) (2 . big5))."
1148   :version "21.1"
1149   :type '(repeat (cons (number :tag "Argument" 1)
1150                        (symbol :tag "Charset")))
1151   :group 'gnus-charset)
1152
1153 (defcustom gnus-preserve-marks t
1154   "Whether marks are preserved when moving, copying and respooling messages."
1155   :version "21.1"
1156   :type 'boolean
1157   :group 'gnus-summary-marks)
1158
1159 (defcustom gnus-alter-articles-to-read-function nil
1160   "Function to be called to alter the list of articles to be selected."
1161   :type '(choice (const nil) function)
1162   :group 'gnus-summary)
1163
1164 (defcustom gnus-orphan-score nil
1165   "*All orphans get this score added.  Set in the score file."
1166   :group 'gnus-score-default
1167   :type '(choice (const nil)
1168                  integer))
1169
1170 (defcustom gnus-summary-save-parts-default-mime "image/.*"
1171   "*A regexp to match MIME parts when saving multiple parts of a
1172 message with `gnus-summary-save-parts' (\\<gnus-summary-mode-map>\\[gnus-summary-save-parts]).
1173 This regexp will be used by default when prompting the user for which
1174 type of files to save."
1175   :group 'gnus-summary
1176   :type 'regexp)
1177
1178 (defcustom gnus-read-all-available-headers nil
1179   "Whether Gnus should parse all headers made available to it.
1180 This is mostly relevant for slow back ends where the user may
1181 wish to widen the summary buffer to include all headers
1182 that were fetched.  Say, for nnultimate groups."
1183   :version "22.1"
1184   :group 'gnus-summary
1185   :type '(choice boolean regexp))
1186
1187 (defcustom gnus-summary-muttprint-program "muttprint"
1188   "Command (and optional arguments) used to run Muttprint."
1189   :version "22.1"
1190   :group 'gnus-summary
1191   :type 'string)
1192
1193 (defcustom gnus-article-loose-mime t
1194   "If non-nil, don't require MIME-Version header.
1195 Some brain-damaged MUA/MTA, e.g. Lotus Domino 5.0.6 clients, does not
1196 supply the MIME-Version header or deliberately strip it from the mail.
1197 If non-nil (the default), Gnus will treat some articles as MIME
1198 even if the MIME-Version header is missing."
1199   :version "22.1"
1200   :type 'boolean
1201   :group 'gnus-article-mime)
1202
1203 (defcustom gnus-article-emulate-mime t
1204   "If non-nil, use MIME emulation for uuencode and the like.
1205 This means that Gnus will search message bodies for text that look
1206 like uuencoded bits, yEncoded bits, and so on, and present that using
1207 the normal Gnus MIME machinery."
1208   :version "22.1"
1209   :type 'boolean
1210   :group 'gnus-article-mime)
1211
1212 ;;; Internal variables
1213
1214 (defvar gnus-summary-display-cache nil)
1215 (defvar gnus-article-mime-handles nil)
1216 (defvar gnus-article-decoded-p nil)
1217 (defvar gnus-article-charset nil)
1218 (defvar gnus-article-ignored-charsets nil)
1219 (defvar gnus-scores-exclude-files nil)
1220 (defvar gnus-page-broken nil)
1221
1222 (defvar gnus-original-article nil)
1223 (defvar gnus-article-internal-prepare-hook nil)
1224 (defvar gnus-newsgroup-process-stack nil)
1225
1226 (defvar gnus-thread-indent-array nil)
1227 (defvar gnus-thread-indent-array-level gnus-thread-indent-level)
1228 (defvar gnus-sort-gathered-threads-function 'gnus-thread-sort-by-number
1229   "Function called to sort the articles within a thread after it has been gathered together.")
1230
1231 (defvar gnus-summary-save-parts-type-history nil)
1232 (defvar gnus-summary-save-parts-last-directory mm-default-directory)
1233
1234 ;; Avoid highlighting in kill files.
1235 (defvar gnus-summary-inhibit-highlight nil)
1236 (defvar gnus-newsgroup-selected-overlay nil)
1237 (defvar gnus-inhibit-limiting nil)
1238 (defvar gnus-newsgroup-adaptive-score-file nil)
1239 (defvar gnus-current-score-file nil)
1240 (defvar gnus-current-move-group nil)
1241 (defvar gnus-current-copy-group nil)
1242 (defvar gnus-current-crosspost-group nil)
1243 (defvar gnus-newsgroup-display nil)
1244
1245 (defvar gnus-newsgroup-dependencies nil)
1246 (defvar gnus-newsgroup-adaptive nil)
1247 (defvar gnus-summary-display-article-function nil)
1248 (defvar gnus-summary-highlight-line-function nil
1249   "Function called after highlighting a summary line.")
1250
1251 (defvar gnus-summary-line-format-alist
1252   `((?N ,(macroexpand '(mail-header-number gnus-tmp-header)) ?d)
1253     (?S ,(macroexpand '(mail-header-subject gnus-tmp-header)) ?s)
1254     (?s gnus-tmp-subject-or-nil ?s)
1255     (?n gnus-tmp-name ?s)
1256     (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from)))
1257         ?s)
1258     (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from))
1259             gnus-tmp-from) ?s)
1260     (?F gnus-tmp-from ?s)
1261     (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s)
1262     (?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s)
1263     (?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s)
1264     (?o (gnus-date-iso8601 (mail-header-date gnus-tmp-header)) ?s)
1265     (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s)
1266     (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s)
1267     (?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
1268     (?k (gnus-summary-line-message-size gnus-tmp-header) ?s)
1269     (?L gnus-tmp-lines ?s)
1270     (?O gnus-tmp-downloaded ?c)
1271     (?I gnus-tmp-indentation ?s)
1272     (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
1273     (?R gnus-tmp-replied ?c)
1274     (?\[ gnus-tmp-opening-bracket ?c)
1275     (?\] gnus-tmp-closing-bracket ?c)
1276     (?\> (make-string gnus-tmp-level ? ) ?s)
1277     (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s)
1278     (?i gnus-tmp-score ?d)
1279     (?z gnus-tmp-score-char ?c)
1280     (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d)
1281     (?U gnus-tmp-unread ?c)
1282     (?f (gnus-summary-from-or-to-or-newsgroups gnus-tmp-header gnus-tmp-from)
1283         ?s)
1284     (?t (gnus-summary-number-of-articles-in-thread
1285          (and (boundp 'thread) (car thread)) gnus-tmp-level)
1286         ?d)
1287     (?e (gnus-summary-number-of-articles-in-thread
1288          (and (boundp 'thread) (car thread)) gnus-tmp-level t)
1289         ?c)
1290     (?u gnus-tmp-user-defined ?s)
1291     (?P (gnus-pick-line-number) ?d)
1292     (?B gnus-tmp-thread-tree-header-string ?s)
1293     (user-date (gnus-user-date
1294                 ,(macroexpand '(mail-header-date gnus-tmp-header))) ?s))
1295   "An alist of format specifications that can appear in summary lines.
1296 These are paired with what variables they correspond with, along with
1297 the type of the variable (string, integer, character, etc).")
1298
1299 (defvar gnus-summary-dummy-line-format-alist
1300   `((?S gnus-tmp-subject ?s)
1301     (?N gnus-tmp-number ?d)
1302     (?u gnus-tmp-user-defined ?s)))
1303
1304 (defvar gnus-summary-mode-line-format-alist
1305   `((?G gnus-tmp-group-name ?s)
1306     (?g (gnus-short-group-name gnus-tmp-group-name) ?s)
1307     (?p (gnus-group-real-name gnus-tmp-group-name) ?s)
1308     (?A gnus-tmp-article-number ?d)
1309     (?Z gnus-tmp-unread-and-unselected ?s)
1310     (?V gnus-version ?s)
1311     (?U gnus-tmp-unread-and-unticked ?d)
1312     (?S gnus-tmp-subject ?s)
1313     (?e gnus-tmp-unselected ?d)
1314     (?u gnus-tmp-user-defined ?s)
1315     (?d (length gnus-newsgroup-dormant) ?d)
1316     (?t (length gnus-newsgroup-marked) ?d)
1317     (?h (length gnus-newsgroup-spam-marked) ?d)
1318     (?r (length gnus-newsgroup-reads) ?d)
1319     (?z (gnus-summary-article-score gnus-tmp-article-number) ?d)
1320     (?E gnus-newsgroup-expunged-tally ?d)
1321     (?s (gnus-current-score-file-nondirectory) ?s)))
1322
1323 (defvar gnus-last-search-regexp nil
1324   "Default regexp for article search command.")
1325
1326 (defvar gnus-last-shell-command nil
1327   "Default shell command on article.")
1328
1329 (defvar gnus-newsgroup-agentized nil
1330   "Locally bound in each summary buffer to indicate whether the server has been agentized.")
1331 (defvar gnus-newsgroup-begin nil)
1332 (defvar gnus-newsgroup-end nil)
1333 (defvar gnus-newsgroup-last-rmail nil)
1334 (defvar gnus-newsgroup-last-mail nil)
1335 (defvar gnus-newsgroup-last-folder nil)
1336 (defvar gnus-newsgroup-last-file nil)
1337 (defvar gnus-newsgroup-last-directory nil)
1338 (defvar gnus-newsgroup-auto-expire nil)
1339 (defvar gnus-newsgroup-active nil)
1340
1341 (defvar gnus-newsgroup-data nil)
1342 (defvar gnus-newsgroup-data-reverse nil)
1343 (defvar gnus-newsgroup-limit nil)
1344 (defvar gnus-newsgroup-limits nil)
1345 (defvar gnus-summary-use-undownloaded-faces nil)
1346
1347 (defvar gnus-newsgroup-unreads nil
1348   "Sorted list of unread articles in the current newsgroup.")
1349
1350 (defvar gnus-newsgroup-unselected nil
1351   "Sorted list of unselected unread articles in the current newsgroup.")
1352
1353 (defvar gnus-newsgroup-reads nil
1354   "Alist of read articles and article marks in the current newsgroup.")
1355
1356 (defvar gnus-newsgroup-expunged-tally nil)
1357
1358 (defvar gnus-newsgroup-marked nil
1359   "Sorted list of ticked articles in the current newsgroup (a subset of unread art).")
1360
1361 (defvar gnus-newsgroup-spam-marked nil
1362   "List of ranges of articles that have been marked as spam.")
1363
1364 (defvar gnus-newsgroup-killed nil
1365   "List of ranges of articles that have been through the scoring process.")
1366
1367 (defvar gnus-newsgroup-cached nil
1368   "Sorted list of articles that come from the article cache.")
1369
1370 (defvar gnus-newsgroup-saved nil
1371   "List of articles that have been saved.")
1372
1373 (defvar gnus-newsgroup-kill-headers nil)
1374
1375 (defvar gnus-newsgroup-replied nil
1376   "List of articles that have been replied to in the current newsgroup.")
1377
1378 (defvar gnus-newsgroup-forwarded nil
1379   "List of articles that have been forwarded in the current newsgroup.")
1380
1381 (defvar gnus-newsgroup-recent nil
1382   "List of articles that have are recent in the current newsgroup.")
1383
1384 (defvar gnus-newsgroup-expirable nil
1385   "Sorted list of articles in the current newsgroup that can be expired.")
1386
1387 (defvar gnus-newsgroup-processable nil
1388   "List of articles in the current newsgroup that can be processed.")
1389
1390 (defvar gnus-newsgroup-downloadable nil
1391   "Sorted list of articles in the current newsgroup that can be processed.")
1392
1393 (defvar gnus-newsgroup-unfetched nil
1394   "Sorted list of articles in the current newsgroup whose headers have
1395 not been fetched into the agent.
1396
1397 This list will always be a subset of gnus-newsgroup-undownloaded.")
1398
1399 (defvar gnus-newsgroup-undownloaded nil
1400   "List of articles in the current newsgroup that haven't been downloaded.")
1401
1402 (defvar gnus-newsgroup-unsendable nil
1403   "List of articles in the current newsgroup that won't be sent.")
1404
1405 (defvar gnus-newsgroup-bookmarks nil
1406   "List of articles in the current newsgroup that have bookmarks.")
1407
1408 (defvar gnus-newsgroup-dormant nil
1409   "Sorted list of dormant articles in the current newsgroup.")
1410
1411 (defvar gnus-newsgroup-unseen nil
1412   "List of unseen articles in the current newsgroup.")
1413
1414 (defvar gnus-newsgroup-seen nil
1415   "Range of seen articles in the current newsgroup.")
1416
1417 (defvar gnus-newsgroup-articles nil
1418   "List of articles in the current newsgroup.")
1419
1420 (defvar gnus-newsgroup-scored nil
1421   "List of scored articles in the current newsgroup.")
1422
1423 (defvar gnus-newsgroup-headers nil
1424   "List of article headers in the current newsgroup.")
1425
1426 (defvar gnus-newsgroup-threads nil)
1427
1428 (defvar gnus-newsgroup-prepared nil
1429   "Whether the current group has been prepared properly.")
1430
1431 (defvar gnus-newsgroup-ancient nil
1432   "List of `gnus-fetch-old-headers' articles in the current newsgroup.")
1433
1434 (defvar gnus-newsgroup-sparse nil)
1435
1436 (defvar gnus-current-article nil)
1437 (defvar gnus-article-current nil)
1438 (defvar gnus-current-headers nil)
1439 (defvar gnus-have-all-headers nil)
1440 (defvar gnus-last-article nil)
1441 (defvar gnus-newsgroup-history nil)
1442 (defvar gnus-newsgroup-charset nil)
1443 (defvar gnus-newsgroup-ephemeral-charset nil)
1444 (defvar gnus-newsgroup-ephemeral-ignored-charsets nil)
1445
1446 (defvar gnus-article-before-search nil)
1447
1448 (defvar gnus-summary-local-variables
1449   '(gnus-newsgroup-name
1450     gnus-newsgroup-begin gnus-newsgroup-end
1451     gnus-newsgroup-last-rmail gnus-newsgroup-last-mail
1452     gnus-newsgroup-last-folder gnus-newsgroup-last-file
1453     gnus-newsgroup-last-directory
1454     gnus-newsgroup-auto-expire gnus-newsgroup-unreads
1455     gnus-newsgroup-unselected gnus-newsgroup-marked
1456     gnus-newsgroup-spam-marked
1457     gnus-newsgroup-reads gnus-newsgroup-saved
1458     gnus-newsgroup-replied gnus-newsgroup-forwarded
1459     gnus-newsgroup-recent
1460     gnus-newsgroup-expirable
1461     gnus-newsgroup-processable gnus-newsgroup-killed
1462     gnus-newsgroup-downloadable gnus-newsgroup-undownloaded
1463     gnus-newsgroup-unfetched
1464     gnus-newsgroup-unsendable gnus-newsgroup-unseen
1465     gnus-newsgroup-seen gnus-newsgroup-articles
1466     gnus-newsgroup-bookmarks gnus-newsgroup-dormant
1467     gnus-newsgroup-headers gnus-newsgroup-threads
1468     gnus-newsgroup-prepared gnus-summary-highlight-line-function
1469     gnus-current-article gnus-current-headers gnus-have-all-headers
1470     gnus-last-article gnus-article-internal-prepare-hook
1471     gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay
1472     gnus-newsgroup-scored gnus-newsgroup-kill-headers
1473     gnus-thread-expunge-below
1474     gnus-score-alist gnus-current-score-file
1475     (gnus-summary-expunge-below . global)
1476     (gnus-summary-mark-below . global)
1477     (gnus-orphan-score . global)
1478     gnus-newsgroup-active gnus-scores-exclude-files
1479     gnus-newsgroup-history gnus-newsgroup-ancient
1480     gnus-newsgroup-sparse gnus-newsgroup-process-stack
1481     (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring)
1482     gnus-newsgroup-adaptive-score-file (gnus-reffed-article-number . -1)
1483     (gnus-newsgroup-expunged-tally . 0)
1484     gnus-cache-removable-articles gnus-newsgroup-cached
1485     gnus-newsgroup-data gnus-newsgroup-data-reverse
1486     gnus-newsgroup-limit gnus-newsgroup-limits
1487     gnus-newsgroup-charset gnus-newsgroup-display
1488     gnus-summary-use-undownloaded-faces)
1489   "Variables that are buffer-local to the summary buffers.")
1490
1491 (defvar gnus-newsgroup-variables nil
1492   "A list of variables that have separate values in different newsgroups.
1493 A list of newsgroup (summary buffer) local variables, or cons of
1494 variables and their default expressions to be evalled (when the default
1495 values are not nil), that should be made global while the summary buffer
1496 is active.
1497
1498 Note: The default expressions will be evaluated (using function `eval')
1499 before assignment to the local variable rather than just assigned to it.
1500 If the default expression is the symbol `global', that symbol will not
1501 be evaluated but the global value of the local variable will be used
1502 instead.
1503
1504 These variables can be used to set variables in the group parameters
1505 while still allowing them to affect operations done in other buffers.
1506 For example:
1507
1508 \(setq gnus-newsgroup-variables
1509      '(message-use-followup-to
1510        (gnus-visible-headers .
1511          \"^From:\\\\|^Newsgroups:\\\\|^Subject:\\\\|^Date:\\\\|^To:\")))
1512 ")
1513
1514 ;; Byte-compiler warning.
1515 (eval-when-compile
1516   ;; Bind features so that require will believe that gnus-sum has
1517   ;; already been loaded (avoids infinite recursion)
1518   (let ((features (cons 'gnus-sum features)))
1519     ;; Several of the declarations in gnus-sum are needed to load the
1520     ;; following files. Right now, these definitions have been
1521     ;; compiled but not defined (evaluated).  We could either do a
1522     ;; eval-and-compile about all of the declarations or evaluate the
1523     ;; source file.
1524     (if (boundp 'gnus-newsgroup-variables)
1525         nil
1526       (load "gnus-sum.el" t t t))
1527     (require 'gnus)
1528     (require 'gnus-art)))
1529
1530 ;; MIME stuff.
1531
1532 (defvar gnus-decode-encoded-word-methods
1533   '(mail-decode-encoded-word-string)
1534   "List of methods used to decode encoded words.
1535
1536 This variable is a list of FUNCTION or (REGEXP . FUNCTION).  If item
1537 is FUNCTION, FUNCTION will be apply to all newsgroups.  If item is a
1538 \(REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups
1539 whose names match REGEXP.
1540
1541 For example:
1542 \((\"chinese\" . gnus-decode-encoded-word-string-by-guess)
1543  mail-decode-encoded-word-string
1544  (\"chinese\" . rfc1843-decode-string))")
1545
1546 (defvar gnus-decode-encoded-word-methods-cache nil)
1547
1548 (defun gnus-multi-decode-encoded-word-string (string)
1549   "Apply the functions from `gnus-encoded-word-methods' that match."
1550   (unless (and gnus-decode-encoded-word-methods-cache
1551                (eq gnus-newsgroup-name
1552                    (car gnus-decode-encoded-word-methods-cache)))
1553     (setq gnus-decode-encoded-word-methods-cache (list gnus-newsgroup-name))
1554     (mapcar (lambda (x)
1555               (if (symbolp x)
1556                   (nconc gnus-decode-encoded-word-methods-cache (list x))
1557                 (if (and gnus-newsgroup-name
1558                          (string-match (car x) gnus-newsgroup-name))
1559                     (nconc gnus-decode-encoded-word-methods-cache
1560                            (list (cdr x))))))
1561             gnus-decode-encoded-word-methods))
1562   (let ((xlist gnus-decode-encoded-word-methods-cache))
1563     (pop xlist)
1564     (while xlist
1565       (setq string (funcall (pop xlist) string))))
1566   string)
1567
1568 ;; Subject simplification.
1569
1570 (defun gnus-simplify-whitespace (str)
1571   "Remove excessive whitespace from STR."
1572   ;; Multiple spaces.
1573   (while (string-match "[ \t][ \t]+" str)
1574     (setq str (concat (substring str 0 (match-beginning 0))
1575                         " "
1576                         (substring str (match-end 0)))))
1577   ;; Leading spaces.
1578   (when (string-match "^[ \t]+" str)
1579     (setq str (substring str (match-end 0))))
1580   ;; Trailing spaces.
1581   (when (string-match "[ \t]+$" str)
1582     (setq str (substring str 0 (match-beginning 0))))
1583   str)
1584
1585 (defun gnus-simplify-all-whitespace (str)
1586   "Remove all whitespace from STR."
1587   (while (string-match "[ \t\n]+" str)
1588     (setq str (replace-match "" nil nil str)))
1589   str)
1590
1591 (defsubst gnus-simplify-subject-re (subject)
1592   "Remove \"Re:\" from subject lines."
1593   (if (string-match message-subject-re-regexp subject)
1594       (substring subject (match-end 0))
1595     subject))
1596
1597 (defun gnus-simplify-subject (subject &optional re-only)
1598   "Remove `Re:' and words in parentheses.
1599 If RE-ONLY is non-nil, strip leading `Re:'s only."
1600   (let ((case-fold-search t))           ;Ignore case.
1601     ;; Remove `Re:', `Re^N:', `Re(n)', and `Re[n]:'.
1602     (when (string-match "\\`\\(re\\([[(^][0-9]+[])]?\\)?:[ \t]*\\)+" subject)
1603       (setq subject (substring subject (match-end 0))))
1604     ;; Remove uninteresting prefixes.
1605     (when (and (not re-only)
1606                gnus-simplify-ignored-prefixes
1607                (string-match gnus-simplify-ignored-prefixes subject))
1608       (setq subject (substring subject (match-end 0))))
1609     ;; Remove words in parentheses from end.
1610     (unless re-only
1611       (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject)
1612         (setq subject (substring subject 0 (match-beginning 0)))))
1613     ;; Return subject string.
1614     subject))
1615
1616 ;; Remove any leading "re:"s, any trailing paren phrases, and simplify
1617 ;; all whitespace.
1618 (defsubst gnus-simplify-buffer-fuzzy-step (regexp &optional newtext)
1619   (goto-char (point-min))
1620   (while (re-search-forward regexp nil t)
1621     (replace-match (or newtext ""))))
1622
1623 (defun gnus-simplify-buffer-fuzzy ()
1624   "Simplify string in the buffer fuzzily.
1625 The string in the accessible portion of the current buffer is simplified.
1626 It is assumed to be a single-line subject.
1627 Whitespace is generally cleaned up, and miscellaneous leading/trailing
1628 matter is removed.  Additional things can be deleted by setting
1629 `gnus-simplify-subject-fuzzy-regexp'."
1630   (let ((case-fold-search t)
1631         (modified-tick))
1632     (gnus-simplify-buffer-fuzzy-step "\t" " ")
1633
1634     (while (not (eq modified-tick (buffer-modified-tick)))
1635       (setq modified-tick (buffer-modified-tick))
1636       (cond
1637        ((listp gnus-simplify-subject-fuzzy-regexp)
1638         (mapcar 'gnus-simplify-buffer-fuzzy-step
1639                 gnus-simplify-subject-fuzzy-regexp))
1640        (gnus-simplify-subject-fuzzy-regexp
1641         (gnus-simplify-buffer-fuzzy-step gnus-simplify-subject-fuzzy-regexp)))
1642       (gnus-simplify-buffer-fuzzy-step "^ *\\[[-+?*!][-+?*!]\\] *")
1643       (gnus-simplify-buffer-fuzzy-step
1644        "^ *\\(re\\|fw\\|fwd\\)[[{(^0-9]*[])}]?[:;] *")
1645       (gnus-simplify-buffer-fuzzy-step "^[[].*:\\( .*\\)[]]$" "\\1"))
1646
1647     (gnus-simplify-buffer-fuzzy-step " *[[{(][^()\n]*[]})] *$")
1648     (gnus-simplify-buffer-fuzzy-step "  +" " ")
1649     (gnus-simplify-buffer-fuzzy-step " $")
1650     (gnus-simplify-buffer-fuzzy-step "^ +")))
1651
1652 (defun gnus-simplify-subject-fuzzy (subject)
1653   "Simplify a subject string fuzzily.
1654 See `gnus-simplify-buffer-fuzzy' for details."
1655   (save-excursion
1656     (gnus-set-work-buffer)
1657     (let ((case-fold-search t))
1658       ;; Remove uninteresting prefixes.
1659       (when (and gnus-simplify-ignored-prefixes
1660                  (string-match gnus-simplify-ignored-prefixes subject))
1661         (setq subject (substring subject (match-end 0))))
1662       (insert subject)
1663       (inline (gnus-simplify-buffer-fuzzy))
1664       (buffer-string))))
1665
1666 (defsubst gnus-simplify-subject-fully (subject)
1667   "Simplify a subject string according to `gnus-summary-gather-subject-limit'."
1668   (cond
1669    (gnus-simplify-subject-functions
1670     (gnus-map-function gnus-simplify-subject-functions subject))
1671    ((null gnus-summary-gather-subject-limit)
1672     (gnus-simplify-subject-re subject))
1673    ((eq gnus-summary-gather-subject-limit 'fuzzy)
1674     (gnus-simplify-subject-fuzzy subject))
1675    ((numberp gnus-summary-gather-subject-limit)
1676     (gnus-limit-string (gnus-simplify-subject-re subject)
1677                        gnus-summary-gather-subject-limit))
1678    (t
1679     subject)))
1680
1681 (defsubst gnus-subject-equal (s1 s2 &optional simple-first)
1682   "Check whether two subjects are equal.
1683 If optional argument SIMPLE-FIRST is t, first argument is already
1684 simplified."
1685   (cond
1686    ((null simple-first)
1687     (equal (gnus-simplify-subject-fully s1)
1688            (gnus-simplify-subject-fully s2)))
1689    (t
1690     (equal s1
1691            (gnus-simplify-subject-fully s2)))))
1692
1693 (defun gnus-summary-bubble-group ()
1694   "Increase the score of the current group.
1695 This is a handy function to add to `gnus-summary-exit-hook' to
1696 increase the score of each group you read."
1697   (gnus-group-add-score gnus-newsgroup-name))
1698
1699 \f
1700 ;;;
1701 ;;; Gnus summary mode
1702 ;;;
1703
1704 (put 'gnus-summary-mode 'mode-class 'special)
1705
1706 (defvar gnus-article-commands-menu)
1707
1708 ;; Non-orthogonal keys
1709
1710 (gnus-define-keys gnus-summary-mode-map
1711   " " gnus-summary-next-page
1712   "\177" gnus-summary-prev-page
1713   [delete] gnus-summary-prev-page
1714   [backspace] gnus-summary-prev-page
1715   "\r" gnus-summary-scroll-up
1716   "\M-\r" gnus-summary-scroll-down
1717   "n" gnus-summary-next-unread-article
1718   "p" gnus-summary-prev-unread-article
1719   "N" gnus-summary-next-article
1720   "P" gnus-summary-prev-article
1721   "\M-\C-n" gnus-summary-next-same-subject
1722   "\M-\C-p" gnus-summary-prev-same-subject
1723   "\M-n" gnus-summary-next-unread-subject
1724   "\M-p" gnus-summary-prev-unread-subject
1725   "." gnus-summary-first-unread-article
1726   "," gnus-summary-best-unread-article
1727   "\M-s" gnus-summary-search-article-forward
1728   "\M-r" gnus-summary-search-article-backward
1729   "\M-S" gnus-summary-repeat-search-article-forward
1730   "\M-R" gnus-summary-repeat-search-article-backward
1731   "<" gnus-summary-beginning-of-article
1732   ">" gnus-summary-end-of-article
1733   "j" gnus-summary-goto-article
1734   "^" gnus-summary-refer-parent-article
1735   "\M-^" gnus-summary-refer-article
1736   "u" gnus-summary-tick-article-forward
1737   "!" gnus-summary-tick-article-forward
1738   "U" gnus-summary-tick-article-backward
1739   "d" gnus-summary-mark-as-read-forward
1740   "D" gnus-summary-mark-as-read-backward
1741   "E" gnus-summary-mark-as-expirable
1742   "\M-u" gnus-summary-clear-mark-forward
1743   "\M-U" gnus-summary-clear-mark-backward
1744   "k" gnus-summary-kill-same-subject-and-select
1745   "\C-k" gnus-summary-kill-same-subject
1746   "\M-\C-k" gnus-summary-kill-thread
1747   "\M-\C-l" gnus-summary-lower-thread
1748   "e" gnus-summary-edit-article
1749   "#" gnus-summary-mark-as-processable
1750   "\M-#" gnus-summary-unmark-as-processable
1751   "\M-\C-t" gnus-summary-toggle-threads
1752   "\M-\C-s" gnus-summary-show-thread
1753   "\M-\C-h" gnus-summary-hide-thread
1754   "\M-\C-f" gnus-summary-next-thread
1755   "\M-\C-b" gnus-summary-prev-thread
1756   [(meta down)] gnus-summary-next-thread
1757   [(meta up)] gnus-summary-prev-thread
1758   "\M-\C-u" gnus-summary-up-thread
1759   "\M-\C-d" gnus-summary-down-thread
1760   "&" gnus-summary-execute-command
1761   "c" gnus-summary-catchup-and-exit
1762   "\C-w" gnus-summary-mark-region-as-read
1763   "\C-t" gnus-summary-toggle-truncation
1764   "?" gnus-summary-mark-as-dormant
1765   "\C-c\M-\C-s" gnus-summary-limit-include-expunged
1766   "\C-c\C-s\C-n" gnus-summary-sort-by-number
1767   "\C-c\C-s\C-l" gnus-summary-sort-by-lines
1768   "\C-c\C-s\C-c" gnus-summary-sort-by-chars
1769   "\C-c\C-s\C-a" gnus-summary-sort-by-author
1770   "\C-c\C-s\C-t" gnus-summary-sort-by-recipient
1771   "\C-c\C-s\C-s" gnus-summary-sort-by-subject
1772   "\C-c\C-s\C-d" gnus-summary-sort-by-date
1773   "\C-c\C-s\C-i" gnus-summary-sort-by-score
1774   "\C-c\C-s\C-o" gnus-summary-sort-by-original
1775   "\C-c\C-s\C-r" gnus-summary-sort-by-random
1776   "=" gnus-summary-expand-window
1777   "\C-x\C-s" gnus-summary-reselect-current-group
1778   "\M-g" gnus-summary-rescan-group
1779   "w" gnus-summary-stop-page-breaking
1780   "\C-c\C-r" gnus-summary-caesar-message
1781   "f" gnus-summary-followup
1782   "F" gnus-summary-followup-with-original
1783   "C" gnus-summary-cancel-article
1784   "r" gnus-summary-reply
1785   "R" gnus-summary-reply-with-original
1786   "\C-c\C-f" gnus-summary-mail-forward
1787   "o" gnus-summary-save-article
1788   "\C-o" gnus-summary-save-article-mail
1789   "|" gnus-summary-pipe-output
1790   "\M-k" gnus-summary-edit-local-kill
1791   "\M-K" gnus-summary-edit-global-kill
1792   ;; "V" gnus-version
1793   "\C-c\C-d" gnus-summary-describe-group
1794   "q" gnus-summary-exit
1795   "Q" gnus-summary-exit-no-update
1796   "\C-c\C-i" gnus-info-find-node
1797   gnus-mouse-2 gnus-mouse-pick-article
1798   [follow-link] mouse-face
1799   "m" gnus-summary-mail-other-window
1800   "a" gnus-summary-post-news
1801   "i" gnus-summary-news-other-window
1802   "x" gnus-summary-limit-to-unread
1803   "s" gnus-summary-isearch-article
1804   "t" gnus-summary-toggle-header
1805   "g" gnus-summary-show-article
1806   "l" gnus-summary-goto-last-article
1807   "\C-c\C-v\C-v" gnus-uu-decode-uu-view
1808   "\C-d" gnus-summary-enter-digest-group
1809   "\M-\C-d" gnus-summary-read-document
1810   "\M-\C-e" gnus-summary-edit-parameters
1811   "\M-\C-a" gnus-summary-customize-parameters
1812   "\C-c\C-b" gnus-bug
1813   "*" gnus-cache-enter-article
1814   "\M-*" gnus-cache-remove-article
1815   "\M-&" gnus-summary-universal-argument
1816   "\C-l" gnus-recenter
1817   "I" gnus-summary-increase-score
1818   "L" gnus-summary-lower-score
1819   "\M-i" gnus-symbolic-argument
1820   "h" gnus-summary-select-article-buffer
1821
1822   "b" gnus-article-view-part
1823   "\M-t" gnus-summary-toggle-display-buttonized
1824
1825   "V" gnus-summary-score-map
1826   "X" gnus-uu-extract-map
1827   "S" gnus-summary-send-map)
1828
1829 ;; Sort of orthogonal keymap
1830 (gnus-define-keys (gnus-summary-mark-map "M" gnus-summary-mode-map)
1831   "t" gnus-summary-tick-article-forward
1832   "!" gnus-summary-tick-article-forward
1833   "d" gnus-summary-mark-as-read-forward
1834   "r" gnus-summary-mark-as-read-forward
1835   "c" gnus-summary-clear-mark-forward
1836   " " gnus-summary-clear-mark-forward
1837   "e" gnus-summary-mark-as-expirable
1838   "x" gnus-summary-mark-as-expirable
1839   "?" gnus-summary-mark-as-dormant
1840   "b" gnus-summary-set-bookmark
1841   "B" gnus-summary-remove-bookmark
1842   "#" gnus-summary-mark-as-processable
1843   "\M-#" gnus-summary-unmark-as-processable
1844   "S" gnus-summary-limit-include-expunged
1845   "C" gnus-summary-catchup
1846   "H" gnus-summary-catchup-to-here
1847   "h" gnus-summary-catchup-from-here
1848   "\C-c" gnus-summary-catchup-all
1849   "k" gnus-summary-kill-same-subject-and-select
1850   "K" gnus-summary-kill-same-subject
1851   "P" gnus-uu-mark-map)
1852
1853 (gnus-define-keys (gnus-summary-mscore-map "V" gnus-summary-mark-map)
1854   "c" gnus-summary-clear-above
1855   "u" gnus-summary-tick-above
1856   "m" gnus-summary-mark-above
1857   "k" gnus-summary-kill-below)
1858
1859 (gnus-define-keys (gnus-summary-limit-map "/" gnus-summary-mode-map)
1860   "/" gnus-summary-limit-to-subject
1861   "n" gnus-summary-limit-to-articles
1862   "b" gnus-summary-limit-to-bodies
1863   "h" gnus-summary-limit-to-headers
1864   "w" gnus-summary-pop-limit
1865   "s" gnus-summary-limit-to-subject
1866   "a" gnus-summary-limit-to-author
1867   "u" gnus-summary-limit-to-unread
1868   "m" gnus-summary-limit-to-marks
1869   "M" gnus-summary-limit-exclude-marks
1870   "v" gnus-summary-limit-to-score
1871   "*" gnus-summary-limit-include-cached
1872   "D" gnus-summary-limit-include-dormant
1873   "T" gnus-summary-limit-include-thread
1874   "d" gnus-summary-limit-exclude-dormant
1875   "t" gnus-summary-limit-to-age
1876   "." gnus-summary-limit-to-unseen
1877   "x" gnus-summary-limit-to-extra
1878   "p" gnus-summary-limit-to-display-predicate
1879   "E" gnus-summary-limit-include-expunged
1880   "c" gnus-summary-limit-exclude-childless-dormant
1881   "C" gnus-summary-limit-mark-excluded-as-read
1882   "o" gnus-summary-insert-old-articles
1883   "N" gnus-summary-insert-new-articles
1884   "S" gnus-summary-limit-to-singletons
1885   "r" gnus-summary-limit-to-replied
1886   "R" gnus-summary-limit-to-recipient)
1887
1888 (gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map)
1889   "n" gnus-summary-next-unread-article
1890   "p" gnus-summary-prev-unread-article
1891   "N" gnus-summary-next-article
1892   "P" gnus-summary-prev-article
1893   "\C-n" gnus-summary-next-same-subject
1894   "\C-p" gnus-summary-prev-same-subject
1895   "\M-n" gnus-summary-next-unread-subject
1896   "\M-p" gnus-summary-prev-unread-subject
1897   "f" gnus-summary-first-unread-article
1898   "b" gnus-summary-best-unread-article
1899   "j" gnus-summary-goto-article
1900   "g" gnus-summary-goto-subject
1901   "l" gnus-summary-goto-last-article
1902   "o" gnus-summary-pop-article)
1903
1904 (gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map)
1905   "k" gnus-summary-kill-thread
1906   "l" gnus-summary-lower-thread
1907   "i" gnus-summary-raise-thread
1908   "T" gnus-summary-toggle-threads
1909   "t" gnus-summary-rethread-current
1910   "^" gnus-summary-reparent-thread
1911   "\M-^" gnus-summary-reparent-children
1912   "s" gnus-summary-show-thread
1913   "S" gnus-summary-show-all-threads
1914   "h" gnus-summary-hide-thread
1915   "H" gnus-summary-hide-all-threads
1916   "n" gnus-summary-next-thread
1917   "p" gnus-summary-prev-thread
1918   "u" gnus-summary-up-thread
1919   "o" gnus-summary-top-thread
1920   "d" gnus-summary-down-thread
1921   "#" gnus-uu-mark-thread
1922   "\M-#" gnus-uu-unmark-thread)
1923
1924 (gnus-define-keys (gnus-summary-buffer-map "Y" gnus-summary-mode-map)
1925   "g" gnus-summary-prepare
1926   "c" gnus-summary-insert-cached-articles
1927   "d" gnus-summary-insert-dormant-articles
1928   "t" gnus-summary-insert-ticked-articles)
1929
1930 (gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map)
1931   "c" gnus-summary-catchup-and-exit
1932   "C" gnus-summary-catchup-all-and-exit
1933   "E" gnus-summary-exit-no-update
1934   "Q" gnus-summary-exit
1935   "Z" gnus-summary-exit
1936   "n" gnus-summary-catchup-and-goto-next-group
1937   "p" gnus-summary-catchup-and-goto-prev-group
1938   "R" gnus-summary-reselect-current-group
1939   "G" gnus-summary-rescan-group
1940   "N" gnus-summary-next-group
1941   "s" gnus-summary-save-newsrc
1942   "P" gnus-summary-prev-group)
1943
1944 (gnus-define-keys (gnus-summary-article-map "A" gnus-summary-mode-map)
1945   " " gnus-summary-next-page
1946   "n" gnus-summary-next-page
1947   "\177" gnus-summary-prev-page
1948   [delete] gnus-summary-prev-page
1949   "p" gnus-summary-prev-page
1950   "\r" gnus-summary-scroll-up
1951   "\M-\r" gnus-summary-scroll-down
1952   "<" gnus-summary-beginning-of-article
1953   ">" gnus-summary-end-of-article
1954   "b" gnus-summary-beginning-of-article
1955   "e" gnus-summary-end-of-article
1956   "^" gnus-summary-refer-parent-article
1957   "r" gnus-summary-refer-parent-article
1958   "D" gnus-summary-enter-digest-group
1959   "R" gnus-summary-refer-references
1960   "T" gnus-summary-refer-thread
1961   "g" gnus-summary-show-article
1962   "s" gnus-summary-isearch-article
1963   "P" gnus-summary-print-article
1964   "M" gnus-mailing-list-insinuate
1965   "t" gnus-article-babel)
1966
1967 (gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map)
1968   "b" gnus-article-add-buttons
1969   "B" gnus-article-add-buttons-to-head
1970   "o" gnus-article-treat-overstrike
1971   "e" gnus-article-emphasize
1972   "w" gnus-article-fill-cited-article
1973   "Q" gnus-article-fill-long-lines
1974   "L" gnus-article-toggle-truncate-lines
1975   "C" gnus-article-capitalize-sentences
1976   "c" gnus-article-remove-cr
1977   "q" gnus-article-de-quoted-unreadable
1978   "6" gnus-article-de-base64-unreadable
1979   "Z" gnus-article-decode-HZ
1980   "A" gnus-article-treat-ansi-sequences
1981   "h" gnus-article-wash-html
1982   "u" gnus-article-unsplit-urls
1983   "s" gnus-summary-force-verify-and-decrypt
1984   "f" gnus-article-display-x-face
1985   "l" gnus-summary-stop-page-breaking
1986   "r" gnus-summary-caesar-message
1987   "m" gnus-summary-morse-message
1988   "t" gnus-summary-toggle-header
1989   "g" gnus-treat-smiley
1990   "v" gnus-summary-verbose-headers
1991   "a" gnus-article-strip-headers-in-body ;; mnemonic: wash archive
1992   "p" gnus-article-verify-x-pgp-sig
1993   "d" gnus-article-treat-dumbquotes
1994   "i" gnus-summary-idna-message)
1995
1996 (gnus-define-keys (gnus-summary-wash-deuglify-map "Y" gnus-summary-wash-map)
1997   ;; mnemonic: deuglif*Y*
1998   "u" gnus-article-outlook-unwrap-lines
1999   "a" gnus-article-outlook-repair-attribution
2000   "c" gnus-article-outlook-rearrange-citation
2001   "f" gnus-article-outlook-deuglify-article) ;; mnemonic: full deuglify
2002
2003 (gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
2004   "a" gnus-article-hide
2005   "h" gnus-article-hide-headers
2006   "b" gnus-article-hide-boring-headers
2007   "s" gnus-article-hide-signature
2008   "c" gnus-article-hide-citation
2009   "C" gnus-article-hide-citation-in-followups
2010   "l" gnus-article-hide-list-identifiers
2011   "B" gnus-article-strip-banner
2012   "P" gnus-article-hide-pem
2013   "\C-c" gnus-article-hide-citation-maybe)
2014
2015 (gnus-define-keys (gnus-summary-wash-highlight-map "H" gnus-summary-wash-map)
2016   "a" gnus-article-highlight
2017   "h" gnus-article-highlight-headers
2018   "c" gnus-article-highlight-citation
2019   "s" gnus-article-highlight-signature)
2020
2021 (gnus-define-keys (gnus-summary-wash-header-map "G" gnus-summary-wash-map)
2022   "f" gnus-article-treat-fold-headers
2023   "u" gnus-article-treat-unfold-headers
2024   "n" gnus-article-treat-fold-newsgroups)
2025
2026 (gnus-define-keys (gnus-summary-wash-display-map "D" gnus-summary-wash-map)
2027   "x" gnus-article-display-x-face
2028   "d" gnus-article-display-face
2029   "s" gnus-treat-smiley
2030   "D" gnus-article-remove-images
2031   "f" gnus-treat-from-picon
2032   "m" gnus-treat-mail-picon
2033   "n" gnus-treat-newsgroups-picon)
2034
2035 (gnus-define-keys (gnus-summary-wash-mime-map "M" gnus-summary-wash-map)
2036   "w" gnus-article-decode-mime-words
2037   "c" gnus-article-decode-charset
2038   "v" gnus-mime-view-all-parts
2039   "b" gnus-article-view-part)
2040
2041 (gnus-define-keys (gnus-summary-wash-time-map "T" gnus-summary-wash-map)
2042   "z" gnus-article-date-ut
2043   "u" gnus-article-date-ut
2044   "l" gnus-article-date-local
2045   "p" gnus-article-date-english
2046   "e" gnus-article-date-lapsed
2047   "o" gnus-article-date-original
2048   "i" gnus-article-date-iso8601
2049   "s" gnus-article-date-user)
2050
2051 (gnus-define-keys (gnus-summary-wash-empty-map "E" gnus-summary-wash-map)
2052   "t" gnus-article-remove-trailing-blank-lines
2053   "l" gnus-article-strip-leading-blank-lines
2054   "m" gnus-article-strip-multiple-blank-lines
2055   "a" gnus-article-strip-blank-lines
2056   "A" gnus-article-strip-all-blank-lines
2057   "s" gnus-article-strip-leading-space
2058   "e" gnus-article-strip-trailing-space
2059   "w" gnus-article-remove-leading-whitespace)
2060
2061 (gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map)
2062   "v" gnus-version
2063   "f" gnus-summary-fetch-faq
2064   "d" gnus-summary-describe-group
2065   "h" gnus-summary-describe-briefly
2066   "i" gnus-info-find-node
2067   "c" gnus-group-fetch-charter
2068   "C" gnus-group-fetch-control)
2069
2070 (gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map)
2071   "e" gnus-summary-expire-articles
2072   "\M-\C-e" gnus-summary-expire-articles-now
2073   "\177" gnus-summary-delete-article
2074   [delete] gnus-summary-delete-article
2075   [backspace] gnus-summary-delete-article
2076   "m" gnus-summary-move-article
2077   "r" gnus-summary-respool-article
2078   "w" gnus-summary-edit-article
2079   "c" gnus-summary-copy-article
2080   "B" gnus-summary-crosspost-article
2081   "q" gnus-summary-respool-query
2082   "t" gnus-summary-respool-trace
2083   "i" gnus-summary-import-article
2084   "I" gnus-summary-create-article
2085   "p" gnus-summary-article-posted-p)
2086
2087 (gnus-define-keys (gnus-summary-save-map "O" gnus-summary-mode-map)
2088   "o" gnus-summary-save-article
2089   "m" gnus-summary-save-article-mail
2090   "F" gnus-summary-write-article-file
2091   "r" gnus-summary-save-article-rmail
2092   "f" gnus-summary-save-article-file
2093   "b" gnus-summary-save-article-body-file
2094   "B" gnus-summary-write-article-body-file
2095   "h" gnus-summary-save-article-folder
2096   "v" gnus-summary-save-article-vm
2097   "p" gnus-summary-pipe-output
2098   "P" gnus-summary-muttprint
2099   "s" gnus-soup-add-article)
2100
2101 (gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map)
2102   "b" gnus-summary-display-buttonized
2103   "m" gnus-summary-repair-multipart
2104   "v" gnus-article-view-part
2105   "o" gnus-article-save-part
2106   "O" gnus-article-save-part-and-strip
2107   "r" gnus-article-replace-part
2108   "d" gnus-article-delete-part
2109   "t" gnus-article-view-part-as-type
2110   "j" gnus-article-jump-to-part
2111   "c" gnus-article-copy-part
2112   "C" gnus-article-view-part-as-charset
2113   "e" gnus-article-view-part-externally
2114   "H" gnus-article-browse-html-article
2115   "E" gnus-article-encrypt-body
2116   "i" gnus-article-inline-part
2117   "|" gnus-article-pipe-part)
2118
2119 (gnus-define-keys (gnus-uu-mark-map "P" gnus-summary-mark-map)
2120   "p" gnus-summary-mark-as-processable
2121   "u" gnus-summary-unmark-as-processable
2122   "U" gnus-summary-unmark-all-processable
2123   "v" gnus-uu-mark-over
2124   "s" gnus-uu-mark-series
2125   "r" gnus-uu-mark-region
2126   "g" gnus-uu-unmark-region
2127   "R" gnus-uu-mark-by-regexp
2128   "G" gnus-uu-unmark-by-regexp
2129   "t" gnus-uu-mark-thread
2130   "T" gnus-uu-unmark-thread
2131   "a" gnus-uu-mark-all
2132   "b" gnus-uu-mark-buffer
2133   "S" gnus-uu-mark-sparse
2134   "k" gnus-summary-kill-process-mark
2135   "y" gnus-summary-yank-process-mark
2136   "w" gnus-summary-save-process-mark
2137   "i" gnus-uu-invert-processable)
2138
2139 (gnus-define-keys (gnus-uu-extract-map "X" gnus-summary-mode-map)
2140   ;;"x" gnus-uu-extract-any
2141   "m" gnus-summary-save-parts
2142   "u" gnus-uu-decode-uu
2143   "U" gnus-uu-decode-uu-and-save
2144   "s" gnus-uu-decode-unshar
2145   "S" gnus-uu-decode-unshar-and-save
2146   "o" gnus-uu-decode-save
2147   "O" gnus-uu-decode-save
2148   "b" gnus-uu-decode-binhex
2149   "B" gnus-uu-decode-binhex
2150   "p" gnus-uu-decode-postscript
2151   "P" gnus-uu-decode-postscript-and-save)
2152
2153 (gnus-define-keys
2154     (gnus-uu-extract-view-map "v" gnus-uu-extract-map)
2155   "u" gnus-uu-decode-uu-view
2156   "U" gnus-uu-decode-uu-and-save-view
2157   "s" gnus-uu-decode-unshar-view
2158   "S" gnus-uu-decode-unshar-and-save-view
2159   "o" gnus-uu-decode-save-view
2160   "O" gnus-uu-decode-save-view
2161   "b" gnus-uu-decode-binhex-view
2162   "B" gnus-uu-decode-binhex-view
2163   "p" gnus-uu-decode-postscript-view
2164   "P" gnus-uu-decode-postscript-and-save-view)
2165
2166 (defvar gnus-article-post-menu nil)
2167
2168 (defconst gnus-summary-menu-maxlen 20)
2169
2170 (defun gnus-summary-menu-split (menu)
2171   ;; If we have lots of elements, divide them into groups of 20
2172   ;; and make a pane (or submenu) for each one.
2173   (if (> (length menu) (/ (* gnus-summary-menu-maxlen 3) 2))
2174       (let ((menu menu) sublists next
2175             (i 1))
2176         (while menu
2177           ;; Pull off the next gnus-summary-menu-maxlen elements
2178           ;; and make them the next element of sublist.
2179           (setq next (nthcdr gnus-summary-menu-maxlen menu))
2180           (if next
2181               (setcdr (nthcdr (1- gnus-summary-menu-maxlen) menu)
2182                       nil))
2183           (setq sublists (cons (cons (format "%s ... %s" (aref (car menu) 0)
2184                                              (aref (car (last menu)) 0)) menu)
2185                                sublists))
2186           (setq i (1+ i))
2187           (setq menu next))
2188         (nreverse sublists))
2189     ;; Few elements--put them all in one pane.
2190     menu))
2191
2192 (defun gnus-summary-make-menu-bar ()
2193   (gnus-turn-off-edit-menu 'summary)
2194
2195   (unless (boundp 'gnus-summary-misc-menu)
2196
2197     (easy-menu-define
2198       gnus-summary-kill-menu gnus-summary-mode-map ""
2199       (cons
2200        "Score"
2201        (nconc
2202         (list
2203          ["Customize" gnus-score-customize t])
2204         (gnus-make-score-map 'increase)
2205         (gnus-make-score-map 'lower)
2206         '(("Mark"
2207            ["Kill below" gnus-summary-kill-below t]
2208            ["Mark above" gnus-summary-mark-above t]
2209            ["Tick above" gnus-summary-tick-above t]
2210            ["Clear above" gnus-summary-clear-above t])
2211           ["Current score" gnus-summary-current-score t]
2212           ["Set score" gnus-summary-set-score t]
2213           ["Switch current score file..." gnus-score-change-score-file t]
2214           ["Set mark below..." gnus-score-set-mark-below t]
2215           ["Set expunge below..." gnus-score-set-expunge-below t]
2216           ["Edit current score file" gnus-score-edit-current-scores t]
2217           ["Edit score file" gnus-score-edit-file t]
2218           ["Trace score" gnus-score-find-trace t]
2219           ["Find words" gnus-score-find-favourite-words t]
2220           ["Rescore buffer" gnus-summary-rescore t]
2221           ["Increase score..." gnus-summary-increase-score t]
2222           ["Lower score..." gnus-summary-lower-score t]))))
2223
2224     ;; Define both the Article menu in the summary buffer and the
2225     ;; equivalent Commands menu in the article buffer here for
2226     ;; consistency.
2227     (let ((innards
2228            `(("Hide"
2229               ["All" gnus-article-hide t]
2230               ["Headers" gnus-article-hide-headers t]
2231               ["Signature" gnus-article-hide-signature t]
2232               ["Citation" gnus-article-hide-citation t]
2233               ["List identifiers" gnus-article-hide-list-identifiers t]
2234               ["Banner" gnus-article-strip-banner t]
2235               ["Boring headers" gnus-article-hide-boring-headers t])
2236              ("Highlight"
2237               ["All" gnus-article-highlight t]
2238               ["Headers" gnus-article-highlight-headers t]
2239               ["Signature" gnus-article-highlight-signature t]
2240               ["Citation" gnus-article-highlight-citation t])
2241              ("MIME"
2242               ["Words" gnus-article-decode-mime-words t]
2243               ["Charset" gnus-article-decode-charset t]
2244               ["QP" gnus-article-de-quoted-unreadable t]
2245               ["Base64" gnus-article-de-base64-unreadable t]
2246               ["View MIME buttons" gnus-summary-display-buttonized t]
2247               ["View all" gnus-mime-view-all-parts t]
2248               ["Verify and Decrypt" gnus-summary-force-verify-and-decrypt t]
2249               ["Encrypt body" gnus-article-encrypt-body
2250                :active (not (gnus-group-read-only-p))
2251                ,@(if (featurep 'xemacs) nil
2252                    '(:help "Encrypt the message body on disk"))]
2253               ["Extract all parts..." gnus-summary-save-parts t]
2254               ("Multipart"
2255                ["Repair multipart" gnus-summary-repair-multipart t]
2256                ["Pipe part..." gnus-article-pipe-part t]
2257                ["Inline part" gnus-article-inline-part t]
2258                ["View part as type..." gnus-article-view-part-as-type t]
2259                ["Encrypt body" gnus-article-encrypt-body
2260                 :active (not (gnus-group-read-only-p))
2261                ,@(if (featurep 'xemacs) nil
2262                    '(:help "Encrypt the message body on disk"))]
2263                ["View part externally" gnus-article-view-part-externally t]
2264                ["View HTML parts in browser" gnus-article-browse-html-article t]
2265                ["View part with charset..." gnus-article-view-part-as-charset t]
2266                ["Copy part" gnus-article-copy-part t]
2267                ["Save part..." gnus-article-save-part t]
2268                ["View part" gnus-article-view-part t]))
2269              ("Date"
2270               ["Local" gnus-article-date-local t]
2271               ["ISO8601" gnus-article-date-iso8601 t]
2272               ["UT" gnus-article-date-ut t]
2273               ["Original" gnus-article-date-original t]
2274               ["Lapsed" gnus-article-date-lapsed t]
2275               ["User-defined" gnus-article-date-user t])
2276              ("Display"
2277               ["Remove images" gnus-article-remove-images t]
2278               ["Toggle smiley" gnus-treat-smiley t]
2279               ["Show X-Face" gnus-article-display-x-face t]
2280               ["Show picons in From" gnus-treat-from-picon t]
2281               ["Show picons in mail headers" gnus-treat-mail-picon t]
2282               ["Show picons in news headers" gnus-treat-newsgroups-picon t]
2283               ("View as different encoding"
2284                ,@(gnus-summary-menu-split
2285                   (mapcar
2286                    (lambda (cs)
2287                      ;; Since easymenu under Emacs doesn't allow
2288                      ;; lambda forms for menu commands, we should
2289                      ;; provide intern'ed function symbols.
2290                      (let ((command (intern (format "\
2291 gnus-summary-show-article-from-menu-as-charset-%s" cs))))
2292                        (fset command
2293                              `(lambda ()
2294                                 (interactive)
2295                                 (let ((gnus-summary-show-article-charset-alist
2296                                        '((1 . ,cs))))
2297                                   (gnus-summary-show-article 1))))
2298                        `[,(symbol-name cs) ,command t]))
2299                    (sort (if (fboundp 'coding-system-list)
2300                              (coding-system-list)
2301                            (mapcar 'car mm-mime-mule-charset-alist))
2302                          'string<)))))
2303              ("Washing"
2304               ("Remove Blanks"
2305                ["Leading" gnus-article-strip-leading-blank-lines t]
2306                ["Multiple" gnus-article-strip-multiple-blank-lines t]
2307                ["Trailing" gnus-article-remove-trailing-blank-lines t]
2308                ["All of the above" gnus-article-strip-blank-lines t]
2309                ["All" gnus-article-strip-all-blank-lines t]
2310                ["Leading space" gnus-article-strip-leading-space t]
2311                ["Trailing space" gnus-article-strip-trailing-space t]
2312                ["Leading space in headers"
2313                 gnus-article-remove-leading-whitespace t])
2314               ["Overstrike" gnus-article-treat-overstrike t]
2315               ["Dumb quotes" gnus-article-treat-dumbquotes t]
2316               ["Emphasis" gnus-article-emphasize t]
2317               ["Word wrap" gnus-article-fill-cited-article t]
2318               ["Fill long lines" gnus-article-fill-long-lines t]
2319               ["Toggle truncate long lines" gnus-article-toggle-truncate-lines t]
2320               ["Capitalize sentences" gnus-article-capitalize-sentences t]
2321               ["Remove CR" gnus-article-remove-cr t]
2322               ["Quoted-Printable" gnus-article-de-quoted-unreadable t]
2323               ["Base64" gnus-article-de-base64-unreadable t]
2324               ["Rot 13" gnus-summary-caesar-message
2325                ,@(if (featurep 'xemacs) '(t)
2326                    '(:help "\"Caesar rotate\" article by 13"))]
2327               ["De-IDNA" gnus-summary-idna-message t]
2328               ["Morse decode" gnus-summary-morse-message t]
2329               ["Unix pipe..." gnus-summary-pipe-message t]
2330               ["Add buttons" gnus-article-add-buttons t]
2331               ["Add buttons to head" gnus-article-add-buttons-to-head t]
2332               ["Stop page breaking" gnus-summary-stop-page-breaking t]
2333               ["Verbose header" gnus-summary-verbose-headers t]
2334               ["Toggle header" gnus-summary-toggle-header t]
2335               ["Unfold headers" gnus-article-treat-unfold-headers t]
2336               ["Fold newsgroups" gnus-article-treat-fold-newsgroups t]
2337               ["Html" gnus-article-wash-html t]
2338               ["Unsplit URLs" gnus-article-unsplit-urls t]
2339               ["Verify X-PGP-Sig" gnus-article-verify-x-pgp-sig t]
2340               ["Decode HZ" gnus-article-decode-HZ t]
2341               ["ANSI sequences" gnus-article-treat-ansi-sequences t]
2342               ("(Outlook) Deuglify"
2343                ["Unwrap lines" gnus-article-outlook-unwrap-lines t]
2344                ["Repair attribution" gnus-article-outlook-repair-attribution t]
2345                ["Rearrange citation" gnus-article-outlook-rearrange-citation t]
2346                ["Full (Outlook) deuglify"
2347                 gnus-article-outlook-deuglify-article t])
2348               )
2349              ("Output"
2350               ["Save in default format..." gnus-summary-save-article
2351                ,@(if (featurep 'xemacs) '(t)
2352                    '(:help "Save article using default method"))]
2353               ["Save in file..." gnus-summary-save-article-file
2354                ,@(if (featurep 'xemacs) '(t)
2355                    '(:help "Save article in file"))]
2356               ["Save in Unix mail format..." gnus-summary-save-article-mail t]
2357               ["Save in MH folder..." gnus-summary-save-article-folder t]
2358               ["Save in VM folder..." gnus-summary-save-article-vm t]
2359               ["Save in RMAIL mbox..." gnus-summary-save-article-rmail t]
2360               ["Save body in file..." gnus-summary-save-article-body-file t]
2361               ["Pipe through a filter..." gnus-summary-pipe-output t]
2362               ["Add to SOUP packet" gnus-soup-add-article t]
2363               ["Print with Muttprint..." gnus-summary-muttprint t]
2364               ["Print" gnus-summary-print-article
2365                ,@(if (featurep 'xemacs) '(t)
2366                    '(:help "Generate and print a PostScript image"))])
2367              ("Copy, move,... (Backend)"
2368               ,@(if (featurep 'xemacs) nil
2369                   '(:help "Copying, moving, expiring articles..."))
2370               ["Respool article..." gnus-summary-respool-article t]
2371               ["Move article..." gnus-summary-move-article
2372                (gnus-check-backend-function
2373                 'request-move-article gnus-newsgroup-name)]
2374               ["Copy article..." gnus-summary-copy-article t]
2375               ["Crosspost article..." gnus-summary-crosspost-article
2376                (gnus-check-backend-function
2377                 'request-replace-article gnus-newsgroup-name)]
2378               ["Import file..." gnus-summary-import-article
2379                (gnus-check-backend-function
2380                 'request-accept-article gnus-newsgroup-name)]
2381               ["Create article..." gnus-summary-create-article
2382                (gnus-check-backend-function
2383                 'request-accept-article gnus-newsgroup-name)]
2384               ["Check if posted" gnus-summary-article-posted-p t]
2385               ["Edit article" gnus-summary-edit-article
2386                (not (gnus-group-read-only-p))]
2387               ["Delete article" gnus-summary-delete-article
2388                (gnus-check-backend-function
2389                 'request-expire-articles gnus-newsgroup-name)]
2390               ["Query respool" gnus-summary-respool-query t]
2391               ["Trace respool" gnus-summary-respool-trace t]
2392               ["Delete expirable articles" gnus-summary-expire-articles-now
2393                (gnus-check-backend-function
2394                 'request-expire-articles gnus-newsgroup-name)])
2395              ("Extract"
2396               ["Uudecode" gnus-uu-decode-uu
2397                ,@(if (featurep 'xemacs) '(t)
2398                    '(:help "Decode uuencoded article(s)"))]
2399               ["Uudecode and save" gnus-uu-decode-uu-and-save t]
2400               ["Unshar" gnus-uu-decode-unshar t]
2401               ["Unshar and save" gnus-uu-decode-unshar-and-save t]
2402               ["Save" gnus-uu-decode-save t]
2403               ["Binhex" gnus-uu-decode-binhex t]
2404               ["Postscript" gnus-uu-decode-postscript t]
2405               ["All MIME parts" gnus-summary-save-parts t])
2406              ("Cache"
2407               ["Enter article" gnus-cache-enter-article t]
2408               ["Remove article" gnus-cache-remove-article t])
2409              ["Translate" gnus-article-babel t]
2410              ["Select article buffer" gnus-summary-select-article-buffer t]
2411              ["Enter digest buffer" gnus-summary-enter-digest-group t]
2412              ["Isearch article..." gnus-summary-isearch-article t]
2413              ["Beginning of the article" gnus-summary-beginning-of-article t]
2414              ["End of the article" gnus-summary-end-of-article t]
2415              ["Fetch parent of article" gnus-summary-refer-parent-article t]
2416              ["Fetch referenced articles" gnus-summary-refer-references t]
2417              ["Fetch current thread" gnus-summary-refer-thread t]
2418              ["Fetch article with id..." gnus-summary-refer-article t]
2419              ["Setup Mailing List Params" gnus-mailing-list-insinuate t]
2420              ["Redisplay" gnus-summary-show-article t]
2421              ["Raw article" gnus-summary-show-raw-article :keys "C-u g"])))
2422       (easy-menu-define
2423         gnus-summary-article-menu gnus-summary-mode-map ""
2424         (cons "Article" innards))
2425
2426       (if (not (keymapp gnus-summary-article-menu))
2427           (easy-menu-define
2428             gnus-article-commands-menu gnus-article-mode-map ""
2429             (cons "Commands" innards))
2430         ;; in Emacs, don't share menu.
2431         (setq gnus-article-commands-menu
2432               (copy-keymap gnus-summary-article-menu))
2433         (define-key gnus-article-mode-map [menu-bar commands]
2434           (cons "Commands" gnus-article-commands-menu))))
2435
2436     (easy-menu-define
2437       gnus-summary-thread-menu gnus-summary-mode-map ""
2438       '("Threads"
2439         ["Find all messages in thread" gnus-summary-refer-thread t]
2440         ["Toggle threading" gnus-summary-toggle-threads t]
2441         ["Hide threads" gnus-summary-hide-all-threads t]
2442         ["Show threads" gnus-summary-show-all-threads t]
2443         ["Hide thread" gnus-summary-hide-thread t]
2444         ["Show thread" gnus-summary-show-thread t]
2445         ["Go to next thread" gnus-summary-next-thread t]
2446         ["Go to previous thread" gnus-summary-prev-thread t]
2447         ["Go down thread" gnus-summary-down-thread t]
2448         ["Go up thread" gnus-summary-up-thread t]
2449         ["Top of thread" gnus-summary-top-thread t]
2450         ["Mark thread as read" gnus-summary-kill-thread t]
2451         ["Lower thread score" gnus-summary-lower-thread t]
2452         ["Raise thread score" gnus-summary-raise-thread t]
2453         ["Rethread current" gnus-summary-rethread-current t]))
2454
2455     (easy-menu-define
2456       gnus-summary-post-menu gnus-summary-mode-map ""
2457       `("Post"
2458         ["Send a message (mail or news)" gnus-summary-post-news
2459          ,@(if (featurep 'xemacs) '(t)
2460              '(:help "Compose a new message (mail or news)"))]
2461         ["Followup" gnus-summary-followup
2462          ,@(if (featurep 'xemacs) '(t)
2463              '(:help "Post followup to this article"))]
2464         ["Followup and yank" gnus-summary-followup-with-original
2465          ,@(if (featurep 'xemacs) '(t)
2466              '(:help "Post followup to this article, quoting its contents"))]
2467         ["Supersede article" gnus-summary-supersede-article t]
2468         ["Cancel article" gnus-summary-cancel-article
2469          ,@(if (featurep 'xemacs) '(t)
2470              '(:help "Cancel an article you posted"))]
2471         ["Reply" gnus-summary-reply t]
2472         ["Reply and yank" gnus-summary-reply-with-original t]
2473         ["Wide reply" gnus-summary-wide-reply t]
2474         ["Wide reply and yank" gnus-summary-wide-reply-with-original
2475          ,@(if (featurep 'xemacs) '(t)
2476              '(:help "Mail a reply, quoting this article"))]
2477         ["Very wide reply" gnus-summary-very-wide-reply t]
2478         ["Very wide reply and yank" gnus-summary-very-wide-reply-with-original
2479          ,@(if (featurep 'xemacs) '(t)
2480              '(:help "Mail a very wide reply, quoting this article"))]
2481         ["Mail forward" gnus-summary-mail-forward t]
2482         ["Post forward" gnus-summary-post-forward t]
2483         ["Digest and mail" gnus-uu-digest-mail-forward t]
2484         ["Digest and post" gnus-uu-digest-post-forward t]
2485         ["Resend message" gnus-summary-resend-message t]
2486         ["Resend message edit" gnus-summary-resend-message-edit t]
2487         ["Send bounced mail" gnus-summary-resend-bounced-mail t]
2488         ["Send a mail" gnus-summary-mail-other-window t]
2489         ["Create a local message" gnus-summary-news-other-window t]
2490         ["Uuencode and post" gnus-uu-post-news
2491          ,@(if (featurep 'xemacs) '(t)
2492              '(:help "Post a uuencoded article"))]
2493         ["Followup via news" gnus-summary-followup-to-mail t]
2494         ["Followup via news and yank"
2495          gnus-summary-followup-to-mail-with-original t]
2496         ;;("Draft"
2497         ;;["Send" gnus-summary-send-draft t]
2498         ;;["Send bounced" gnus-resend-bounced-mail t])
2499         ))
2500
2501     (cond
2502      ((not (keymapp gnus-summary-post-menu))
2503       (setq gnus-article-post-menu gnus-summary-post-menu))
2504      ((not gnus-article-post-menu)
2505       ;; Don't share post menu.
2506       (setq gnus-article-post-menu
2507             (copy-keymap gnus-summary-post-menu))))
2508     (define-key gnus-article-mode-map [menu-bar post]
2509       (cons "Post" gnus-article-post-menu))
2510
2511     (easy-menu-define
2512       gnus-summary-misc-menu gnus-summary-mode-map ""
2513       `("Gnus"
2514         ("Mark Read"
2515          ["Mark as read" gnus-summary-mark-as-read-forward t]
2516          ["Mark same subject and select"
2517           gnus-summary-kill-same-subject-and-select t]
2518          ["Mark same subject" gnus-summary-kill-same-subject t]
2519          ["Catchup" gnus-summary-catchup
2520           ,@(if (featurep 'xemacs) '(t)
2521               '(:help "Mark unread articles in this group as read"))]
2522          ["Catchup all" gnus-summary-catchup-all t]
2523          ["Catchup to here" gnus-summary-catchup-to-here t]
2524          ["Catchup from here" gnus-summary-catchup-from-here t]
2525          ["Catchup region" gnus-summary-mark-region-as-read
2526           (gnus-mark-active-p)]
2527          ["Mark excluded" gnus-summary-limit-mark-excluded-as-read t])
2528         ("Mark Various"
2529          ["Tick" gnus-summary-tick-article-forward t]
2530          ["Mark as dormant" gnus-summary-mark-as-dormant t]
2531          ["Remove marks" gnus-summary-clear-mark-forward t]
2532          ["Set expirable mark" gnus-summary-mark-as-expirable t]
2533          ["Set bookmark" gnus-summary-set-bookmark t]
2534          ["Remove bookmark" gnus-summary-remove-bookmark t])
2535         ("Limit to"
2536          ["Marks..." gnus-summary-limit-to-marks t]
2537          ["Subject..." gnus-summary-limit-to-subject t]
2538          ["Author..." gnus-summary-limit-to-author t]
2539          ["Recipient..." gnus-summary-limit-to-recipient t]
2540          ["Age..." gnus-summary-limit-to-age t]
2541          ["Extra..." gnus-summary-limit-to-extra t]
2542          ["Score..." gnus-summary-limit-to-score t]
2543          ["Display Predicate" gnus-summary-limit-to-display-predicate t]
2544          ["Unread" gnus-summary-limit-to-unread t]
2545          ["Unseen" gnus-summary-limit-to-unseen t]
2546          ["Singletons" gnus-summary-limit-to-singletons t]
2547          ["Replied" gnus-summary-limit-to-replied t]
2548          ["Non-dormant" gnus-summary-limit-exclude-dormant t]
2549          ["Next or process marked articles" gnus-summary-limit-to-articles t]
2550          ["Pop limit" gnus-summary-pop-limit t]
2551          ["Show dormant" gnus-summary-limit-include-dormant t]
2552          ["Hide childless dormant"
2553           gnus-summary-limit-exclude-childless-dormant t]
2554          ;;["Hide thread" gnus-summary-limit-exclude-thread t]
2555          ["Hide marked" gnus-summary-limit-exclude-marks t]
2556          ["Show expunged" gnus-summary-limit-include-expunged t])
2557         ("Process Mark"
2558          ["Set mark" gnus-summary-mark-as-processable t]
2559          ["Remove mark" gnus-summary-unmark-as-processable t]
2560          ["Remove all marks" gnus-summary-unmark-all-processable t]
2561          ["Invert marks" gnus-uu-invert-processable t]
2562          ["Mark above" gnus-uu-mark-over t]
2563          ["Mark series" gnus-uu-mark-series t]
2564          ["Mark region" gnus-uu-mark-region (gnus-mark-active-p)]
2565          ["Unmark region" gnus-uu-unmark-region (gnus-mark-active-p)]
2566          ["Mark by regexp..." gnus-uu-mark-by-regexp t]
2567          ["Unmark by regexp..." gnus-uu-unmark-by-regexp t]
2568          ["Mark all" gnus-uu-mark-all t]
2569          ["Mark buffer" gnus-uu-mark-buffer t]
2570          ["Mark sparse" gnus-uu-mark-sparse t]
2571          ["Mark thread" gnus-uu-mark-thread t]
2572          ["Unmark thread" gnus-uu-unmark-thread t]
2573          ("Process Mark Sets"
2574           ["Kill" gnus-summary-kill-process-mark t]
2575           ["Yank" gnus-summary-yank-process-mark
2576            gnus-newsgroup-process-stack]
2577           ["Save" gnus-summary-save-process-mark t]
2578           ["Run command on marked..." gnus-summary-universal-argument t]))
2579         ("Scroll article"
2580          ["Page forward" gnus-summary-next-page
2581           ,@(if (featurep 'xemacs) '(t)
2582               '(:help "Show next page of article"))]
2583          ["Page backward" gnus-summary-prev-page
2584           ,@(if (featurep 'xemacs) '(t)
2585               '(:help "Show previous page of article"))]
2586          ["Line forward" gnus-summary-scroll-up t])
2587         ("Move"
2588          ["Next unread article" gnus-summary-next-unread-article t]
2589          ["Previous unread article" gnus-summary-prev-unread-article t]
2590          ["Next article" gnus-summary-next-article t]
2591          ["Previous article" gnus-summary-prev-article t]
2592          ["Next unread subject" gnus-summary-next-unread-subject t]
2593          ["Previous unread subject" gnus-summary-prev-unread-subject t]
2594          ["Next article same subject" gnus-summary-next-same-subject t]
2595          ["Previous article same subject" gnus-summary-prev-same-subject t]
2596          ["First unread article" gnus-summary-first-unread-article t]
2597          ["Best unread article" gnus-summary-best-unread-article t]
2598          ["Go to subject number..." gnus-summary-goto-subject t]
2599          ["Go to article number..." gnus-summary-goto-article t]
2600          ["Go to the last article" gnus-summary-goto-last-article t]
2601          ["Pop article off history" gnus-summary-pop-article t])
2602         ("Sort"
2603          ["Sort by number" gnus-summary-sort-by-number t]
2604          ["Sort by author" gnus-summary-sort-by-author t]
2605          ["Sort by recipient" gnus-summary-sort-by-recipient t]
2606          ["Sort by subject" gnus-summary-sort-by-subject t]
2607          ["Sort by date" gnus-summary-sort-by-date t]
2608          ["Sort by score" gnus-summary-sort-by-score t]
2609          ["Sort by lines" gnus-summary-sort-by-lines t]
2610          ["Sort by characters" gnus-summary-sort-by-chars t]
2611          ["Randomize" gnus-summary-sort-by-random t]
2612          ["Original sort" gnus-summary-sort-by-original t])
2613         ("Help"
2614          ["Fetch group FAQ" gnus-summary-fetch-faq t]
2615          ["Describe group" gnus-summary-describe-group t]
2616          ["Fetch charter" gnus-group-fetch-charter
2617           ,@(if (featurep 'xemacs) nil
2618               '(:help "Display the charter of the current group"))]
2619          ["Fetch control message" gnus-group-fetch-control
2620           ,@(if (featurep 'xemacs) nil
2621               '(:help "Display the archived control message for the current group"))]
2622          ["Read manual" gnus-info-find-node t])
2623         ("Modes"
2624          ["Pick and read" gnus-pick-mode t]
2625          ["Binary" gnus-binary-mode t])
2626         ("Regeneration"
2627          ["Regenerate" gnus-summary-prepare t]
2628          ["Insert cached articles" gnus-summary-insert-cached-articles t]
2629          ["Insert dormant articles" gnus-summary-insert-dormant-articles t]
2630          ["Insert ticked articles" gnus-summary-insert-ticked-articles t]
2631          ["Toggle threading" gnus-summary-toggle-threads t])
2632         ["See old articles" gnus-summary-insert-old-articles t]
2633         ["See new articles" gnus-summary-insert-new-articles t]
2634         ["Filter articles..." gnus-summary-execute-command t]
2635         ["Run command on articles..." gnus-summary-universal-argument t]
2636         ["Search articles forward..." gnus-summary-search-article-forward t]
2637         ["Search articles backward..." gnus-summary-search-article-backward t]
2638         ["Toggle line truncation" gnus-summary-toggle-truncation t]
2639         ["Expand window" gnus-summary-expand-window t]
2640         ["Expire expirable articles" gnus-summary-expire-articles
2641          (gnus-check-backend-function
2642           'request-expire-articles gnus-newsgroup-name)]
2643         ["Edit local kill file" gnus-summary-edit-local-kill t]
2644         ["Edit main kill file" gnus-summary-edit-global-kill t]
2645         ["Edit group parameters" gnus-summary-edit-parameters t]
2646         ["Customize group parameters" gnus-summary-customize-parameters t]
2647         ["Send a bug report" gnus-bug t]
2648         ("Exit"
2649          ["Catchup and exit" gnus-summary-catchup-and-exit
2650           ,@(if (featurep 'xemacs) '(t)
2651               '(:help "Mark unread articles in this group as read, then exit"))]
2652          ["Catchup all and exit" gnus-summary-catchup-all-and-exit t]
2653          ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t]
2654          ["Catchup and goto prev" gnus-summary-catchup-and-goto-prev-group t]
2655          ["Exit group" gnus-summary-exit
2656           ,@(if (featurep 'xemacs) '(t)
2657               '(:help "Exit current group, return to group selection mode"))]
2658          ["Exit group without updating" gnus-summary-exit-no-update t]
2659          ["Exit and goto next group" gnus-summary-next-group t]
2660          ["Exit and goto prev group" gnus-summary-prev-group t]
2661          ["Reselect group" gnus-summary-reselect-current-group t]
2662          ["Rescan group" gnus-summary-rescan-group t]
2663          ["Update dribble" gnus-summary-save-newsrc t])))
2664
2665     (gnus-run-hooks 'gnus-summary-menu-hook)))
2666
2667 (defvar gnus-summary-tool-bar-map nil)
2668
2669 ;; Note: The :set function in the `gnus-summary-tool-bar*' variables will only
2670 ;; affect _new_ message buffers.  We might add a function that walks thru all
2671 ;; summary-mode buffers and force the update.
2672 (defun gnus-summary-tool-bar-update (&optional symbol value)
2673   "Update summary mode toolbar.
2674 Setter function for custom variables."
2675   (setq-default gnus-summary-tool-bar-map nil)
2676   (when symbol
2677     ;; When used as ":set" function:
2678     (set-default symbol value))
2679   (when (gnus-buffer-live-p gnus-summary-buffer)
2680     (with-current-buffer gnus-summary-buffer
2681       (gnus-summary-make-tool-bar))))
2682
2683 (defcustom gnus-summary-tool-bar (if (eq gmm-tool-bar-style 'gnome)
2684                                      'gnus-summary-tool-bar-gnome
2685                                    'gnus-summary-tool-bar-retro)
2686   "Specifies the Gnus summary tool bar.
2687
2688 It can be either a list or a symbol refering to a list.  See
2689 `gmm-tool-bar-from-list' for the format of the list.  The
2690 default key map is `gnus-summary-mode-map'.
2691
2692 Pre-defined symbols include `gnus-summary-tool-bar-gnome' and
2693 `gnus-summary-tool-bar-retro'."
2694   :type '(choice (const :tag "GNOME style" gnus-summary-tool-bar-gnome)
2695                  (const :tag "Retro look"  gnus-summary-tool-bar-retro)
2696                  (repeat :tag "User defined list" gmm-tool-bar-item)
2697                  (symbol))
2698   :version "23.0" ;; No Gnus
2699   :initialize 'custom-initialize-default
2700   :set 'gnus-summary-tool-bar-update
2701   :group 'gnus-summary)
2702
2703 (defcustom gnus-summary-tool-bar-gnome
2704   '((gnus-summary-post-news "mail/compose" nil)
2705     (gnus-summary-insert-new-articles "mail/inbox" nil
2706                                       :visible (or (not gnus-agent)
2707                                                    gnus-plugged))
2708     (gnus-summary-reply-with-original "mail/reply")
2709     (gnus-summary-reply "mail/reply" nil :visible nil)
2710     (gnus-summary-followup-with-original "mail/reply-all")
2711     (gnus-summary-followup "mail/reply-all" nil :visible nil)
2712     (gnus-summary-mail-forward "mail/forward")
2713     (gnus-summary-save-article "mail/save")
2714     (gnus-summary-search-article-forward "search" nil :visible nil)
2715     (gnus-summary-print-article "print")
2716     (gnus-summary-tick-article-forward "flag-followup" nil :visible nil)
2717     ;; Some new commands that may need more suitable icons:
2718     (gnus-summary-save-newsrc "save" nil :visible nil)
2719     ;; (gnus-summary-show-article "stock_message-display" nil :visible nil)
2720     (gnus-summary-prev-article "left-arrow")
2721     (gnus-summary-next-article "right-arrow")
2722     (gnus-summary-next-page "next-page")
2723     ;; (gnus-summary-enter-digest-group "right_arrow" nil :visible nil)
2724     ;;
2725     ;; Maybe some sort-by-... could be added:
2726     ;; (gnus-summary-sort-by-author "sort-a-z" nil :visible nil)
2727     ;; (gnus-summary-sort-by-date "sort-1-9" nil :visible nil)
2728     (gnus-summary-mark-as-expirable
2729      "delete" nil
2730      :visible (gnus-check-backend-function 'request-expire-articles
2731                                            gnus-newsgroup-name))
2732     (gnus-summary-mark-as-spam
2733      "mail/spam" t
2734      :visible (and (fboundp 'spam-group-ham-contents-p)
2735                    (spam-group-ham-contents-p gnus-newsgroup-name))
2736      :help "Mark as spam")
2737     (gnus-summary-mark-as-read-forward
2738      "mail/not-spam" nil
2739      :visible (and (fboundp 'spam-group-spam-contents-p)
2740                    (spam-group-spam-contents-p gnus-newsgroup-name)))
2741     ;;
2742     (gnus-summary-exit "exit")
2743     (gmm-customize-mode "preferences" t :help "Edit mode preferences")
2744     (gnus-info-find-node "help"))
2745   "List of functions for the summary tool bar (GNOME style).
2746
2747 See `gmm-tool-bar-from-list' for the format of the list."
2748   :type '(repeat gmm-tool-bar-item)
2749   :version "23.0" ;; No Gnus
2750   :initialize 'custom-initialize-default
2751   :set 'gnus-summary-tool-bar-update
2752   :group 'gnus-summary)
2753
2754 (defcustom gnus-summary-tool-bar-retro
2755   '((gnus-summary-prev-unread-article "gnus/prev-ur")
2756     (gnus-summary-next-unread-article "gnus/next-ur")
2757     (gnus-summary-post-news "gnus/post")
2758     (gnus-summary-followup-with-original "gnus/fuwo")
2759     (gnus-summary-followup "gnus/followup")
2760     (gnus-summary-reply-with-original "gnus/reply-wo")
2761     (gnus-summary-reply "gnus/reply")
2762     (gnus-summary-caesar-message "gnus/rot13")
2763     (gnus-uu-decode-uu "gnus/uu-decode")
2764     (gnus-summary-save-article-file "gnus/save-aif")
2765     (gnus-summary-save-article "gnus/save-art")
2766     (gnus-uu-post-news "gnus/uu-post")
2767     (gnus-summary-catchup "gnus/catchup")
2768     (gnus-summary-catchup-and-exit "gnus/cu-exit")
2769     (gnus-summary-exit "gnus/exit-summ")
2770     ;; Some new command that may need more suitable icons:
2771     (gnus-summary-print-article "gnus/print" nil :visible nil)
2772     (gnus-summary-mark-as-expirable "gnus/close" nil :visible nil)
2773     (gnus-summary-save-newsrc "gnus/save" nil :visible nil)
2774     ;; (gnus-summary-enter-digest-group "gnus/right_arrow" nil :visible nil)
2775     (gnus-summary-search-article-forward "gnus/search" nil :visible nil)
2776     ;; (gnus-summary-insert-new-articles "gnus/paste" nil :visible nil)
2777     ;; (gnus-summary-toggle-threads "gnus/open" nil :visible nil)
2778     ;;
2779     (gnus-info-find-node "gnus/help" nil :visible nil))
2780   "List of functions for the summary tool bar (retro look).
2781
2782 See `gmm-tool-bar-from-list' for the format of the list."
2783   :type '(repeat gmm-tool-bar-item)
2784   :version "23.0" ;; No Gnus
2785   :initialize 'custom-initialize-default
2786   :set 'gnus-summary-tool-bar-update
2787   :group 'gnus-summary)
2788
2789 (defcustom gnus-summary-tool-bar-zap-list t
2790   "List of icon items from the global tool bar.
2791 These items are not displayed in the Gnus summary mode tool bar.
2792
2793 See `gmm-tool-bar-from-list' for the format of the list."
2794   :type 'gmm-tool-bar-zap-list
2795   :version "23.0" ;; No Gnus
2796   :initialize 'custom-initialize-default
2797   :set 'gnus-summary-tool-bar-update
2798   :group 'gnus-summary)
2799
2800 (defvar image-load-path)
2801
2802 (defun gnus-summary-make-tool-bar (&optional force)
2803   "Make a summary mode tool bar from `gnus-summary-tool-bar'.
2804 When FORCE, rebuild the tool bar."
2805   (when (and (not (featurep 'xemacs))
2806              (boundp 'tool-bar-mode)
2807              tool-bar-mode
2808              (or (not gnus-summary-tool-bar-map) force))
2809     (let* ((load-path
2810             (gmm-image-load-path-for-library "gnus"
2811                                              "mail/save.xpm"
2812                                              nil t))
2813            (image-load-path (cons (car load-path)
2814                                   (when (boundp 'image-load-path)
2815                                     image-load-path)))
2816            (map (gmm-tool-bar-from-list gnus-summary-tool-bar
2817                                         gnus-summary-tool-bar-zap-list
2818                                         'gnus-summary-mode-map)))
2819       (when map
2820         ;; Need to set `gnus-summary-tool-bar-map' because `gnus-article-mode'
2821         ;; uses it's value.
2822         (setq gnus-summary-tool-bar-map map))))
2823   (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map))
2824
2825 (defun gnus-score-set-default (var value)
2826   "A version of set that updates the GNU Emacs menu-bar."
2827   (set var value)
2828   ;; It is the message that forces the active status to be updated.
2829   (message ""))
2830
2831 (defun gnus-make-score-map (type)
2832   "Make a summary score map of type TYPE."
2833   (if t
2834       nil
2835     (let ((headers '(("author" "from" string)
2836                      ("subject" "subject" string)
2837                      ("article body" "body" string)
2838                      ("article head" "head" string)
2839                      ("xref" "xref" string)
2840                      ("extra header" "extra" string)
2841                      ("lines" "lines" number)
2842                      ("followups to author" "followup" string)))
2843           (types '((number ("less than" <)
2844                            ("greater than" >)
2845                            ("equal" =))
2846                    (string ("substring" s)
2847                            ("exact string" e)
2848                            ("fuzzy string" f)
2849                            ("regexp" r))))
2850           (perms '(("temporary" (current-time-string))
2851                    ("permanent" nil)
2852                    ("immediate" now)))
2853           header)
2854       (list
2855        (apply
2856         'nconc
2857         (list
2858          (if (eq type 'lower)
2859              "Lower score"
2860            "Increase score"))
2861         (let (outh)
2862           (while headers
2863             (setq header (car headers))
2864             (setq outh
2865                   (cons
2866                    (apply
2867                     'nconc
2868                     (list (car header))
2869                     (let ((ts (cdr (assoc (nth 2 header) types)))
2870                           outt)
2871                       (while ts
2872                         (setq outt
2873                               (cons
2874                                (apply
2875                                 'nconc
2876                                 (list (caar ts))
2877                                 (let ((ps perms)
2878                                       outp)
2879                                   (while ps
2880                                     (setq outp
2881                                           (cons
2882                                            (vector
2883                                             (caar ps)
2884                                             (list
2885                                              'gnus-summary-score-entry
2886                                              (nth 1 header)
2887                                              (if (or (string= (nth 1 header)
2888                                                               "head")
2889                                                      (string= (nth 1 header)
2890                                                               "body"))
2891                                                  ""
2892                                                (list 'gnus-summary-header
2893                                                      (nth 1 header)))
2894                                              (list 'quote (nth 1 (car ts)))
2895                                              (list 'gnus-score-delta-default
2896                                                    nil)
2897                                              (nth 1 (car ps))
2898                                              t)
2899                                             t)
2900                                            outp))
2901                                     (setq ps (cdr ps)))
2902                                   (list (nreverse outp))))
2903                                outt))
2904                         (setq ts (cdr ts)))
2905                       (list (nreverse outt))))
2906                    outh))
2907             (setq headers (cdr headers)))
2908           (list (nreverse outh))))))))
2909
2910 \f
2911
2912 (defun gnus-summary-mode (&optional group)
2913   "Major mode for reading articles.
2914
2915 All normal editing commands are switched off.
2916 \\<gnus-summary-mode-map>
2917 Each line in this buffer represents one article.  To read an
2918 article, you can, for instance, type `\\[gnus-summary-next-page]'.  To move forwards
2919 and backwards while displaying articles, type `\\[gnus-summary-next-unread-article]' and `\\[gnus-summary-prev-unread-article]',
2920 respectively.
2921
2922 You can also post articles and send mail from this buffer.  To
2923 follow up an article, type `\\[gnus-summary-followup]'.  To mail a reply to the author
2924 of an article, type `\\[gnus-summary-reply]'.
2925
2926 There are approx. one gazillion commands you can execute in this
2927 buffer; read the info pages for more information (`\\[gnus-info-find-node]').
2928
2929 The following commands are available:
2930
2931 \\{gnus-summary-mode-map}"
2932   (interactive)
2933   (kill-all-local-variables)
2934   (let ((gnus-summary-local-variables gnus-newsgroup-variables))
2935     (gnus-summary-make-local-variables))
2936   (gnus-summary-make-local-variables)
2937   (setq gnus-newsgroup-name group)
2938   (when (gnus-visual-p 'summary-menu 'menu)
2939     (gnus-summary-make-menu-bar)
2940     (gnus-summary-make-tool-bar))
2941   (gnus-make-thread-indent-array)
2942   (gnus-simplify-mode-line)
2943   (setq major-mode 'gnus-summary-mode)
2944   (setq mode-name "Summary")
2945   (make-local-variable 'minor-mode-alist)
2946   (use-local-map gnus-summary-mode-map)
2947   (buffer-disable-undo)
2948   (setq buffer-read-only t              ;Disable modification
2949         show-trailing-whitespace nil)
2950   (setq truncate-lines t)
2951   (setq selective-display t)
2952   (setq selective-display-ellipses t)   ;Display `...'
2953   (gnus-summary-set-display-table)
2954   (gnus-set-default-directory)
2955   (make-local-variable 'gnus-summary-line-format)
2956   (make-local-variable 'gnus-summary-line-format-spec)
2957   (make-local-variable 'gnus-summary-dummy-line-format)
2958   (make-local-variable 'gnus-summary-dummy-line-format-spec)
2959   (make-local-variable 'gnus-summary-mark-positions)
2960   (gnus-make-local-hook 'pre-command-hook)
2961   (add-hook 'pre-command-hook 'gnus-set-global-variables nil t)
2962   (gnus-run-mode-hooks 'gnus-summary-mode-hook)
2963   (turn-on-gnus-mailing-list-mode)
2964   (mm-enable-multibyte)
2965   (gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy)
2966   (gnus-update-summary-mark-positions))
2967
2968 (defun gnus-summary-make-local-variables ()
2969   "Make all the local summary buffer variables."
2970   (let (global)
2971     (dolist (local gnus-summary-local-variables)
2972       (if (consp local)
2973           (progn
2974             (if (eq (cdr local) 'global)
2975                 ;; Copy the global value of the variable.
2976                 (setq global (symbol-value (car local)))
2977               ;; Use the value from the list.
2978               (setq global (eval (cdr local))))
2979             (set (make-local-variable (car local)) global))
2980         ;; Simple nil-valued local variable.
2981         (set (make-local-variable local) nil)))))
2982
2983 (defun gnus-summary-clear-local-variables ()
2984   (let ((locals gnus-summary-local-variables))
2985     (while locals
2986       (if (consp (car locals))
2987           (and (symbolp (caar locals))
2988                (set (caar locals) nil))
2989         (and (symbolp (car locals))
2990              (set (car locals) nil)))
2991       (setq locals (cdr locals)))))
2992
2993 ;; Summary data functions.
2994
2995 (defmacro gnus-data-number (data)
2996   `(car ,data))
2997
2998 (defmacro gnus-data-set-number (data number)
2999   `(setcar ,data ,number))
3000
3001 (defmacro gnus-data-mark (data)
3002   `(nth 1 ,data))
3003
3004 (defmacro gnus-data-set-mark (data mark)
3005   `(setcar (nthcdr 1 ,data) ,mark))
3006
3007 (defmacro gnus-data-pos (data)
3008   `(nth 2 ,data))
3009
3010 (defmacro gnus-data-set-pos (data pos)
3011   `(setcar (nthcdr 2 ,data) ,pos))
3012
3013 (defmacro gnus-data-header (data)
3014   `(nth 3 ,data))
3015
3016 (defmacro gnus-data-set-header (data header)
3017   `(setf (nth 3 ,data) ,header))
3018
3019 (defmacro gnus-data-level (data)
3020   `(nth 4 ,data))
3021
3022 (defmacro gnus-data-unread-p (data)
3023   `(= (nth 1 ,data) gnus-unread-mark))
3024
3025 (defmacro gnus-data-read-p (data)
3026   `(/= (nth 1 ,data) gnus-unread-mark))
3027
3028 (defmacro gnus-data-pseudo-p (data)
3029   `(consp (nth 3 ,data)))
3030
3031 (defmacro gnus-data-find (number)
3032   `(assq ,number gnus-newsgroup-data))
3033
3034 (defmacro gnus-data-find-list (number &optional data)
3035   `(let ((bdata ,(or data 'gnus-newsgroup-data)))
3036      (memq (assq ,number bdata)
3037            bdata)))
3038
3039 (defmacro gnus-data-make (number mark pos header level)
3040   `(list ,number ,mark ,pos ,header ,level))
3041
3042 (defun gnus-data-enter (after-article number mark pos header level offset)
3043   (let ((data (gnus-data-find-list after-article)))
3044     (unless data
3045       (error "No such article: %d" after-article))
3046     (setcdr data (cons (gnus-data-make number mark pos header level)
3047                        (cdr data)))
3048     (setq gnus-newsgroup-data-reverse nil)
3049     (gnus-data-update-list (cddr data) offset)))
3050
3051 (defun gnus-data-enter-list (after-article list &optional offset)
3052   (when list
3053     (let ((data (and after-article (gnus-data-find-list after-article)))
3054           (ilist list))
3055       (if (not (or data
3056                    after-article))
3057           (let ((odata gnus-newsgroup-data))
3058             (setq gnus-newsgroup-data (nconc list gnus-newsgroup-data))
3059             (when offset
3060               (gnus-data-update-list odata offset)))
3061         ;; Find the last element in the list to be spliced into the main
3062         ;; list.
3063         (setq list (last list))
3064         (if (not data)
3065             (progn
3066               (setcdr list gnus-newsgroup-data)
3067               (setq gnus-newsgroup-data ilist)
3068               (when offset
3069                 (gnus-data-update-list (cdr list) offset)))
3070           (setcdr list (cdr data))
3071           (setcdr data ilist)
3072           (when offset
3073             (gnus-data-update-list (cdr list) offset))))
3074       (setq gnus-newsgroup-data-reverse nil))))
3075
3076 (defun gnus-data-remove (article &optional offset)
3077   (let ((data gnus-newsgroup-data))
3078     (if (= (gnus-data-number (car data)) article)
3079         (progn
3080           (setq gnus-newsgroup-data (cdr gnus-newsgroup-data)
3081                 gnus-newsgroup-data-reverse nil)
3082           (when offset
3083             (gnus-data-update-list gnus-newsgroup-data offset)))
3084       (while (cdr data)
3085         (when (= (gnus-data-number (cadr data)) article)
3086           (setcdr data (cddr data))
3087           (when offset
3088             (gnus-data-update-list (cdr data) offset))
3089           (setq data nil
3090                 gnus-newsgroup-data-reverse nil))
3091         (setq data (cdr data))))))
3092
3093 (defmacro gnus-data-list (backward)
3094   `(if ,backward
3095        (or gnus-newsgroup-data-reverse
3096            (setq gnus-newsgroup-data-reverse
3097                  (reverse gnus-newsgroup-data)))
3098      gnus-newsgroup-data))
3099
3100 (defun gnus-data-update-list (data offset)
3101   "Add OFFSET to the POS of all data entries in DATA."
3102   (setq gnus-newsgroup-data-reverse nil)
3103   (while data
3104     (setcar (nthcdr 2 (car data)) (+ offset (nth 2 (car data))))
3105     (setq data (cdr data))))
3106
3107 (defun gnus-summary-article-pseudo-p (article)
3108   "Say whether this article is a pseudo article or not."
3109   (not (vectorp (gnus-data-header (gnus-data-find article)))))
3110
3111 (defmacro gnus-summary-article-sparse-p (article)
3112   "Say whether this article is a sparse article or not."
3113   `(memq ,article gnus-newsgroup-sparse))
3114
3115 (defmacro gnus-summary-article-ancient-p (article)
3116   "Say whether this article is a sparse article or not."
3117   `(memq ,article gnus-newsgroup-ancient))
3118
3119 (defun gnus-article-parent-p (number)
3120   "Say whether this article is a parent or not."
3121   (let ((data (gnus-data-find-list number)))
3122     (and (cdr data)              ; There has to be an article after...
3123          (< (gnus-data-level (car data)) ; And it has to have a higher level.
3124             (gnus-data-level (nth 1 data))))))
3125
3126 (defun gnus-article-children (number)
3127   "Return a list of all children to NUMBER."
3128   (let* ((data (gnus-data-find-list number))
3129          (level (gnus-data-level (car data)))
3130          children)
3131     (setq data (cdr data))
3132     (while (and data
3133                 (= (gnus-data-level (car data)) (1+ level)))
3134       (push (gnus-data-number (car data)) children)
3135       (setq data (cdr data)))
3136     children))
3137
3138 (defmacro gnus-summary-skip-intangible ()
3139   "If the current article is intangible, then jump to a different article."
3140   '(let ((to (get-text-property (point) 'gnus-intangible)))
3141      (and to (gnus-summary-goto-subject to))))
3142
3143 (defmacro gnus-summary-article-intangible-p ()
3144   "Say whether this article is intangible or not."
3145   '(get-text-property (point) 'gnus-intangible))
3146
3147 (defun gnus-article-read-p (article)
3148   "Say whether ARTICLE is read or not."
3149   (not (or (memq article gnus-newsgroup-marked)
3150            (memq article gnus-newsgroup-spam-marked)
3151            (memq article gnus-newsgroup-unreads)
3152            (memq article gnus-newsgroup-unselected)
3153            (memq article gnus-newsgroup-dormant))))
3154
3155 ;; Some summary mode macros.
3156
3157 (defmacro gnus-summary-article-number ()
3158   "The article number of the article on the current line.
3159 If there isn't an article number here, then we return the current
3160 article number."
3161   '(progn
3162      (gnus-summary-skip-intangible)
3163      (or (get-text-property (point) 'gnus-number)
3164          (gnus-summary-last-subject))))
3165
3166 (defmacro gnus-summary-article-header (&optional number)
3167   "Return the header of article NUMBER."
3168   `(gnus-data-header (gnus-data-find
3169                       ,(or number '(gnus-summary-article-number)))))
3170
3171 (defmacro gnus-summary-thread-level (&optional number)
3172   "Return the level of thread that starts with article NUMBER."
3173   `(if (and (eq gnus-summary-make-false-root 'dummy)
3174             (get-text-property (point) 'gnus-intangible))
3175        0
3176      (gnus-data-level (gnus-data-find
3177                        ,(or number '(gnus-summary-article-number))))))
3178
3179 (defmacro gnus-summary-article-mark (&optional number)
3180   "Return the mark of article NUMBER."
3181   `(gnus-data-mark (gnus-data-find
3182                     ,(or number '(gnus-summary-article-number)))))
3183
3184 (defmacro gnus-summary-article-pos (&optional number)
3185   "Return the position of the line of article NUMBER."
3186   `(gnus-data-pos (gnus-data-find
3187                    ,(or number '(gnus-summary-article-number)))))
3188
3189 (defalias 'gnus-summary-subject-string 'gnus-summary-article-subject)
3190 (defmacro gnus-summary-article-subject (&optional number)
3191   "Return current subject string or nil if nothing."
3192   `(let ((headers
3193           ,(if number
3194                `(gnus-data-header (assq ,number gnus-newsgroup-data))
3195              '(gnus-data-header (assq (gnus-summary-article-number)
3196                                       gnus-newsgroup-data)))))
3197      (and headers
3198           (vectorp headers)
3199           (mail-header-subject headers))))
3200
3201 (defmacro gnus-summary-article-score (&optional number)
3202   "Return current article score."
3203   `(or (cdr (assq ,(or number '(gnus-summary-article-number))
3204                   gnus-newsgroup-scored))
3205        gnus-summary-default-score 0))
3206
3207 (defun gnus-summary-article-children (&optional number)
3208   "Return a list of article numbers that are children of article NUMBER."
3209   (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))))
3210          (level (gnus-data-level (car data)))
3211          l children)
3212     (while (and (setq data (cdr data))
3213                 (> (setq l (gnus-data-level (car data))) level))
3214       (and (= (1+ level) l)
3215            (push (gnus-data-number (car data))
3216                  children)))
3217     (nreverse children)))
3218
3219 (defun gnus-summary-article-parent (&optional number)
3220   "Return the article number of the parent of article NUMBER."
3221   (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))
3222                                     (gnus-data-list t)))
3223          (level (gnus-data-level (car data))))
3224     (if (zerop level)
3225         ()                              ; This is a root.
3226       ;; We search until we find an article with a level less than
3227       ;; this one.  That function has to be the parent.
3228       (while (and (setq data (cdr data))
3229                   (not (< (gnus-data-level (car data)) level))))
3230       (and data (gnus-data-number (car data))))))
3231
3232 (defun gnus-unread-mark-p (mark)
3233   "Say whether MARK is the unread mark."
3234   (= mark gnus-unread-mark))
3235
3236 (defun gnus-read-mark-p (mark)
3237   "Say whether MARK is one of the marks that mark as read.
3238 This is all marks except unread, ticked, dormant, and expirable."
3239   (not (or (= mark gnus-unread-mark)
3240            (= mark gnus-ticked-mark)
3241            (= mark gnus-spam-mark)
3242            (= mark gnus-dormant-mark)
3243            (= mark gnus-expirable-mark))))
3244
3245 (defmacro gnus-article-mark (number)
3246   "Return the MARK of article NUMBER.
3247 This macro should only be used when computing the mark the \"first\"
3248 time; i.e., when generating the summary lines.  After that,
3249 `gnus-summary-article-mark' should be used to examine the
3250 marks of articles."
3251   `(cond
3252     ((memq ,number gnus-newsgroup-unsendable) gnus-unsendable-mark)
3253     ((memq ,number gnus-newsgroup-downloadable) gnus-downloadable-mark)
3254     ((memq ,number gnus-newsgroup-unreads) gnus-unread-mark)
3255     ((memq ,number gnus-newsgroup-marked) gnus-ticked-mark)
3256     ((memq ,number gnus-newsgroup-spam-marked) gnus-spam-mark)
3257     ((memq ,number gnus-newsgroup-dormant) gnus-dormant-mark)
3258     ((memq ,number gnus-newsgroup-expirable) gnus-expirable-mark)
3259     (t (or (cdr (assq ,number gnus-newsgroup-reads))
3260            gnus-ancient-mark))))
3261
3262 ;; Saving hidden threads.
3263
3264 (defmacro gnus-save-hidden-threads (&rest forms)
3265   "Save hidden threads, eval FORMS, and restore the hidden threads."
3266   (let ((config (make-symbol "config")))
3267     `(let ((,config (gnus-hidden-threads-configuration)))
3268        (unwind-protect
3269            (save-excursion
3270              ,@forms)
3271          (gnus-restore-hidden-threads-configuration ,config)))))
3272 (put 'gnus-save-hidden-threads 'lisp-indent-function 0)
3273 (put 'gnus-save-hidden-threads 'edebug-form-spec '(body))
3274
3275 (defun gnus-data-compute-positions ()
3276   "Compute the positions of all articles."
3277   (setq gnus-newsgroup-data-reverse nil)
3278   (let ((data gnus-newsgroup-data))
3279     (save-excursion
3280       (gnus-save-hidden-threads
3281         (gnus-summary-show-all-threads)
3282         (goto-char (point-min))
3283         (while data
3284           (while (get-text-property (point) 'gnus-intangible)
3285             (forward-line 1))
3286           (gnus-data-set-pos (car data) (+ (point) 3))
3287           (setq data (cdr data))
3288           (forward-line 1))))))
3289
3290 (defun gnus-hidden-threads-configuration ()
3291   "Return the current hidden threads configuration."
3292   (save-excursion
3293     (let (config)
3294       (goto-char (point-min))
3295       (while (search-forward "\r" nil t)
3296         (push (1- (point)) config))
3297       config)))
3298
3299 (defun gnus-restore-hidden-threads-configuration (config)
3300   "Restore hidden threads configuration from CONFIG."
3301   (save-excursion
3302     (let (point buffer-read-only)
3303       (while (setq point (pop config))
3304         (when (and (< point (point-max))
3305                    (goto-char point)
3306                    (eq (char-after) ?\n))
3307           (subst-char-in-region point (1+ point) ?\n ?\r))))))
3308
3309 ;; Various summary mode internalish functions.
3310
3311 (defun gnus-mouse-pick-article (e)
3312   (interactive "e")
3313   (mouse-set-point e)
3314   (gnus-summary-next-page nil t))
3315
3316 (defun gnus-summary-set-display-table ()
3317   "Change the display table.
3318 Odd characters have a tendency to mess
3319 up nicely formatted displays - we make all possible glyphs
3320 display only a single character."
3321
3322   ;; We start from the standard display table, if any.
3323   (let ((table (or (copy-sequence standard-display-table)
3324                    (make-display-table)))
3325         (i 32))
3326     ;; Nix out all the control chars...
3327     (while (>= (setq i (1- i)) 0)
3328       (aset table i [??]))
3329    ;; ... but not newline and cr, of course.  (cr is necessary for the
3330     ;; selective display).
3331     (aset table ?\n nil)
3332     (aset table ?\r nil)
3333     ;; We keep TAB as well.
3334     (aset table ?\t nil)
3335     ;; We nix out any glyphs 127 through 255, or 127 through 159 in
3336     ;; Emacs 23 (unicode), that are not set already.
3337     (let ((i (if (ignore-errors (= (make-char 'latin-iso8859-1 160) 160))
3338                  160
3339                256)))
3340       (while (>= (setq i (1- i)) 127)
3341         ;; Only modify if the entry is nil.
3342         (unless (aref table i)
3343           (aset table i [??]))))
3344     (setq buffer-display-table table)))
3345
3346 (defun gnus-summary-set-article-display-arrow (pos)
3347   "Update the overlay arrow to point to line at position POS."
3348   (when (and gnus-summary-display-arrow
3349              (boundp 'overlay-arrow-position)
3350              (boundp 'overlay-arrow-string))
3351     (save-excursion
3352       (goto-char pos)
3353       (beginning-of-line)
3354       (unless overlay-arrow-position
3355         (setq overlay-arrow-position (make-marker)))
3356       (setq overlay-arrow-string "=>"
3357             overlay-arrow-position (set-marker overlay-arrow-position
3358                                                (point)
3359                                                (current-buffer))))))
3360
3361 (defun gnus-summary-setup-buffer (group)
3362   "Initialize summary buffer."
3363   (let ((buffer (gnus-summary-buffer-name group))
3364         (dead-name (concat "*Dead Summary "
3365                            (gnus-group-decoded-name group) "*")))
3366     ;; If a dead summary buffer exists, we kill it.
3367     (when (gnus-buffer-live-p dead-name)
3368       (gnus-kill-buffer dead-name))
3369     (if (get-buffer buffer)
3370         (progn
3371           (set-buffer buffer)
3372           (setq gnus-summary-buffer (current-buffer))
3373           (not gnus-newsgroup-prepared))
3374       ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
3375       (setq gnus-summary-buffer (set-buffer (gnus-get-buffer-create buffer)))
3376       (gnus-summary-mode group)
3377       (when gnus-carpal
3378         (gnus-carpal-setup-buffer 'summary))
3379       (when (gnus-group-quit-config group)
3380         (set (make-local-variable 'gnus-single-article-buffer) nil))
3381       (make-local-variable 'gnus-article-buffer)
3382       (make-local-variable 'gnus-article-current)
3383       (make-local-variable 'gnus-original-article-buffer)
3384       (setq gnus-newsgroup-name group)
3385       ;; Set any local variables in the group parameters.
3386       (gnus-summary-set-local-parameters gnus-newsgroup-name)
3387       t)))
3388
3389 (defun gnus-set-global-variables ()
3390   "Set the global equivalents of the buffer-local variables.
3391 They are set to the latest values they had.  These reflect the summary
3392 buffer that was in action when the last article was fetched."
3393   (when (eq major-mode 'gnus-summary-mode)
3394     (setq gnus-summary-buffer (current-buffer))
3395     (let ((name gnus-newsgroup-name)
3396           (marked gnus-newsgroup-marked)
3397           (spam gnus-newsgroup-spam-marked)
3398           (unread gnus-newsgroup-unreads)
3399           (headers gnus-current-headers)
3400           (data gnus-newsgroup-data)
3401           (summary gnus-summary-buffer)
3402           (article-buffer gnus-article-buffer)
3403           (original gnus-original-article-buffer)
3404           (gac gnus-article-current)
3405           (reffed gnus-reffed-article-number)
3406           (score-file gnus-current-score-file)
3407           (default-charset gnus-newsgroup-charset)
3408           vlist)
3409       (let ((locals gnus-newsgroup-variables))
3410         (while locals
3411           (if (consp (car locals))
3412               (push (eval (caar locals)) vlist)
3413             (push (eval (car locals)) vlist))
3414           (setq locals (cdr locals)))
3415         (setq vlist (nreverse vlist)))
3416       (with-current-buffer gnus-group-buffer
3417         (setq gnus-newsgroup-name name
3418               gnus-newsgroup-marked marked
3419               gnus-newsgroup-spam-marked spam
3420               gnus-newsgroup-unreads unread
3421               gnus-current-headers headers
3422               gnus-newsgroup-data data
3423               gnus-article-current gac
3424               gnus-summary-buffer summary
3425               gnus-article-buffer article-buffer
3426               gnus-original-article-buffer original
3427               gnus-reffed-article-number reffed
3428               gnus-current-score-file score-file
3429               gnus-newsgroup-charset default-charset)
3430         (let ((locals gnus-newsgroup-variables))
3431           (while locals
3432             (if (consp (car locals))
3433                 (set (caar locals) (pop vlist))
3434               (set (car locals) (pop vlist)))
3435             (setq locals (cdr locals))))
3436         ;; The article buffer also has local variables.
3437         (when (gnus-buffer-live-p gnus-article-buffer)
3438           (set-buffer gnus-article-buffer)
3439           (setq gnus-summary-buffer summary))))))
3440
3441 (defun gnus-summary-article-unread-p (article)
3442   "Say whether ARTICLE is unread or not."
3443   (memq article gnus-newsgroup-unreads))
3444
3445 (defun gnus-summary-first-article-p (&optional article)
3446   "Return whether ARTICLE is the first article in the buffer."
3447   (if (not (setq article (or article (gnus-summary-article-number))))
3448       nil
3449     (eq article (caar gnus-newsgroup-data))))
3450
3451 (defun gnus-summary-last-article-p (&optional article)
3452   "Return whether ARTICLE is the last article in the buffer."
3453   (if (not (setq article (or article (gnus-summary-article-number))))
3454       ;; All non-existent numbers are the last article.  :-)
3455       t
3456     (not (cdr (gnus-data-find-list article)))))
3457
3458 (defun gnus-make-thread-indent-array (&optional n)
3459   (when (or n
3460             (progn (setq n 200) nil)
3461             (null gnus-thread-indent-array)
3462             (/= gnus-thread-indent-level gnus-thread-indent-array-level))
3463     (setq gnus-thread-indent-array (make-vector (1+ n) "")
3464           gnus-thread-indent-array-level gnus-thread-indent-level)
3465     (while (>= n 0)
3466       (aset gnus-thread-indent-array n
3467             (make-string (* n gnus-thread-indent-level) ? ))
3468       (setq n (1- n)))))
3469
3470 (defun gnus-update-summary-mark-positions ()
3471   "Compute where the summary marks are to go."
3472   (save-excursion
3473     (when (gnus-buffer-exists-p gnus-summary-buffer)
3474       (set-buffer gnus-summary-buffer))
3475     (let ((spec gnus-summary-line-format-spec)
3476           pos)
3477       (save-excursion
3478         (gnus-set-work-buffer)
3479         (let ((gnus-tmp-unread ?Z)
3480               (gnus-replied-mark ?Z)
3481               (gnus-score-below-mark ?Z)
3482               (gnus-score-over-mark ?Z)
3483               (gnus-undownloaded-mark ?Z)
3484               (gnus-summary-line-format-spec spec)
3485               (gnus-newsgroup-downloadable '(0))
3486               (header [0 "" "" "05 Apr 2001 23:33:09 +0400" "" "" 0 0 "" nil])
3487               case-fold-search ignores)
3488           ;; Here, all marks are bound to Z.
3489           (gnus-summary-insert-line header
3490                                     0 nil t gnus-tmp-unread t nil "" nil 1)
3491           (goto-char (point-min))
3492           ;; Memorize the positions of the same characters as dummy marks.
3493           (while (re-search-forward "[A-D]" nil t)
3494             (push (point) ignores))
3495           (erase-buffer)
3496           ;; We use A-D as dummy marks in order to know column positions
3497           ;; where marks should be inserted.
3498           (setq gnus-tmp-unread ?A
3499                 gnus-replied-mark ?B
3500                 gnus-score-below-mark ?C
3501                 gnus-score-over-mark ?C
3502                 gnus-undownloaded-mark ?D)
3503           (gnus-summary-insert-line header
3504                                     0 nil t gnus-tmp-unread t nil "" nil 1)
3505           ;; Ignore characters which aren't dummy marks.
3506           (dolist (p ignores)
3507             (delete-region (goto-char (1- p)) p)
3508             (insert ?Z))
3509           (goto-char (point-min))
3510           (setq pos (list (cons 'unread
3511                                 (and (search-forward "A" nil t)
3512                                      (- (point) (point-min) 1)))))
3513           (goto-char (point-min))
3514           (push (cons 'replied (and (search-forward "B" nil t)
3515                                     (- (point) (point-min) 1)))
3516                 pos)
3517           (goto-char (point-min))
3518           (push (cons 'score (and (search-forward "C" nil t)
3519                                   (- (point) (point-min) 1)))
3520                 pos)
3521           (goto-char (point-min))
3522           (push (cons 'download (and (search-forward "D" nil t)
3523                                      (- (point) (point-min) 1)))
3524                 pos)))
3525       (setq gnus-summary-mark-positions pos))))
3526
3527 (defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number)
3528   "Insert a dummy root in the summary buffer."
3529   (beginning-of-line)
3530   (gnus-add-text-properties
3531    (point) (progn (eval gnus-summary-dummy-line-format-spec) (point))
3532    (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number)))
3533
3534 (defun gnus-summary-extract-address-component (from)
3535   (or (car (funcall gnus-extract-address-components from))
3536       from))
3537
3538 (defun gnus-summary-from-or-to-or-newsgroups (header gnus-tmp-from)
3539   (let ((mail-parse-charset gnus-newsgroup-charset)
3540         ; Is it really necessary to do this next part for each summary line?
3541         ; Luckily, doesn't seem to slow things down much.
3542         (mail-parse-ignored-charsets
3543          (with-current-buffer gnus-summary-buffer
3544            gnus-newsgroup-ignored-charsets)))
3545     (or
3546      (and gnus-ignored-from-addresses
3547           (string-match gnus-ignored-from-addresses gnus-tmp-from)
3548           (let ((extra-headers (mail-header-extra header))
3549                 to
3550                 newsgroups)
3551             (cond
3552              ((setq to (cdr (assq 'To extra-headers)))
3553               (concat gnus-summary-to-prefix
3554                       (inline
3555                         (gnus-summary-extract-address-component
3556                          (funcall gnus-decode-encoded-address-function to)))))
3557              ((setq newsgroups
3558                     (or
3559                      (cdr (assq 'Newsgroups extra-headers))
3560                      (and
3561                       (memq 'Newsgroups gnus-extra-headers)
3562                       (eq (car (gnus-find-method-for-group
3563                                 gnus-newsgroup-name)) 'nntp)
3564                       (gnus-group-real-name gnus-newsgroup-name))))
3565               (concat gnus-summary-newsgroup-prefix newsgroups)))))
3566      (inline (gnus-summary-extract-address-component gnus-tmp-from)))))
3567
3568 (defun gnus-summary-insert-line (gnus-tmp-header
3569                                  gnus-tmp-level gnus-tmp-current
3570                                  undownloaded gnus-tmp-unread gnus-tmp-replied
3571                                  gnus-tmp-expirable gnus-tmp-subject-or-nil
3572                                  &optional gnus-tmp-dummy gnus-tmp-score
3573                                  gnus-tmp-process)
3574   (if (>= gnus-tmp-level (length gnus-thread-indent-array))
3575       (gnus-make-thread-indent-array (max (* 2 (length gnus-thread-indent-array))
3576                                           gnus-tmp-level)))
3577   (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level))
3578          (gnus-tmp-lines (mail-header-lines gnus-tmp-header))
3579          (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0))
3580          (gnus-tmp-score-char
3581           (if (or (null gnus-summary-default-score)
3582                   (<= (abs (- gnus-tmp-score gnus-summary-default-score))
3583                       gnus-summary-zcore-fuzz))
3584               ?                         ;Whitespace
3585             (if (< gnus-tmp-score gnus-summary-default-score)
3586                 gnus-score-below-mark gnus-score-over-mark)))
3587          (gnus-tmp-number (mail-header-number gnus-tmp-header))
3588          (gnus-tmp-replied
3589           (cond (gnus-tmp-process gnus-process-mark)
3590                 ((memq gnus-tmp-current gnus-newsgroup-cached)
3591                  gnus-cached-mark)
3592                 (gnus-tmp-replied gnus-replied-mark)
3593                 ((memq gnus-tmp-current gnus-newsgroup-forwarded)
3594                  gnus-forwarded-mark)
3595                 ((memq gnus-tmp-current gnus-newsgroup-saved)
3596                  gnus-saved-mark)
3597                 ((memq gnus-tmp-number gnus-newsgroup-recent)
3598                  gnus-recent-mark)
3599                 ((memq gnus-tmp-number gnus-newsgroup-unseen)
3600                  gnus-unseen-mark)
3601                 (t gnus-no-mark)))
3602          (gnus-tmp-downloaded
3603           (cond (undownloaded
3604                  gnus-undownloaded-mark)
3605                 (gnus-newsgroup-agentized
3606                  gnus-downloaded-mark)
3607                 (t
3608                  gnus-no-mark)))
3609          (gnus-tmp-from (mail-header-from gnus-tmp-header))
3610          (gnus-tmp-name
3611           (cond
3612            ((string-match "<[^>]+> *$" gnus-tmp-from)
3613             (let ((beg (match-beginning 0)))
3614               (or (and (string-match "^\".+\"" gnus-tmp-from)
3615                        (substring gnus-tmp-from 1 (1- (match-end 0))))
3616                   (substring gnus-tmp-from 0 beg))))
3617            ((string-match "(.+)" gnus-tmp-from)
3618             (substring gnus-tmp-from
3619                        (1+ (match-beginning 0)) (1- (match-end 0))))
3620            (t gnus-tmp-from)))
3621          (gnus-tmp-subject (mail-header-subject gnus-tmp-header))
3622          (gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[))
3623          (gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\]))
3624          (buffer-read-only nil))
3625     (when (string= gnus-tmp-name "")
3626       (setq gnus-tmp-name gnus-tmp-from))
3627     (unless (numberp gnus-tmp-lines)
3628       (setq gnus-tmp-lines -1))
3629     (if (= gnus-tmp-lines -1)
3630         (setq gnus-tmp-lines "?")
3631       (setq gnus-tmp-lines (number-to-string gnus-tmp-lines)))
3632       (gnus-put-text-property
3633      (point)
3634      (progn (eval gnus-summary-line-format-spec) (point))
3635        'gnus-number gnus-tmp-number)
3636     (when (gnus-visual-p 'summary-highlight 'highlight)
3637       (forward-line -1)
3638       (gnus-run-hooks 'gnus-summary-update-hook)
3639       (forward-line 1))))
3640
3641 (defun gnus-summary-update-line (&optional dont-update)
3642   "Update summary line after change."
3643   (when (and gnus-summary-default-score
3644              (not gnus-summary-inhibit-highlight))
3645     (let* ((gnus-summary-inhibit-highlight t) ; Prevent recursion.
3646            (article (gnus-summary-article-number))
3647            (score (gnus-summary-article-score article)))
3648       (unless dont-update
3649         (if (and gnus-summary-mark-below
3650                  (< (gnus-summary-article-score)
3651                     gnus-summary-mark-below))
3652             ;; This article has a low score, so we mark it as read.
3653             (when (memq article gnus-newsgroup-unreads)
3654               (gnus-summary-mark-article-as-read gnus-low-score-mark))
3655           (when (eq (gnus-summary-article-mark) gnus-low-score-mark)
3656             ;; This article was previously marked as read on account
3657             ;; of a low score, but now it has risen, so we mark it as
3658             ;; unread.
3659             (gnus-summary-mark-article-as-unread gnus-unread-mark)))
3660         (gnus-summary-update-mark
3661          (if (or (null gnus-summary-default-score)
3662                  (<= (abs (- score gnus-summary-default-score))
3663                      gnus-summary-zcore-fuzz))
3664              ?                          ;Whitespace
3665            (if (< score gnus-summary-default-score)
3666                gnus-score-below-mark gnus-score-over-mark))
3667          'score))
3668       ;; Do visual highlighting.
3669       (when (gnus-visual-p 'summary-highlight 'highlight)
3670         (gnus-run-hooks 'gnus-summary-update-hook)))))
3671
3672 (defvar gnus-tmp-new-adopts nil)
3673
3674 (defun gnus-summary-number-of-articles-in-thread (thread &optional level char)
3675   "Return the number of articles in THREAD.
3676 This may be 0 in some cases -- if none of the articles in
3677 the thread are to be displayed."
3678   (let* ((number
3679          ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
3680           (cond
3681            ((not (listp thread))
3682             1)
3683            ((and (consp thread) (cdr thread))
3684             (apply
3685              '+ 1 (mapcar
3686                    'gnus-summary-number-of-articles-in-thread (cdr thread))))
3687            ((null thread)
3688             1)
3689            ((memq (mail-header-number (car thread)) gnus-newsgroup-limit)
3690             1)
3691            (t 0))))
3692     (when (and level (zerop level) gnus-tmp-new-adopts)
3693       (incf number
3694             (apply '+ (mapcar
3695                        'gnus-summary-number-of-articles-in-thread
3696                        gnus-tmp-new-adopts))))
3697     (if char
3698         (if (> number 1) gnus-not-empty-thread-mark
3699           gnus-empty-thread-mark)
3700       number)))
3701
3702 (defsubst gnus-summary-line-message-size (head)
3703   "Return pretty-printed version of message size.
3704 This function is intended to be used in
3705 `gnus-summary-line-format-alist'."
3706   (let ((c (or (mail-header-chars head) -1)))
3707     (cond ((< c 0) "n/a")               ; chars not available
3708           ((< c (* 1000 10)) (format "%1.1fk" (/ c 1024.0)))
3709           ((< c (* 1000 100)) (format "%dk" (/ c 1024.0)))
3710           ((< c (* 1000 10000)) (format "%1.1fM" (/ c (* 1024.0 1024))))
3711           (t (format "%dM" (/ c (* 1024.0 1024)))))))
3712
3713
3714 (defun gnus-summary-set-local-parameters (group)
3715   "Go through the local params of GROUP and set all variable specs in that list."
3716   (let ((vars '(quit-config)))          ; Ignore quit-config.
3717     (dolist (elem (gnus-group-find-parameter group))
3718       (and (consp elem)                 ; Has to be a cons.
3719            (consp (cdr elem))           ; The cdr has to be a list.
3720            (symbolp (car elem))         ; Has to be a symbol in there.
3721            (not (memq (car elem) vars))
3722            (ignore-errors               ; So we set it.
3723              (push (car elem) vars)
3724              (make-local-variable (car elem))
3725              (set (car elem) (eval (nth 1 elem))))))))
3726
3727 (defun gnus-summary-read-group (group &optional show-all no-article
3728                                       kill-buffer no-display backward
3729                                       select-articles)
3730   "Start reading news in newsgroup GROUP.
3731 If SHOW-ALL is non-nil, already read articles are also listed.
3732 If NO-ARTICLE is non-nil, no article is selected initially.
3733 If NO-DISPLAY, don't generate a summary buffer."
3734   (let (result)
3735     (while (and group
3736                 (null (setq result
3737                             (let ((gnus-auto-select-next nil))
3738                               (or (gnus-summary-read-group-1
3739                                    group show-all no-article
3740                                    kill-buffer no-display
3741                                    select-articles)
3742                                   (setq show-all nil
3743                                         select-articles nil)))))
3744                 (eq gnus-auto-select-next 'quietly))
3745       (set-buffer gnus-group-buffer)
3746       ;; The entry function called above goes to the next
3747       ;; group automatically, so we go two groups back
3748       ;; if we are searching for the previous group.
3749       (when backward
3750         (gnus-group-prev-unread-group 2))
3751       (if (not (equal group (gnus-group-group-name)))
3752           (setq group (gnus-group-group-name))
3753         (setq group nil)))
3754     result))
3755
3756 (defun gnus-summary-read-group-1 (group show-all no-article
3757                                         kill-buffer no-display
3758                                         &optional select-articles)
3759   ;; Killed foreign groups can't be entered.
3760   ;;  (when (and (not (gnus-group-native-p group))
3761   ;;         (not (gnus-gethash group gnus-newsrc-hashtb)))
3762   ;;    (error "Dead non-native groups can't be entered"))
3763   (gnus-message 5 "Retrieving newsgroup: %s..."
3764                 (gnus-group-decoded-name group))
3765   (let* ((new-group (gnus-summary-setup-buffer group))
3766          (quit-config (gnus-group-quit-config group))
3767          (did-select (and new-group (gnus-select-newsgroup
3768                                      group show-all select-articles))))
3769     (cond
3770      ;; This summary buffer exists already, so we just select it.
3771      ((not new-group)
3772       (gnus-set-global-variables)
3773       (when kill-buffer
3774         (gnus-kill-or-deaden-summary kill-buffer))
3775       (gnus-configure-windows 'summary 'force)
3776       (gnus-set-mode-line 'summary)
3777       (gnus-summary-position-point)
3778       (message "")
3779       t)
3780      ;; We couldn't select this group.
3781      ((null did-select)
3782       (when (and (eq major-mode 'gnus-summary-mode)
3783                  (not (equal (current-buffer) kill-buffer)))
3784         (kill-buffer (current-buffer))
3785         (if (not quit-config)
3786             (progn
3787               ;; Update the info -- marks might need to be removed,
3788               ;; for instance.
3789               (gnus-summary-update-info)
3790               (set-buffer gnus-group-buffer)
3791               (gnus-group-jump-to-group group)
3792               (gnus-group-next-unread-group 1))
3793           (gnus-handle-ephemeral-exit quit-config)))
3794       (let ((grpinfo (gnus-get-info group)))
3795         (if (null (gnus-info-read grpinfo))
3796             (gnus-message 3 "Group %s contains no messages"
3797                           (gnus-group-decoded-name group))
3798           (gnus-message 3 "Can't select group")))
3799       nil)
3800      ;; The user did a `C-g' while prompting for number of articles,
3801      ;; so we exit this group.
3802      ((eq did-select 'quit)
3803       (and (eq major-mode 'gnus-summary-mode)
3804            (not (equal (current-buffer) kill-buffer))
3805            (kill-buffer (current-buffer)))
3806       (when kill-buffer
3807         (gnus-kill-or-deaden-summary kill-buffer))
3808       (if (not quit-config)
3809           (progn
3810             (set-buffer gnus-group-buffer)
3811             (gnus-group-jump-to-group group)
3812             (gnus-group-next-unread-group 1)
3813             (gnus-configure-windows 'group 'force))
3814         (gnus-handle-ephemeral-exit quit-config))
3815       ;; Finally signal the quit.
3816       (signal 'quit nil))
3817      ;; The group was successfully selected.
3818      (t
3819       (gnus-set-global-variables)
3820       ;; Save the active value in effect when the group was entered.
3821       (setq gnus-newsgroup-active
3822             (gnus-copy-sequence
3823              (gnus-active gnus-newsgroup-name)))
3824       ;; You can change the summary buffer in some way with this hook.
3825       (gnus-run-hooks 'gnus-select-group-hook)
3826       (when (memq 'summary (gnus-update-format-specifications
3827                             nil 'summary 'summary-mode 'summary-dummy))
3828         ;; The format specification for the summary line was updated,
3829         ;; so we need to update the mark positions as well.
3830         (gnus-update-summary-mark-positions))
3831       ;; Do score processing.
3832       (when gnus-use-scoring
3833         (gnus-possibly-score-headers))
3834       ;; Check whether to fill in the gaps in the threads.
3835       (when gnus-build-sparse-threads
3836         (gnus-build-sparse-threads))
3837       ;; Find the initial limit.
3838       (if show-all
3839           (let ((gnus-newsgroup-dormant nil))
3840             (gnus-summary-initial-limit show-all))
3841         (gnus-summary-initial-limit show-all))
3842       ;; Generate the summary buffer.
3843       (unless no-display
3844         (gnus-summary-prepare))
3845       (when gnus-use-trees
3846         (gnus-tree-open group)
3847         (setq gnus-summary-highlight-line-function
3848               'gnus-tree-highlight-article))
3849       ;; If the summary buffer is empty, but there are some low-scored
3850       ;; articles or some excluded dormants, we include these in the
3851       ;; buffer.
3852       (when (and (zerop (buffer-size))
3853                  (not no-display))
3854         (cond (gnus-newsgroup-dormant
3855                (gnus-summary-limit-include-dormant))
3856               ((and gnus-newsgroup-scored show-all)
3857                (gnus-summary-limit-include-expunged t))))
3858       ;; Function `gnus-apply-kill-file' must be called in this hook.
3859       (gnus-run-hooks 'gnus-apply-kill-hook)
3860       (if (and (zerop (buffer-size))
3861                (not no-display))
3862           (progn
3863             ;; This newsgroup is empty.
3864             (gnus-summary-catchup-and-exit nil t)
3865             (gnus-message 6 "No unread news")
3866             (when kill-buffer
3867               (gnus-kill-or-deaden-summary kill-buffer))
3868             ;; Return nil from this function.
3869             nil)
3870         ;; Hide conversation thread subtrees.  We cannot do this in
3871         ;; gnus-summary-prepare-hook since kill processing may not
3872         ;; work with hidden articles.
3873         (gnus-summary-maybe-hide-threads)
3874         (when kill-buffer
3875           (gnus-kill-or-deaden-summary kill-buffer))
3876         (gnus-summary-auto-select-subject)
3877         ;; Show first unread article if requested.
3878         (if (and (not no-article)
3879                  (not no-display)
3880                  gnus-newsgroup-unreads
3881                  gnus-auto-select-first)
3882             (progn
3883               (gnus-configure-windows 'summary)
3884               (let ((art (gnus-summary-article-number)))
3885                 (unless (and (not gnus-plugged)
3886                              (or (memq art gnus-newsgroup-undownloaded)
3887                                  (memq art gnus-newsgroup-downloadable)))
3888                   (gnus-summary-goto-article art))))
3889           ;; Don't select any articles.
3890           (gnus-summary-position-point)
3891           (gnus-configure-windows 'summary 'force)
3892           (gnus-set-mode-line 'summary))
3893         (when (and gnus-auto-center-group
3894                    (get-buffer-window gnus-group-buffer t))
3895           ;; Gotta use windows, because recenter does weird stuff if
3896           ;; the current buffer ain't the displayed window.
3897           (let ((owin (selected-window)))
3898             (select-window (get-buffer-window gnus-group-buffer t))
3899             (when (gnus-group-goto-group group)
3900               (recenter))
3901             (select-window owin)))
3902         ;; Mark this buffer as "prepared".
3903         (setq gnus-newsgroup-prepared t)
3904         (gnus-run-hooks 'gnus-summary-prepared-hook)
3905         (unless (gnus-ephemeral-group-p group)
3906           (gnus-group-update-group group))
3907         t)))))
3908
3909 (defun gnus-summary-auto-select-subject ()
3910   "Select the subject line on initial group entry."
3911   (goto-char (point-min))
3912   (cond
3913    ((eq gnus-auto-select-subject 'best)
3914     (gnus-summary-best-unread-subject))
3915    ((eq gnus-auto-select-subject 'unread)
3916     (gnus-summary-first-unread-subject))
3917    ((eq gnus-auto-select-subject 'unseen)
3918     (gnus-summary-first-unseen-subject))
3919    ((eq gnus-auto-select-subject 'unseen-or-unread)
3920     (gnus-summary-first-unseen-or-unread-subject))
3921    ((eq gnus-auto-select-subject 'first)
3922     ;; Do nothing.
3923     )
3924    ((functionp gnus-auto-select-subject)
3925     (funcall gnus-auto-select-subject))))
3926
3927 (defun gnus-summary-prepare ()
3928   "Generate the summary buffer."
3929   (interactive)
3930   (let ((buffer-read-only nil))
3931     (erase-buffer)
3932     (setq gnus-newsgroup-data nil
3933           gnus-newsgroup-data-reverse nil)
3934     (gnus-run-hooks 'gnus-summary-generate-hook)
3935     ;; Generate the buffer, either with threads or without.
3936     (when gnus-newsgroup-headers
3937       (gnus-summary-prepare-threads
3938        (if gnus-show-threads
3939            (gnus-sort-gathered-threads
3940             (funcall gnus-summary-thread-gathering-function
3941                      (gnus-sort-threads
3942                       (gnus-cut-threads (gnus-make-threads)))))
3943          ;; Unthreaded display.
3944          (gnus-sort-articles gnus-newsgroup-headers))))
3945     (setq gnus-newsgroup-data (nreverse gnus-newsgroup-data))
3946     ;; Call hooks for modifying summary buffer.
3947     (goto-char (point-min))
3948     (gnus-run-hooks 'gnus-summary-prepare-hook)))
3949
3950 (defsubst gnus-general-simplify-subject (subject)
3951   "Simplify subject by the same rules as `gnus-gather-threads-by-subject'."
3952   (setq subject
3953         (cond
3954          ;; Truncate the subject.
3955          (gnus-simplify-subject-functions
3956           (gnus-map-function gnus-simplify-subject-functions subject))
3957          ((numberp gnus-summary-gather-subject-limit)
3958           (setq subject (gnus-simplify-subject-re subject))
3959           (if (> (length subject) gnus-summary-gather-subject-limit)
3960               (substring subject 0 gnus-summary-gather-subject-limit)
3961             subject))
3962          ;; Fuzzily simplify it.
3963          ((eq 'fuzzy gnus-summary-gather-subject-limit)
3964           (gnus-simplify-subject-fuzzy subject))
3965          ;; Just remove the leading "Re:".
3966          (t
3967           (gnus-simplify-subject-re subject))))
3968
3969   (if (and gnus-summary-gather-exclude-subject
3970            (string-match gnus-summary-gather-exclude-subject subject))
3971       nil                         ; This article shouldn't be gathered
3972     subject))
3973
3974 (defun gnus-summary-simplify-subject-query ()
3975   "Query where the respool algorithm would put this article."
3976   (interactive)
3977   (gnus-summary-select-article)
3978   (message (gnus-general-simplify-subject (gnus-summary-article-subject))))
3979
3980 (defun gnus-gather-threads-by-subject (threads)
3981   "Gather threads by looking at Subject headers."
3982   (if (not gnus-summary-make-false-root)
3983       threads
3984     (let ((hashtb (gnus-make-hashtable 1024))
3985           (prev threads)
3986           (result threads)
3987           subject hthread whole-subject)
3988       (while threads
3989         (setq subject (gnus-general-simplify-subject
3990                        (setq whole-subject (mail-header-subject
3991                                             (caar threads)))))
3992         (when subject
3993           (if (setq hthread (gnus-gethash subject hashtb))
3994               (progn
3995                 ;; We enter a dummy root into the thread, if we
3996                 ;; haven't done that already.
3997                 (unless (stringp (caar hthread))
3998                   (setcar hthread (list whole-subject (car hthread))))
3999                 ;; We add this new gathered thread to this gathered
4000                 ;; thread.
4001                 (setcdr (car hthread)
4002                         (nconc (cdar hthread) (list (car threads))))
4003                 ;; Remove it from the list of threads.
4004                 (setcdr prev (cdr threads))
4005                 (setq threads prev))
4006             ;; Enter this thread into the hash table.
4007             (gnus-sethash subject
4008                           (if gnus-summary-make-false-root-always
4009                               (progn
4010                                 ;; If you want a dummy root above all
4011                                 ;; threads...
4012                                 (setcar threads (list whole-subject
4013                                                       (car threads)))
4014                                 threads)
4015                             threads)
4016                           hashtb)))
4017         (setq prev threads)
4018         (setq threads (cdr threads)))
4019       result)))
4020
4021 (defun gnus-gather-threads-by-references (threads)
4022   "Gather threads by looking at References headers."
4023   (let ((idhashtb (gnus-make-hashtable 1024))
4024         (thhashtb (gnus-make-hashtable 1024))
4025         (prev threads)
4026         (result threads)
4027         ids references id gthread gid entered ref)
4028     (while threads
4029       (when (setq references (mail-header-references (caar threads)))
4030         (setq id (mail-header-id (caar threads))
4031               ids (inline (gnus-split-references references))
4032               entered nil)
4033         (while (setq ref (pop ids))
4034           (setq ids (delete ref ids))
4035           (if (not (setq gid (gnus-gethash ref idhashtb)))
4036               (progn
4037                 (gnus-sethash ref id idhashtb)
4038                 (gnus-sethash id threads thhashtb))
4039             (setq gthread (gnus-gethash gid thhashtb))
4040             (unless entered
4041               ;; We enter a dummy root into the thread, if we
4042               ;; haven't done that already.
4043               (unless (stringp (caar gthread))
4044                 (setcar gthread (list (mail-header-subject (caar gthread))
4045                                       (car gthread))))
4046               ;; We add this new gathered thread to this gathered
4047               ;; thread.
4048               (setcdr (car gthread)
4049                       (nconc (cdar gthread) (list (car threads)))))
4050             ;; Add it into the thread hash table.
4051             (gnus-sethash id gthread thhashtb)
4052             (setq entered t)
4053             ;; Remove it from the list of threads.
4054             (setcdr prev (cdr threads))
4055             (setq threads prev))))
4056       (setq prev threads)
4057       (setq threads (cdr threads)))
4058     result))
4059
4060 (defun gnus-sort-gathered-threads (threads)
4061   "Sort subtreads inside each gathered thread by `gnus-sort-gathered-threads-function'."
4062   (let ((result threads))
4063     (while threads
4064       (when (stringp (caar threads))
4065         (setcdr (car threads)
4066                 (sort (cdar threads) gnus-sort-gathered-threads-function)))
4067       (setq threads (cdr threads)))
4068     result))
4069
4070 (defun gnus-thread-loop-p (root thread)
4071   "Say whether ROOT is in THREAD."
4072   (let ((stack (list thread))
4073         (infloop 0)
4074         th)
4075     (while (setq thread (pop stack))
4076       (setq th (cdr thread))
4077       (while (and th
4078                   (not (eq (caar th) root)))
4079         (pop th))
4080       (if th
4081           ;; We have found a loop.
4082           (let (ref-dep)
4083             (setcdr thread (delq (car th) (cdr thread)))
4084             (if (boundp (setq ref-dep (intern "none"
4085                                               gnus-newsgroup-dependencies)))
4086                 (setcdr (symbol-value ref-dep)
4087                         (nconc (cdr (symbol-value ref-dep))
4088                                (list (car th))))
4089               (set ref-dep (list nil (car th))))
4090             (setq infloop 1
4091                   stack nil))
4092         ;; Push all the subthreads onto the stack.
4093         (push (cdr thread) stack)))
4094     infloop))
4095
4096 (defun gnus-make-threads ()
4097   "Go through the dependency hashtb and find the roots.  Return all threads."
4098   (let (threads)
4099     (while (catch 'infloop
4100              (mapatoms
4101               (lambda (refs)
4102                 ;; Deal with self-referencing References loops.
4103                 (when (and (car (symbol-value refs))
4104                            (not (zerop
4105                                  (apply
4106                                   '+
4107                                   (mapcar
4108                                    (lambda (thread)
4109                                      (gnus-thread-loop-p
4110                                       (car (symbol-value refs)) thread))
4111                                    (cdr (symbol-value refs)))))))
4112                   (setq threads nil)
4113                   (throw 'infloop t))
4114                 (unless (car (symbol-value refs))
4115                   ;; These threads do not refer back to any other
4116                   ;; articles, so they're roots.
4117                   (setq threads (append (cdr (symbol-value refs)) threads))))
4118               gnus-newsgroup-dependencies)))
4119     threads))
4120
4121 ;; Build the thread tree.
4122 (defsubst gnus-dependencies-add-header (header dependencies force-new)
4123   "Enter HEADER into the DEPENDENCIES table if it is not already there.
4124
4125 If FORCE-NEW is not nil, enter HEADER into the DEPENDENCIES table even
4126 if it was already present.
4127
4128 If `gnus-summary-ignore-duplicates' is nil then duplicate Message-IDs
4129 will not be entered in the DEPENDENCIES table.  Otherwise duplicate
4130 Message-IDs will be renamed to a unique Message-ID before being
4131 entered.
4132
4133 Returns HEADER if it was entered in the DEPENDENCIES.  Returns nil otherwise."
4134   (let* ((id (mail-header-id header))
4135          (id-dep (and id (intern id dependencies)))
4136          parent-id ref ref-dep ref-header replaced)
4137     ;; Enter this `header' in the `dependencies' table.
4138     (cond
4139      ((not id-dep)
4140       (setq header nil))
4141      ;; The first two cases do the normal part: enter a new `header'
4142      ;; in the `dependencies' table.
4143      ((not (boundp id-dep))
4144       (set id-dep (list header)))
4145      ((null (car (symbol-value id-dep)))
4146       (setcar (symbol-value id-dep) header))
4147
4148      ;; From here the `header' was already present in the
4149      ;; `dependencies' table.
4150      (force-new
4151       ;; Overrides an existing entry;
4152       ;; just set the header part of the entry.
4153       (setcar (symbol-value id-dep) header)
4154       (setq replaced t))
4155
4156      ;; Renames the existing `header' to a unique Message-ID.
4157      ((not gnus-summary-ignore-duplicates)
4158       ;; An article with this Message-ID has already been seen.
4159       ;; We rename the Message-ID.
4160       (set (setq id-dep (intern (setq id (nnmail-message-id)) dependencies))
4161            (list header))
4162       (mail-header-set-id header id))
4163
4164      ;; The last case ignores an existing entry, except it adds any
4165      ;; additional Xrefs (in case the two articles came from different
4166      ;; servers.
4167      ;; Also sets `header' to `nil' meaning that the `dependencies'
4168      ;; table was *not* modified.
4169      (t
4170       (mail-header-set-xref
4171        (car (symbol-value id-dep))
4172        (concat (or (mail-header-xref (car (symbol-value id-dep)))
4173                    "")
4174                (or (mail-header-xref header) "")))
4175       (setq header nil)))
4176
4177     (when (and header (not replaced))
4178       ;; First check that we are not creating a References loop.
4179       (setq parent-id (gnus-parent-id (mail-header-references header)))
4180       (setq ref parent-id)
4181       (while (and ref
4182                   (setq ref-dep (intern-soft ref dependencies))
4183                   (boundp ref-dep)
4184                   (setq ref-header (car (symbol-value ref-dep))))
4185         (if (string= id ref)
4186             ;; Yuk!  This is a reference loop.  Make the article be a
4187             ;; root article.
4188             (progn
4189               (mail-header-set-references (car (symbol-value id-dep)) "none")
4190               (setq ref nil)
4191               (setq parent-id nil))
4192           (setq ref (gnus-parent-id (mail-header-references ref-header)))))
4193       (setq ref-dep (intern (or parent-id "none") dependencies))
4194       (if (boundp ref-dep)
4195           (setcdr (symbol-value ref-dep)
4196                   (nconc (cdr (symbol-value ref-dep))
4197                          (list (symbol-value id-dep))))
4198         (set ref-dep (list nil (symbol-value id-dep)))))
4199     header))
4200
4201 (defun gnus-extract-message-id-from-in-reply-to (string)
4202   (if (string-match "<[^>]+>" string)
4203       (substring string (match-beginning 0) (match-end 0))
4204     nil))
4205
4206 (defun gnus-build-sparse-threads ()
4207   (let ((headers gnus-newsgroup-headers)
4208         (mail-parse-charset gnus-newsgroup-charset)
4209         (gnus-summary-ignore-duplicates t)
4210         header references generation relations
4211         subject child end new-child date)
4212     ;; First we create an alist of generations/relations, where
4213     ;; generations is how much we trust the relation, and the relation
4214     ;; is parent/child.
4215     (gnus-message 7 "Making sparse threads...")
4216     (save-excursion
4217       (nnheader-set-temp-buffer " *gnus sparse threads*")
4218       (while (setq header (pop headers))
4219         (when (and (setq references (mail-header-references header))
4220                    (not (string= references "")))
4221           (insert references)
4222           (setq child (mail-header-id header)
4223                 subject (mail-header-subject header)
4224                 date (mail-header-date header)
4225                 generation 0)
4226           (while (search-backward ">" nil t)
4227             (setq end (1+ (point)))
4228             (when (search-backward "<" nil t)
4229               (setq new-child (buffer-substring (point) end))
4230               (push (list (incf generation)
4231                           child (setq child new-child)
4232                           subject date)
4233                     relations)))
4234           (when child
4235             (push (list (1+ generation) child nil subject) relations))
4236           (erase-buffer)))
4237       (kill-buffer (current-buffer)))
4238     ;; Sort over trustworthiness.
4239     (mapcar
4240      (lambda (relation)
4241        (when (gnus-dependencies-add-header
4242               (make-full-mail-header
4243                gnus-reffed-article-number
4244                (nth 3 relation) "" (or (nth 4 relation) "")
4245                (nth 1 relation)
4246                (or (nth 2 relation) "") 0 0 "")
4247               gnus-newsgroup-dependencies nil)
4248          (push gnus-reffed-article-number gnus-newsgroup-limit)
4249          (push gnus-reffed-article-number gnus-newsgroup-sparse)
4250          (push (cons gnus-reffed-article-number gnus-sparse-mark)
4251                gnus-newsgroup-reads)
4252          (decf gnus-reffed-article-number)))
4253      (sort relations 'car-less-than-car))
4254     (gnus-message 7 "Making sparse threads...done")))
4255
4256 (defun gnus-build-old-threads ()
4257   ;; Look at all the articles that refer back to old articles, and
4258   ;; fetch the headers for the articles that aren't there.  This will
4259   ;; build complete threads - if the roots haven't been expired by the
4260   ;; server, that is.
4261   (let ((mail-parse-charset gnus-newsgroup-charset)
4262         id heads)
4263     (mapatoms
4264      (lambda (refs)
4265        (when (not (car (symbol-value refs)))
4266          (setq heads (cdr (symbol-value refs)))
4267          (while heads
4268            (if (memq (mail-header-number (caar heads))
4269                      gnus-newsgroup-dormant)
4270                (setq heads (cdr heads))
4271              (setq id (symbol-name refs))
4272              (while (and (setq id (gnus-build-get-header id))
4273                          (not (car (gnus-id-to-thread id)))))
4274              (setq heads nil)))))
4275      gnus-newsgroup-dependencies)))
4276
4277 (defsubst gnus-remove-odd-characters (string)
4278   "Translate STRING into something that doesn't contain weird characters."
4279   (mm-subst-char-in-string
4280    ?\r ?\-
4281    (mm-subst-char-in-string ?\n ?\- string t) t))
4282
4283 ;; This function has to be called with point after the article number
4284 ;; on the beginning of the line.
4285 (defsubst gnus-nov-parse-line (number dependencies &optional force-new)
4286   (let ((eol (point-at-eol))
4287         (buffer (current-buffer))
4288         header references in-reply-to)
4289
4290     ;; overview: [num subject from date id refs chars lines misc]
4291     (unwind-protect
4292         (let (x)
4293           (narrow-to-region (point) eol)
4294           (unless (eobp)
4295             (forward-char))
4296
4297           (setq header
4298                 (make-full-mail-header
4299                  number                 ; number
4300                  (condition-case ()     ; subject
4301                      (gnus-remove-odd-characters
4302                       (funcall gnus-decode-encoded-word-function
4303                                (setq x (nnheader-nov-field))))
4304                    (error x))
4305                  (condition-case ()     ; from
4306                      (gnus-remove-odd-characters
4307                       (funcall gnus-decode-encoded-address-function
4308                                (setq x (nnheader-nov-field))))
4309                    (error x))
4310                  (nnheader-nov-field)   ; date
4311                  (nnheader-nov-read-message-id number)  ; id
4312                  (setq references (nnheader-nov-field)) ; refs
4313                  (nnheader-nov-read-integer) ; chars
4314                  (nnheader-nov-read-integer) ; lines
4315                  (unless (eobp)
4316                    (if (looking-at "Xref: ")
4317                        (goto-char (match-end 0)))
4318                    (nnheader-nov-field)) ; Xref
4319                  (nnheader-nov-parse-extra)))) ; extra
4320
4321       (widen))
4322
4323     (when (and (string= references "")
4324                (setq in-reply-to (mail-header-extra header))
4325                (setq in-reply-to (cdr (assq 'In-Reply-To in-reply-to))))
4326       (mail-header-set-references
4327        header (gnus-extract-message-id-from-in-reply-to in-reply-to)))
4328
4329     (when gnus-alter-header-function
4330       (funcall gnus-alter-header-function header))
4331     (gnus-dependencies-add-header header dependencies force-new)))
4332
4333 (defun gnus-build-get-header (id)
4334   "Look through the buffer of NOV lines and find the header to ID.
4335 Enter this line into the dependencies hash table, and return
4336 the id of the parent article (if any)."
4337   (let ((deps gnus-newsgroup-dependencies)
4338         found header)
4339     (prog1
4340         (save-excursion
4341           (set-buffer nntp-server-buffer)
4342           (let ((case-fold-search nil))
4343             (goto-char (point-min))
4344             (while (and (not found)
4345                         (search-forward id nil t))
4346               (beginning-of-line)
4347               (setq found (looking-at
4348                            (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s"
4349                                    (regexp-quote id))))
4350               (or found (beginning-of-line 2)))
4351             (when found
4352               (beginning-of-line)
4353               (and
4354                (setq header (gnus-nov-parse-line
4355                              (read (current-buffer)) deps))
4356                (gnus-parent-id (mail-header-references header))))))
4357       (when header
4358         (let ((number (mail-header-number header)))
4359           (push number gnus-newsgroup-limit)
4360           (push header gnus-newsgroup-headers)
4361           (if (memq number gnus-newsgroup-unselected)
4362               (progn
4363                 (setq gnus-newsgroup-unreads
4364                       (gnus-add-to-sorted-list gnus-newsgroup-unreads
4365                                                number))
4366                 (setq gnus-newsgroup-unselected
4367                       (delq number gnus-newsgroup-unselected)))
4368             (push number gnus-newsgroup-ancient)))))))
4369
4370 (defun gnus-build-all-threads ()
4371   "Read all the headers."
4372   (let ((gnus-summary-ignore-duplicates t)
4373         (mail-parse-charset gnus-newsgroup-charset)
4374         (dependencies gnus-newsgroup-dependencies)
4375         header article)
4376     (save-excursion
4377       (set-buffer nntp-server-buffer)
4378       (let ((case-fold-search nil))
4379         (goto-char (point-min))
4380         (while (not (eobp))
4381           (ignore-errors
4382             (setq article (read (current-buffer))
4383                   header (gnus-nov-parse-line article dependencies)))
4384           (when header
4385             (with-current-buffer gnus-summary-buffer
4386               (push header gnus-newsgroup-headers)
4387               (if (memq (setq article (mail-header-number header))
4388                         gnus-newsgroup-unselected)
4389                   (progn
4390                     (setq gnus-newsgroup-unreads
4391                           (gnus-add-to-sorted-list
4392                            gnus-newsgroup-unreads article))
4393                     (setq gnus-newsgroup-unselected
4394                           (delq article gnus-newsgroup-unselected)))
4395                 (push article gnus-newsgroup-ancient)))
4396             (forward-line 1)))))))
4397
4398 (defun gnus-summary-update-article-line (article header)
4399   "Update the line for ARTICLE using HEADER."
4400   (let* ((id (mail-header-id header))
4401          (thread (gnus-id-to-thread id)))
4402     (unless thread
4403       (error "Article in no thread"))
4404     ;; Update the thread.
4405     (setcar thread header)
4406     (gnus-summary-goto-subject article)
4407     (let* ((datal (gnus-data-find-list article))
4408            (data (car datal))
4409            (buffer-read-only nil)
4410            (level (gnus-summary-thread-level)))
4411       (gnus-delete-line)
4412       (let ((inserted (- (point)
4413                          (progn
4414                            (gnus-summary-insert-line
4415                             header level nil
4416                             (memq article gnus-newsgroup-undownloaded)
4417                             (gnus-article-mark article)
4418                             (memq article gnus-newsgroup-replied)
4419                             (memq article gnus-newsgroup-expirable)
4420                             ;; Only insert the Subject string when it's different
4421                             ;; from the previous Subject string.
4422                             (if (and
4423                                  gnus-show-threads
4424                                  (gnus-subject-equal
4425                                   (condition-case ()
4426                                       (mail-header-subject
4427                                        (gnus-data-header
4428                                         (cadr
4429                                          (gnus-data-find-list
4430                                           article
4431                                           (gnus-data-list t)))))
4432                                     ;; Error on the side of excessive subjects.
4433                                     (error ""))
4434                                   (mail-header-subject header)))
4435                                 ""
4436                               (mail-header-subject header))
4437                             nil (cdr (assq article gnus-newsgroup-scored))
4438                             (memq article gnus-newsgroup-processable))
4439                            (point)))))
4440         (when (cdr datal)
4441           (gnus-data-update-list
4442            (cdr datal)
4443            (- (gnus-data-pos data) (gnus-data-pos (cadr datal)) inserted)))))))
4444
4445 (defun gnus-summary-update-article (article &optional iheader)
4446   "Update ARTICLE in the summary buffer."
4447   (set-buffer gnus-summary-buffer)
4448   (let* ((header (gnus-summary-article-header article))
4449          (id (mail-header-id header))
4450          (data (gnus-data-find article))
4451          (thread (gnus-id-to-thread id))
4452          (references (mail-header-references header))
4453          (parent
4454           (gnus-id-to-thread
4455            (or (gnus-parent-id
4456                 (when (and references
4457                            (not (equal "" references)))
4458                   references))
4459                "none")))
4460          (buffer-read-only nil)
4461          (old (car thread)))
4462     (when thread
4463       (unless iheader
4464         (setcar thread nil)
4465         (when parent
4466           (delq thread parent)))
4467       (if (gnus-summary-insert-subject id header)
4468           ;; Set the (possibly) new article number in the data structure.
4469           (gnus-data-set-number data (gnus-id-to-article id))
4470         (setcar thread old)
4471         nil))))
4472
4473 (defun gnus-rebuild-thread (id &optional line)
4474   "Rebuild the thread containing ID.
4475 If LINE, insert the rebuilt thread starting on line LINE."
4476   (let ((buffer-read-only nil)
4477         old-pos current thread data)
4478     (if (not gnus-show-threads)
4479         (setq thread (list (car (gnus-id-to-thread id))))
4480       ;; Get the thread this article is part of.
4481       (setq thread (gnus-remove-thread id)))
4482     (setq old-pos (point-at-bol))
4483     (setq current (save-excursion
4484                     (and (re-search-backward "[\r\n]" nil t)
4485                          (gnus-summary-article-number))))
4486     ;; If this is a gathered thread, we have to go some re-gathering.
4487     (when (stringp (car thread))
4488       (let ((subject (car thread))
4489             roots thr)
4490         (setq thread (cdr thread))
4491         (while thread
4492           (unless (memq (setq thr (gnus-id-to-thread
4493                                    (gnus-root-id
4494                                     (mail-header-id (caar thread)))))
4495                         roots)
4496             (push thr roots))
4497           (setq thread (cdr thread)))
4498         ;; We now have all (unique) roots.
4499         (if (= (length roots) 1)
4500             ;; All the loose roots are now one solid root.
4501             (setq thread (car roots))
4502           (setq thread (cons subject (gnus-sort-threads roots))))))
4503     (let (threads)
4504       ;; We then insert this thread into the summary buffer.
4505       (when line
4506         (goto-char (point-min))
4507         (forward-line (1- line)))
4508       (let (gnus-newsgroup-data gnus-newsgroup-threads)
4509         (if gnus-show-threads
4510             (gnus-summary-prepare-threads (gnus-cut-threads (list thread)))
4511           (gnus-summary-prepare-unthreaded thread))
4512         (setq data (nreverse gnus-newsgroup-data))
4513         (setq threads gnus-newsgroup-threads))
4514       ;; We splice the new data into the data structure.
4515       ;;!!! This is kinda bogus.  We assume that in LINE is non-nil,
4516       ;;!!! then we want to insert at the beginning of the buffer.
4517       ;;!!! That happens to be true with Gnus now, but that may
4518       ;;!!! change in the future.  Perhaps.
4519       (gnus-data-enter-list
4520        (if line nil current) data (- (point) old-pos))
4521       (setq gnus-newsgroup-threads
4522             (nconc threads gnus-newsgroup-threads))
4523       (gnus-data-compute-positions))))
4524
4525 (defun gnus-number-to-header (number)
4526   "Return the header for article NUMBER."
4527   (let ((headers gnus-newsgroup-headers))
4528     (while (and headers
4529                 (not (= number (mail-header-number (car headers)))))
4530       (pop headers))
4531     (when headers
4532       (car headers))))
4533
4534 (defun gnus-parent-headers (in-headers &optional generation)
4535   "Return the headers of the GENERATIONeth parent of HEADERS."
4536   (unless generation
4537     (setq generation 1))
4538   (let ((parent t)
4539         (headers in-headers)
4540         references)
4541     (while (and parent
4542                 (not (zerop generation))
4543                 (setq references (mail-header-references headers)))
4544       (setq headers (if (and references
4545                              (setq parent (gnus-parent-id references)))
4546                         (car (gnus-id-to-thread parent))
4547                       nil))
4548       (decf generation))
4549     (and (not (eq headers in-headers))
4550          headers)))
4551
4552 (defun gnus-id-to-thread (id)
4553   "Return the (sub-)thread where ID appears."
4554   (gnus-gethash id gnus-newsgroup-dependencies))
4555
4556 (defun gnus-id-to-article (id)
4557   "Return the article number of ID."
4558   (let ((thread (gnus-id-to-thread id)))
4559     (when (and thread
4560                (car thread))
4561       (mail-header-number (car thread)))))
4562
4563 (defun gnus-id-to-header (id)
4564   "Return the article headers of ID."
4565   (car (gnus-id-to-thread id)))
4566
4567 (defun gnus-article-displayed-root-p (article)
4568   "Say whether ARTICLE is a root(ish) article."
4569   (let ((level (gnus-summary-thread-level article))
4570         (refs (mail-header-references  (gnus-summary-article-header article)))
4571         particle)
4572     (cond
4573      ((null level) nil)
4574      ((zerop level) t)
4575      ((null refs) t)
4576      ((null (gnus-parent-id refs)) t)
4577      ((and (= 1 level)
4578            (null (setq particle (gnus-id-to-article
4579                                  (gnus-parent-id refs))))
4580            (null (gnus-summary-thread-level particle)))))))
4581
4582 (defun gnus-root-id (id)
4583   "Return the id of the root of the thread where ID appears."
4584   (let (last-id prev)
4585     (while (and id (setq prev (car (gnus-id-to-thread id))))
4586       (setq last-id id
4587             id (gnus-parent-id (mail-header-references prev))))
4588     last-id))
4589
4590 (defun gnus-articles-in-thread (thread)
4591   "Return the list of articles in THREAD."
4592   (cons (mail-header-number (car thread))
4593         (apply 'nconc (mapcar 'gnus-articles-in-thread (cdr thread)))))
4594
4595 (defun gnus-remove-thread (id &optional dont-remove)
4596   "Remove the thread that has ID in it."
4597   (let (headers thread last-id)
4598     ;; First go up in this thread until we find the root.
4599     (setq last-id (gnus-root-id id)
4600           headers (message-flatten-list (gnus-id-to-thread last-id)))
4601     ;; We have now found the real root of this thread.  It might have
4602     ;; been gathered into some loose thread, so we have to search
4603     ;; through the threads to find the thread we wanted.
4604     (let ((threads gnus-newsgroup-threads)
4605           sub)
4606       (while threads
4607         (setq sub (car threads))
4608         (if (stringp (car sub))
4609             ;; This is a gathered thread, so we look at the roots
4610             ;; below it to find whether this article is in this
4611             ;; gathered root.
4612             (progn
4613               (setq sub (cdr sub))
4614               (while sub
4615                 (when (member (caar sub) headers)
4616                   (setq thread (car threads)
4617                         threads nil
4618                         sub nil))
4619                 (setq sub (cdr sub))))
4620           ;; It's an ordinary thread, so we check it.
4621           (when (eq (car sub) (car headers))
4622             (setq thread sub
4623                   threads nil)))
4624         (setq threads (cdr threads)))
4625       ;; If this article is in no thread, then it's a root.
4626       (if thread
4627           (unless dont-remove
4628             (setq gnus-newsgroup-threads (delq thread gnus-newsgroup-threads)))
4629         (setq thread (gnus-id-to-thread last-id)))
4630       (when thread
4631         (prog1
4632             thread                      ; We return this thread.
4633           (unless dont-remove
4634             (if (stringp (car thread))
4635                 (progn
4636                   ;; If we use dummy roots, then we have to remove the
4637                   ;; dummy root as well.
4638                   (when (eq gnus-summary-make-false-root 'dummy)
4639                     ;; We go to the dummy root by going to
4640                     ;; the first sub-"thread", and then one line up.
4641                     (gnus-summary-goto-article
4642                      (mail-header-number (caadr thread)))
4643                     (forward-line -1)
4644                     (gnus-delete-line)
4645                     (gnus-data-compute-positions))
4646                   (setq thread (cdr thread))
4647                   (while thread
4648                     (gnus-remove-thread-1 (car thread))
4649                     (setq thread (cdr thread))))
4650               (gnus-remove-thread-1 thread))))))))
4651
4652 (defun gnus-remove-thread-1 (thread)
4653   "Remove the thread THREAD recursively."
4654   (let ((number (mail-header-number (pop thread)))
4655         d)
4656     (setq thread (reverse thread))
4657     (while thread
4658       (gnus-remove-thread-1 (pop thread)))
4659     (when (setq d (gnus-data-find number))
4660       (goto-char (gnus-data-pos d))
4661       (gnus-summary-show-thread)
4662       (gnus-data-remove
4663        number
4664        (- (point-at-bol)
4665           (prog1
4666               (1+ (point-at-eol))
4667             (gnus-delete-line)))))))
4668
4669 (defun gnus-sort-threads-recursive (threads func)
4670   (sort (mapcar (lambda (thread)
4671                   (cons (car thread)
4672                         (and (cdr thread)
4673                              (gnus-sort-threads-recursive (cdr thread) func))))
4674                 threads) func))
4675
4676 (defun gnus-sort-threads-loop (threads func)
4677   (let* ((superthread (cons nil threads))
4678          (stack (list (cons superthread threads)))
4679          remaining-threads thread)
4680     (while stack
4681       (setq remaining-threads (cdr (car stack)))
4682       (if remaining-threads
4683           (progn (setq thread (car remaining-threads))
4684                  (setcdr (car stack) (cdr remaining-threads))
4685                  (if (cdr thread)
4686                      (push (cons thread (cdr thread)) stack)))
4687         (setq thread (caar stack))
4688         (setcdr thread (sort (cdr thread) func))
4689         (pop stack)))
4690     (cdr superthread)))
4691
4692 (defun gnus-sort-threads (threads)
4693   "Sort THREADS."
4694   (if (not gnus-thread-sort-functions)
4695       threads
4696     (gnus-message 8 "Sorting threads...")
4697     (prog1
4698         (condition-case nil
4699             (let ((max-lisp-eval-depth (max max-lisp-eval-depth 5000)))
4700               (gnus-sort-threads-recursive
4701                threads (gnus-make-sort-function gnus-thread-sort-functions)))
4702           ;; Even after binding max-lisp-eval-depth, the recursive
4703           ;; sorter might fail for very long threads.  In that case,
4704           ;; try using a (less well-tested) non-recursive sorter.
4705           (error (gnus-sort-threads-loop
4706                   threads (gnus-make-sort-function
4707                            gnus-thread-sort-functions))))
4708       (gnus-message 8 "Sorting threads...done"))))
4709
4710 (defun gnus-sort-articles (articles)
4711   "Sort ARTICLES."
4712   (when gnus-article-sort-functions
4713     (gnus-message 7 "Sorting articles...")
4714     (prog1
4715         (setq gnus-newsgroup-headers
4716               (sort articles (gnus-make-sort-function
4717                               gnus-article-sort-functions)))
4718       (gnus-message 7 "Sorting articles...done"))))
4719
4720 ;; Written by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
4721 (defmacro gnus-thread-header (thread)
4722   "Return header of first article in THREAD.
4723 Note that THREAD must never, ever be anything else than a variable -
4724 using some other form will lead to serious barfage."
4725   (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread)))
4726   ;; (8% speedup to gnus-summary-prepare, just for fun :-)
4727   (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207"
4728         (vector thread) 2))
4729
4730 (defsubst gnus-article-sort-by-number (h1 h2)
4731   "Sort articles by article number."
4732   (< (mail-header-number h1)
4733      (mail-header-number h2)))
4734
4735 (defun gnus-thread-sort-by-number (h1 h2)
4736   "Sort threads by root article number."
4737   (gnus-article-sort-by-number
4738    (gnus-thread-header h1) (gnus-thread-header h2)))
4739
4740 (defsubst gnus-article-sort-by-random (h1 h2)
4741   "Sort articles by article number."
4742   (zerop (random 2)))
4743
4744 (defun gnus-thread-sort-by-random (h1 h2)
4745   "Sort threads by root article number."
4746   (gnus-article-sort-by-random
4747    (gnus-thread-header h1) (gnus-thread-header h2)))
4748
4749 (defsubst gnus-article-sort-by-lines (h1 h2)
4750   "Sort articles by article Lines header."
4751   (< (mail-header-lines h1)
4752      (mail-header-lines h2)))
4753
4754 (defun gnus-thread-sort-by-lines (h1 h2)
4755   "Sort threads by root article Lines header."
4756   (gnus-article-sort-by-lines
4757    (gnus-thread-header h1) (gnus-thread-header h2)))
4758
4759 (defsubst gnus-article-sort-by-chars (h1 h2)
4760   "Sort articles by octet length."
4761   (< (mail-header-chars h1)
4762      (mail-header-chars h2)))
4763
4764 (defun gnus-thread-sort-by-chars (h1 h2)
4765   "Sort threads by root article octet length."
4766   (gnus-article-sort-by-chars
4767    (gnus-thread-header h1) (gnus-thread-header h2)))
4768
4769 (defsubst gnus-article-sort-by-author (h1 h2)
4770   "Sort articles by root author."
4771   (string-lessp
4772    (let ((extract (funcall
4773                    gnus-extract-address-components
4774                    (mail-header-from h1))))
4775      (or (car extract) (cadr extract) ""))
4776    (let ((extract (funcall
4777                    gnus-extract-address-components
4778                    (mail-header-from h2))))
4779      (or (car extract) (cadr extract) ""))))
4780
4781 (defun gnus-thread-sort-by-author (h1 h2)
4782   "Sort threads by root author."
4783   (gnus-article-sort-by-author
4784    (gnus-thread-header h1)  (gnus-thread-header h2)))
4785
4786 (defsubst gnus-article-sort-by-recipient (h1 h2)
4787   "Sort articles by recipient."
4788   (string-lessp
4789    (let ((extract (funcall
4790                    gnus-extract-address-components
4791                    (or (cdr (assq 'To (mail-header-extra h1))) ""))))
4792      (or (car extract) (cadr extract)))
4793    (let ((extract (funcall
4794                    gnus-extract-address-components
4795                    (or (cdr (assq 'To (mail-header-extra h2))) ""))))
4796      (or (car extract) (cadr extract)))))
4797
4798 (defun gnus-thread-sort-by-recipient (h1 h2)
4799   "Sort threads by root recipient."
4800   (gnus-article-sort-by-recipient
4801    (gnus-thread-header h1) (gnus-thread-header h2)))
4802
4803 (defsubst gnus-article-sort-by-subject (h1 h2)
4804   "Sort articles by root subject."
4805   (string-lessp
4806    (downcase (gnus-simplify-subject-re (mail-header-subject h1)))
4807    (downcase (gnus-simplify-subject-re (mail-header-subject h2)))))
4808
4809 (defun gnus-thread-sort-by-subject (h1 h2)
4810   "Sort threads by root subject."
4811   (gnus-article-sort-by-subject
4812    (gnus-thread-header h1) (gnus-thread-header h2)))
4813
4814 (defsubst gnus-article-sort-by-date (h1 h2)
4815   "Sort articles by root article date."
4816   (time-less-p
4817    (gnus-date-get-time (mail-header-date h1))
4818    (gnus-date-get-time (mail-header-date h2))))
4819
4820 (defun gnus-thread-sort-by-date (h1 h2)
4821   "Sort threads by root article date."
4822   (gnus-article-sort-by-date
4823    (gnus-thread-header h1) (gnus-thread-header h2)))
4824
4825 (defsubst gnus-article-sort-by-score (h1 h2)
4826   "Sort articles by root article score.
4827 Unscored articles will be counted as having a score of zero."
4828   (> (or (cdr (assq (mail-header-number h1)
4829                     gnus-newsgroup-scored))
4830          gnus-summary-default-score 0)
4831      (or (cdr (assq (mail-header-number h2)
4832                     gnus-newsgroup-scored))
4833          gnus-summary-default-score 0)))
4834
4835 (defun gnus-thread-sort-by-score (h1 h2)
4836   "Sort threads by root article score."
4837   (gnus-article-sort-by-score
4838    (gnus-thread-header h1) (gnus-thread-header h2)))
4839
4840 (defun gnus-thread-sort-by-total-score (h1 h2)
4841   "Sort threads by the sum of all scores in the thread.
4842 Unscored articles will be counted as having a score of zero."
4843   (> (gnus-thread-total-score h1) (gnus-thread-total-score h2)))
4844
4845 (defun gnus-thread-total-score (thread)
4846   ;; This function find the total score of THREAD.
4847   (cond
4848    ((null thread)
4849     0)
4850    ((consp thread)
4851     (if (stringp (car thread))
4852         (apply gnus-thread-score-function 0
4853                (mapcar 'gnus-thread-total-score-1 (cdr thread)))
4854       (gnus-thread-total-score-1 thread)))
4855    (t
4856     (gnus-thread-total-score-1 (list thread)))))
4857
4858 (defun gnus-thread-sort-by-most-recent-number (h1 h2)
4859   "Sort threads such that the thread with the most recently arrived article comes first."
4860   (> (gnus-thread-highest-number h1) (gnus-thread-highest-number h2)))
4861
4862 (defun gnus-thread-highest-number (thread)
4863   "Return the highest article number in THREAD."
4864   (apply 'max (mapcar (lambda (header)
4865                         (mail-header-number header))
4866                       (message-flatten-list thread))))
4867
4868 (defun gnus-thread-sort-by-most-recent-date (h1 h2)
4869   "Sort threads such that the thread with the most recently dated article comes first."
4870   (> (gnus-thread-latest-date h1) (gnus-thread-latest-date h2)))
4871
4872 (defun gnus-thread-latest-date (thread)
4873   "Return the highest article date in THREAD."
4874   (let ((previous-time 0))
4875     (apply 'max
4876            (mapcar
4877             (lambda (header)
4878               (setq previous-time
4879                     (condition-case ()
4880                         (time-to-seconds (mail-header-parse-date
4881                                           (mail-header-date header)))
4882                       (error previous-time))))
4883             (sort
4884              (message-flatten-list thread)
4885              (lambda (h1 h2)
4886                (< (mail-header-number h1)
4887                   (mail-header-number h2))))))))
4888
4889 (defun gnus-thread-total-score-1 (root)
4890   ;; This function find the total score of the thread below ROOT.
4891   (setq root (car root))
4892   (apply gnus-thread-score-function
4893          (or (append
4894               (mapcar 'gnus-thread-total-score
4895                       (cdr (gnus-id-to-thread (mail-header-id root))))
4896               (when (> (mail-header-number root) 0)
4897                 (list (or (cdr (assq (mail-header-number root)
4898                                      gnus-newsgroup-scored))
4899                           gnus-summary-default-score 0))))
4900              (list gnus-summary-default-score)
4901              '(0))))
4902
4903 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
4904 (defvar gnus-tmp-prev-subject nil)
4905 (defvar gnus-tmp-false-parent nil)
4906 (defvar gnus-tmp-root-expunged nil)
4907 (defvar gnus-tmp-dummy-line nil)
4908
4909 (eval-when-compile (defvar gnus-tmp-header))
4910 (defun gnus-extra-header (type &optional header)
4911   "Return the extra header of TYPE."
4912   (or (cdr (assq type (mail-header-extra (or header gnus-tmp-header))))
4913       ""))
4914
4915 (defvar gnus-tmp-thread-tree-header-string "")
4916
4917 (defcustom gnus-sum-thread-tree-root "> "
4918   "With %B spec, used for the root of a thread.
4919 If nil, use subject instead."
4920   :version "22.1"
4921   :type '(radio (const :format "%v  " nil) string)
4922   :group 'gnus-thread)
4923
4924 (defcustom gnus-sum-thread-tree-false-root "> "
4925   "With %B spec, used for a false root of a thread.
4926 If nil, use subject instead."
4927   :version "22.1"
4928   :type '(radio (const :format "%v  " nil) string)
4929   :group 'gnus-thread)
4930
4931 (defcustom gnus-sum-thread-tree-single-indent ""
4932   "With %B spec, used for a thread with just one message.
4933 If nil, use subject instead."
4934   :version "22.1"
4935   :type '(radio (const :format "%v  " nil) string)
4936   :group 'gnus-thread)
4937
4938 (defcustom gnus-sum-thread-tree-vertical "| "
4939   "With %B spec, used for drawing a vertical line."
4940   :version "22.1"
4941   :type 'string
4942   :group 'gnus-thread)
4943
4944 (defcustom gnus-sum-thread-tree-indent "  "
4945   "With %B spec, used for indenting."
4946   :version "22.1"
4947   :type 'string
4948   :group 'gnus-thread)
4949
4950 (defcustom gnus-sum-thread-tree-leaf-with-other "+-> "
4951   "With %B spec, used for a leaf with brothers."
4952   :version "22.1"
4953   :type 'string
4954   :group 'gnus-thread)
4955
4956 (defcustom gnus-sum-thread-tree-single-leaf "\\-> "
4957   "With %B spec, used for a leaf without brothers."
4958   :version "22.1"
4959   :type 'string
4960   :group 'gnus-thread)
4961
4962 (defun gnus-summary-prepare-threads (threads)
4963   "Prepare summary buffer from THREADS and indentation LEVEL.
4964 THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])'
4965 or a straight list of headers."
4966   (gnus-message 7 "Generating summary...")
4967
4968   (setq gnus-newsgroup-threads threads)
4969   (beginning-of-line)
4970
4971   (let ((gnus-tmp-level 0)
4972         (default-score (or gnus-summary-default-score 0))
4973         (gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight))
4974         (building-line-count gnus-summary-display-while-building)
4975         (building-count (integerp gnus-summary-display-while-building))
4976         thread number subject stack state gnus-tmp-gathered beg-match
4977         new-roots gnus-tmp-new-adopts thread-end simp-subject
4978         gnus-tmp-header gnus-tmp-unread gnus-tmp-downloaded
4979         gnus-tmp-replied gnus-tmp-subject-or-nil
4980         gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score
4981         gnus-tmp-score-char gnus-tmp-from gnus-tmp-name
4982         gnus-tmp-number gnus-tmp-opening-bracket gnus-tmp-closing-bracket
4983         tree-stack)
4984
4985     (setq gnus-tmp-prev-subject nil
4986           gnus-tmp-thread-tree-header-string "")
4987
4988     (if (vectorp (car threads))
4989         ;; If this is a straight (sic) list of headers, then a
4990         ;; threaded summary display isn't required, so we just create
4991         ;; an unthreaded one.
4992         (gnus-summary-prepare-unthreaded threads)
4993
4994       ;; Do the threaded display.
4995
4996       (if gnus-summary-display-while-building
4997           (switch-to-buffer (buffer-name)))
4998       (while (or threads stack gnus-tmp-new-adopts new-roots)
4999
5000         (if (and (= gnus-tmp-level 0)
5001                  (or (not stack)
5002                      (= (caar stack) 0))
5003                  (not gnus-tmp-false-parent)
5004                  (or gnus-tmp-new-adopts new-roots))
5005             (if gnus-tmp-new-adopts
5006                 (setq gnus-tmp-level (if gnus-tmp-root-expunged 0 1)
5007                       thread (list (car gnus-tmp-new-adopts))
5008                       gnus-tmp-header (caar thread)
5009                       gnus-tmp-new-adopts (cdr gnus-tmp-new-adopts))
5010               (when new-roots
5011                 (setq thread (list (car new-roots))
5012                       gnus-tmp-header (caar thread)
5013                       new-roots (cdr new-roots))))
5014
5015           (if threads
5016               ;; If there are some threads, we do them before the
5017               ;; threads on the stack.
5018               (setq thread threads
5019                     gnus-tmp-header (caar thread))
5020             ;; There were no current threads, so we pop something off
5021             ;; the stack.
5022             (setq state (car stack)
5023                   gnus-tmp-level (car state)
5024                   tree-stack (cadr state)
5025                   thread (caddr state)
5026                   stack (cdr stack)
5027                   gnus-tmp-header (caar thread))))
5028
5029         (setq gnus-tmp-false-parent nil)
5030         (setq gnus-tmp-root-expunged nil)
5031         (setq thread-end nil)
5032
5033         (if (stringp gnus-tmp-header)
5034             ;; The header is a dummy root.
5035             (cond
5036              ((eq gnus-summary-make-false-root 'adopt)
5037               ;; We let the first article adopt the rest.
5038               (setq gnus-tmp-new-adopts (nconc gnus-tmp-new-adopts
5039                                                (cddar thread)))
5040               (setq gnus-tmp-gathered
5041                     (nconc (mapcar
5042                             (lambda (h) (mail-header-number (car h)))
5043                             (cddar thread))
5044                            gnus-tmp-gathered))
5045               (setq thread (cons (list (caar thread)
5046                                        (cadar thread))
5047                                  (cdr thread)))
5048               (setq gnus-tmp-level -1
5049                     gnus-tmp-false-parent t))
5050              ((eq gnus-summary-make-false-root 'empty)
5051               ;; We print adopted articles with empty subject fields.
5052               (setq gnus-tmp-gathered
5053                     (nconc (mapcar
5054                             (lambda (h) (mail-header-number (car h)))
5055                             (cddar thread))
5056                            gnus-tmp-gathered))
5057               (setq gnus-tmp-level -1))
5058              ((eq gnus-summary-make-false-root 'dummy)
5059               ;; We remember that we probably want to output a dummy
5060               ;; root.
5061               (setq gnus-tmp-dummy-line gnus-tmp-header)
5062               (setq gnus-tmp-prev-subject gnus-tmp-header))
5063              (t
5064               ;; We do not make a root for the gathered
5065               ;; sub-threads at all.
5066               (setq gnus-tmp-level -1)))
5067
5068           (setq number (mail-header-number gnus-tmp-header)
5069                 subject (mail-header-subject gnus-tmp-header)
5070                 simp-subject (gnus-simplify-subject-fully subject))
5071
5072           (cond
5073            ;; If the thread has changed subject, we might want to make
5074            ;; this subthread into a root.
5075            ((and (null gnus-thread-ignore-subject)
5076                  (not (zerop gnus-tmp-level))
5077                  gnus-tmp-prev-subject
5078                  (not (string= gnus-tmp-prev-subject simp-subject)))
5079             (setq new-roots (nconc new-roots (list (car thread)))
5080                   thread-end t
5081                   gnus-tmp-header nil))
5082            ;; If the article lies outside the current limit,
5083            ;; then we do not display it.
5084            ((not (memq number gnus-newsgroup-limit))
5085             (setq gnus-tmp-gathered
5086                   (nconc (mapcar
5087                           (lambda (h) (mail-header-number (car h)))
5088                           (cdar thread))
5089                          gnus-tmp-gathered))
5090             (setq gnus-tmp-new-adopts (if (cdar thread)
5091                                           (append gnus-tmp-new-adopts
5092                                                   (cdar thread))
5093                                         gnus-tmp-new-adopts)
5094                   thread-end t
5095                   gnus-tmp-header nil)
5096             (when (zerop gnus-tmp-level)
5097               (setq gnus-tmp-root-expunged t)))
5098            ;; Perhaps this article is to be marked as read?
5099            ((and gnus-summary-mark-below
5100                  (< (or (cdr (assq number gnus-newsgroup-scored))
5101                         default-score)
5102                     gnus-summary-mark-below)
5103                  ;; Don't touch sparse articles.
5104                  (not (gnus-summary-article-sparse-p number))
5105                  (not (gnus-summary-article-ancient-p number)))
5106             (setq gnus-newsgroup-unreads
5107                   (delq number gnus-newsgroup-unreads))
5108             (if gnus-newsgroup-auto-expire
5109                 (setq gnus-newsgroup-expirable
5110                       (gnus-add-to-sorted-list
5111                        gnus-newsgroup-expirable number))
5112               (push (cons number gnus-low-score-mark)
5113                     gnus-newsgroup-reads))))
5114
5115           (when gnus-tmp-header
5116             ;; We may have an old dummy line to output before this
5117             ;; article.
5118             (when (and gnus-tmp-dummy-line
5119                        (gnus-subject-equal
5120                         gnus-tmp-dummy-line
5121                         (mail-header-subject gnus-tmp-header)))
5122               (gnus-summary-insert-dummy-line
5123                gnus-tmp-dummy-line (mail-header-number gnus-tmp-header))
5124               (setq gnus-tmp-dummy-line nil))
5125
5126             ;; Compute the mark.
5127             (setq gnus-tmp-unread (gnus-article-mark number))
5128
5129             (push (gnus-data-make number gnus-tmp-unread (1+ (point))
5130                                   gnus-tmp-header gnus-tmp-level)
5131                   gnus-newsgroup-data)
5132
5133             ;; Actually insert the line.
5134             (setq
5135              gnus-tmp-subject-or-nil
5136              (cond
5137               ((and gnus-thread-ignore-subject
5138                     gnus-tmp-prev-subject
5139                     (not (string= gnus-tmp-prev-subject simp-subject)))
5140                subject)
5141               ((zerop gnus-tmp-level)
5142                (if (and (eq gnus-summary-make-false-root 'empty)
5143                         (memq number gnus-tmp-gathered)
5144                         gnus-tmp-prev-subject
5145                         (string= gnus-tmp-prev-subject simp-subject))
5146                    gnus-summary-same-subject
5147                  subject))
5148               (t gnus-summary-same-subject)))
5149             (if (and (eq gnus-summary-make-false-root 'adopt)
5150                      (= gnus-tmp-level 1)
5151                      (memq number gnus-tmp-gathered))
5152                 (setq gnus-tmp-opening-bracket ?\<
5153                       gnus-tmp-closing-bracket ?\>)
5154               (setq gnus-tmp-opening-bracket ?\[
5155                     gnus-tmp-closing-bracket ?\]))
5156             (if (>= gnus-tmp-level (length gnus-thread-indent-array))
5157                 (gnus-make-thread-indent-array
5158                  (max (* 2 (length gnus-thread-indent-array))
5159                       gnus-tmp-level)))
5160             (setq
5161              gnus-tmp-indentation
5162              (aref gnus-thread-indent-array gnus-tmp-level)
5163              gnus-tmp-lines (mail-header-lines gnus-tmp-header)
5164              gnus-tmp-score (or (cdr (assq number gnus-newsgroup-scored))
5165                                 gnus-summary-default-score 0)
5166              gnus-tmp-score-char
5167              (if (or (null gnus-summary-default-score)
5168                      (<= (abs (- gnus-tmp-score gnus-summary-default-score))
5169                          gnus-summary-zcore-fuzz))
5170                  ?                      ;Whitespace
5171                (if (< gnus-tmp-score gnus-summary-default-score)
5172                    gnus-score-below-mark gnus-score-over-mark))
5173              gnus-tmp-replied
5174              (cond ((memq number gnus-newsgroup-processable)
5175                     gnus-process-mark)
5176                    ((memq number gnus-newsgroup-cached)
5177                     gnus-cached-mark)
5178                    ((memq number gnus-newsgroup-replied)
5179                     gnus-replied-mark)
5180                    ((memq number gnus-newsgroup-forwarded)
5181                     gnus-forwarded-mark)
5182                    ((memq number gnus-newsgroup-saved)
5183                     gnus-saved-mark)
5184                    ((memq number gnus-newsgroup-recent)
5185                     gnus-recent-mark)
5186                    ((memq number gnus-newsgroup-unseen)
5187                     gnus-unseen-mark)
5188                    (t gnus-no-mark))
5189              gnus-tmp-downloaded
5190              (cond ((memq number gnus-newsgroup-undownloaded)
5191                     gnus-undownloaded-mark)
5192                    (gnus-newsgroup-agentized
5193                     gnus-downloaded-mark)
5194                    (t
5195                     gnus-no-mark))
5196              gnus-tmp-from (mail-header-from gnus-tmp-header)
5197              gnus-tmp-name
5198              (cond
5199               ((string-match "<[^>]+> *$" gnus-tmp-from)
5200                (setq beg-match (match-beginning 0))
5201                (or (and (string-match "^\".+\"" gnus-tmp-from)
5202                         (substring gnus-tmp-from 1 (1- (match-end 0))))
5203                    (substring gnus-tmp-from 0 beg-match)))
5204               ((string-match "(.+)" gnus-tmp-from)
5205                (substring gnus-tmp-from
5206                           (1+ (match-beginning 0)) (1- (match-end 0))))
5207               (t gnus-tmp-from))
5208
5209              ;; Do the %B string
5210              gnus-tmp-thread-tree-header-string
5211              (cond
5212               ((not gnus-show-threads) "")
5213               ((zerop gnus-tmp-level)
5214                (cond ((cdar thread)
5215                       (or gnus-sum-thread-tree-root subject))
5216                      (gnus-tmp-new-adopts
5217                       (or gnus-sum-thread-tree-false-root subject))
5218                      (t
5219                       (or gnus-sum-thread-tree-single-indent subject))))
5220               (t
5221                (concat (apply 'concat
5222                               (mapcar (lambda (item)
5223                                         (if (= item 1)
5224                                             gnus-sum-thread-tree-vertical
5225                                           gnus-sum-thread-tree-indent))
5226                                       (cdr (reverse tree-stack))))
5227                        (if (nth 1 thread)
5228                            gnus-sum-thread-tree-leaf-with-other
5229                          gnus-sum-thread-tree-single-leaf)))))
5230             (when (string= gnus-tmp-name "")
5231               (setq gnus-tmp-name gnus-tmp-from))
5232             (unless (numberp gnus-tmp-lines)
5233               (setq gnus-tmp-lines -1))
5234             (if (= gnus-tmp-lines -1)
5235                 (setq gnus-tmp-lines "?")
5236               (setq gnus-tmp-lines (number-to-string gnus-tmp-lines)))
5237               (gnus-put-text-property
5238              (point)
5239              (progn (eval gnus-summary-line-format-spec) (point))
5240                'gnus-number number)
5241             (when gnus-visual-p
5242               (forward-line -1)
5243               (gnus-run-hooks 'gnus-summary-update-hook)
5244               (forward-line 1))
5245
5246             (setq gnus-tmp-prev-subject simp-subject)))
5247
5248         (when (nth 1 thread)
5249           (push (list (max 0 gnus-tmp-level)
5250                       (copy-sequence tree-stack)
5251                       (nthcdr 1 thread))
5252                 stack))
5253         (push (if (nth 1 thread) 1 0) tree-stack)
5254         (incf gnus-tmp-level)
5255         (setq threads (if thread-end nil (cdar thread)))
5256         (if gnus-summary-display-while-building
5257             (if building-count
5258                 (progn
5259                   ;; use a set frequency
5260                   (setq building-line-count (1- building-line-count))
5261                   (when (= building-line-count 0)
5262                     (sit-for 0)
5263                     (setq building-line-count
5264                           gnus-summary-display-while-building)))
5265               ;; always
5266               (sit-for 0)))
5267         (unless threads
5268           (setq gnus-tmp-level 0)))))
5269   (gnus-message 7 "Generating summary...done"))
5270
5271 (defun gnus-summary-prepare-unthreaded (headers)
5272   "Generate an unthreaded summary buffer based on HEADERS."
5273   (let (header number mark)
5274
5275     (beginning-of-line)
5276
5277     (while headers
5278       ;; We may have to root out some bad articles...
5279       (when (memq (setq number (mail-header-number
5280                                 (setq header (pop headers))))
5281                   gnus-newsgroup-limit)
5282         ;; Mark article as read when it has a low score.
5283         (when (and gnus-summary-mark-below
5284                    (< (or (cdr (assq number gnus-newsgroup-scored))
5285                           gnus-summary-default-score 0)
5286                       gnus-summary-mark-below)
5287                    (not (gnus-summary-article-ancient-p number)))
5288           (setq gnus-newsgroup-unreads
5289                 (delq number gnus-newsgroup-unreads))
5290           (if gnus-newsgroup-auto-expire
5291               (push number gnus-newsgroup-expirable)
5292             (push (cons number gnus-low-score-mark)
5293                   gnus-newsgroup-reads)))
5294
5295         (setq mark (gnus-article-mark number))
5296         (push (gnus-data-make number mark (1+ (point)) header 0)
5297               gnus-newsgroup-data)
5298         (gnus-summary-insert-line
5299          header 0 number
5300          (memq number gnus-newsgroup-undownloaded)
5301          mark (memq number gnus-newsgroup-replied)
5302          (memq number gnus-newsgroup-expirable)
5303          (mail-header-subject header) nil
5304          (cdr (assq number gnus-newsgroup-scored))
5305          (memq number gnus-newsgroup-processable))))))
5306
5307 (defun gnus-summary-remove-list-identifiers ()
5308   "Remove list identifiers in `gnus-list-identifiers' from articles in the current group."
5309   (let ((regexp (if (consp gnus-list-identifiers)
5310                     (mapconcat 'identity gnus-list-identifiers " *\\|")
5311                   gnus-list-identifiers))
5312         changed subject)
5313     (when regexp
5314       (setq regexp (concat "^\\(?:R[Ee]: +\\)*\\(" regexp " *\\)"))
5315       (dolist (header gnus-newsgroup-headers)
5316         (setq subject (mail-header-subject header)
5317               changed nil)
5318         (while (string-match regexp subject)
5319           (setq subject
5320                 (concat (substring subject 0 (match-beginning 1))
5321                         (substring subject (match-end 0)))
5322                 changed t))
5323         (when changed
5324           (when (string-match "^\\(\\(?:R[Ee]: +\\)+\\)R[Ee]: +" subject)
5325             (setq subject
5326                   (concat (substring subject 0 (match-beginning 1))
5327                           (substring subject (match-end 1)))))
5328           (mail-header-set-subject header subject))))))
5329
5330 (defun gnus-fetch-headers (articles)
5331   "Fetch headers of ARTICLES."
5332   (let ((name (gnus-group-decoded-name gnus-newsgroup-name)))
5333     (gnus-message 5 "Fetching headers for %s..." name)
5334     (prog1
5335         (if (eq 'nov
5336                 (setq gnus-headers-retrieved-by
5337                       (gnus-retrieve-headers
5338                        articles gnus-newsgroup-name
5339                        ;; We might want to fetch old headers, but
5340                        ;; not if there is only 1 article.
5341                        (and (or (and
5342                                  (not (eq gnus-fetch-old-headers 'some))
5343                                  (not (numberp gnus-fetch-old-headers)))
5344                                 (> (length articles) 1))
5345                             gnus-fetch-old-headers))))
5346             (gnus-get-newsgroup-headers-xover
5347              articles nil nil gnus-newsgroup-name t)
5348           (gnus-get-newsgroup-headers))
5349       (gnus-message 5 "Fetching headers for %s...done" name))))
5350
5351 (defun gnus-select-newsgroup (group &optional read-all select-articles)
5352   "Select newsgroup GROUP.
5353 If READ-ALL is non-nil, all articles in the group are selected.
5354 If SELECT-ARTICLES, only select those articles from GROUP."
5355   (let* ((entry (gnus-group-entry group))
5356          ;;!!! Dirty hack; should be removed.
5357          (gnus-summary-ignore-duplicates
5358           (if (eq (car (gnus-find-method-for-group group)) 'nnvirtual)
5359               t
5360             gnus-summary-ignore-duplicates))
5361          (info (nth 2 entry))
5362          articles fetched-articles cached)
5363
5364     (unless (gnus-check-server
5365              (set (make-local-variable 'gnus-current-select-method)
5366                   (gnus-find-method-for-group group)))
5367       (error "Couldn't open server"))
5368
5369     (or (and entry (not (eq (car entry) t))) ; Either it's active...
5370         (gnus-activate-group group)     ; Or we can activate it...
5371         (progn                          ; Or we bug out.
5372           (when (equal major-mode 'gnus-summary-mode)
5373             (gnus-kill-buffer (current-buffer)))
5374           (error "Couldn't activate group %s: %s"
5375                  (gnus-group-decoded-name group) (gnus-status-message group))))
5376
5377     (unless (gnus-request-group group t)
5378       (when (equal major-mode 'gnus-summary-mode)
5379         (gnus-kill-buffer (current-buffer)))
5380       (error "Couldn't request group %s: %s"
5381              (gnus-group-decoded-name group) (gnus-status-message group)))
5382
5383     (when gnus-agent
5384       (gnus-agent-possibly-alter-active group (gnus-active group) info)
5385
5386       (setq gnus-summary-use-undownloaded-faces
5387             (gnus-agent-find-parameter
5388              group
5389              'agent-enable-undownloaded-faces)))
5390
5391     (setq gnus-newsgroup-name group
5392           gnus-newsgroup-unselected nil
5393           gnus-newsgroup-unreads (gnus-list-of-unread-articles group))
5394
5395     (let ((display (gnus-group-find-parameter group 'display)))
5396       (setq gnus-newsgroup-display
5397             (cond
5398              ((not (zerop (or (car-safe read-all) 0)))
5399               ;; The user entered the group with C-u SPC/RET, let's show
5400               ;; all articles.
5401               'gnus-not-ignore)
5402              ((eq display 'all)
5403               'gnus-not-ignore)
5404              ((arrayp display)
5405               (gnus-summary-display-make-predicate (mapcar 'identity display)))
5406              ((numberp display)
5407               ;; The following is probably the "correct" solution, but
5408               ;; it makes Gnus fetch all headers and then limit the
5409               ;; articles (which is slow), so instead we hack the
5410               ;; select-articles parameter instead. -- Simon Josefsson
5411               ;; <jas@kth.se>
5412               ;;
5413               ;; (gnus-byte-compile
5414               ;;  `(lambda () (> number ,(- (cdr (gnus-active group))
5415               ;;                         display)))))
5416               (setq select-articles
5417                     (gnus-uncompress-range
5418                      (cons (let ((tmp (- (cdr (gnus-active group)) display)))
5419                              (if (> tmp 0)
5420                                  tmp
5421                                1))
5422                            (cdr (gnus-active group)))))
5423               nil)
5424              (t
5425               nil))))
5426
5427     (gnus-summary-setup-default-charset)
5428
5429     ;; Kludge to avoid having cached articles nixed out in virtual groups.
5430     (when (gnus-virtual-group-p group)
5431       (setq cached gnus-newsgroup-cached))
5432
5433     (setq gnus-newsgroup-unreads
5434           (gnus-sorted-ndifference
5435            (gnus-sorted-ndifference gnus-newsgroup-unreads
5436                                     gnus-newsgroup-marked)
5437            gnus-newsgroup-dormant))
5438
5439     (setq gnus-newsgroup-processable nil)
5440
5441     (gnus-update-read-articles group gnus-newsgroup-unreads)
5442
5443     ;; Adjust and set lists of article marks.
5444     (when info
5445       (gnus-adjust-marked-articles info))
5446     (if (setq articles select-articles)
5447         (setq gnus-newsgroup-unselected
5448               (gnus-sorted-difference gnus-newsgroup-unreads articles))
5449       (setq articles (gnus-articles-to-read group read-all)))
5450
5451     (cond
5452      ((null articles)
5453       ;;(gnus-message 3 "Couldn't select newsgroup -- no articles to display")
5454       'quit)
5455      ((eq articles 0) nil)
5456      (t
5457       ;; Init the dependencies hash table.
5458       (setq gnus-newsgroup-dependencies
5459             (gnus-make-hashtable (length articles)))
5460       (gnus-set-global-variables)
5461       ;; Retrieve the headers and read them in.
5462
5463       (setq gnus-newsgroup-headers (gnus-fetch-headers articles))
5464
5465       ;; Kludge to avoid having cached articles nixed out in virtual groups.
5466       (when cached
5467         (setq gnus-newsgroup-cached cached))
5468
5469       ;; Suppress duplicates?
5470       (when gnus-suppress-duplicates
5471         (gnus-dup-suppress-articles))
5472
5473       ;; Set the initial limit.
5474       (setq gnus-newsgroup-limit (copy-sequence articles))
5475       ;; Remove canceled articles from the list of unread articles.
5476       (setq fetched-articles
5477             (mapcar (lambda (headers) (mail-header-number headers))
5478                     gnus-newsgroup-headers))
5479       (setq gnus-newsgroup-articles fetched-articles)
5480       (setq gnus-newsgroup-unreads
5481             (gnus-sorted-nintersection
5482              gnus-newsgroup-unreads fetched-articles))
5483       (gnus-compute-unseen-list)
5484
5485       ;; Removed marked articles that do not exist.
5486       (gnus-update-missing-marks
5487        (gnus-sorted-difference articles fetched-articles))
5488       ;; We might want to build some more threads first.
5489       (when (and gnus-fetch-old-headers
5490                  (eq gnus-headers-retrieved-by 'nov))
5491         (if (eq gnus-fetch-old-headers 'invisible)
5492             (gnus-build-all-threads)
5493           (gnus-build-old-threads)))
5494       ;; Let the Gnus agent mark articles as read.
5495       (when gnus-agent
5496         (gnus-agent-get-undownloaded-list))
5497       ;; Remove list identifiers from subject
5498       (when gnus-list-identifiers
5499         (gnus-summary-remove-list-identifiers))
5500       ;; Check whether auto-expire is to be done in this group.
5501       (setq gnus-newsgroup-auto-expire
5502             (gnus-group-auto-expirable-p group))
5503       ;; Set up the article buffer now, if necessary.
5504       (unless (and gnus-single-article-buffer
5505                    (equal gnus-article-buffer "*Article*"))
5506         (gnus-article-setup-buffer))
5507       ;; First and last article in this newsgroup.
5508       (when gnus-newsgroup-headers
5509         (setq gnus-newsgroup-begin
5510               (mail-header-number (car gnus-newsgroup-headers))
5511               gnus-newsgroup-end
5512               (mail-header-number
5513                (gnus-last-element gnus-newsgroup-headers))))
5514       ;; GROUP is successfully selected.
5515       (or gnus-newsgroup-headers t)))))
5516
5517 (defun gnus-compute-unseen-list ()
5518   ;; The `seen' marks are treated specially.
5519   (if (not gnus-newsgroup-seen)
5520       (setq gnus-newsgroup-unseen gnus-newsgroup-articles)
5521     (setq gnus-newsgroup-unseen
5522           (gnus-inverse-list-range-intersection
5523            gnus-newsgroup-articles gnus-newsgroup-seen))))
5524
5525 (defun gnus-summary-display-make-predicate (display)
5526   (require 'gnus-agent)
5527   (when (= (length display) 1)
5528     (setq display (car display)))
5529   (unless gnus-summary-display-cache
5530     (dolist (elem (append '((unread . unread)
5531                             (read . read)
5532                             (unseen . unseen))
5533                           gnus-article-mark-lists))
5534       (push (cons (cdr elem)
5535                   (gnus-byte-compile
5536                    `(lambda () (gnus-article-marked-p ',(cdr elem)))))
5537             gnus-summary-display-cache)))
5538   (let ((gnus-category-predicate-alist gnus-summary-display-cache)
5539         (gnus-category-predicate-cache gnus-summary-display-cache))
5540     (gnus-get-predicate display)))
5541
5542 ;; Uses the dynamically bound `number' variable.
5543 (eval-when-compile
5544   (defvar number))
5545 (defun gnus-article-marked-p (type &optional article)
5546   (let ((article (or article number)))
5547     (cond
5548      ((eq type 'tick)
5549       (memq article gnus-newsgroup-marked))
5550      ((eq type 'spam)
5551       (memq article gnus-newsgroup-spam-marked))
5552      ((eq type 'unsend)
5553       (memq article gnus-newsgroup-unsendable))
5554      ((eq type 'undownload)
5555       (memq article gnus-newsgroup-undownloaded))
5556      ((eq type 'download)
5557       (memq article gnus-newsgroup-downloadable))
5558      ((eq type 'unread)
5559       (memq article gnus-newsgroup-unreads))
5560      ((eq type 'read)
5561       (memq article gnus-newsgroup-reads))
5562      ((eq type 'dormant)
5563       (memq article gnus-newsgroup-dormant) )
5564      ((eq type 'expire)
5565       (memq article gnus-newsgroup-expirable))
5566      ((eq type 'reply)
5567       (memq article gnus-newsgroup-replied))
5568      ((eq type 'killed)
5569       (memq article gnus-newsgroup-killed))
5570      ((eq type 'bookmark)
5571       (assq article gnus-newsgroup-bookmarks))
5572      ((eq type 'score)
5573       (assq article gnus-newsgroup-scored))
5574      ((eq type 'save)
5575       (memq article gnus-newsgroup-saved))
5576      ((eq type 'cache)
5577       (memq article gnus-newsgroup-cached))
5578      ((eq type 'forward)
5579       (memq article gnus-newsgroup-forwarded))
5580      ((eq type 'seen)
5581       (not (memq article gnus-newsgroup-unseen)))
5582      ((eq type 'recent)
5583       (memq article gnus-newsgroup-recent))
5584      (t t))))
5585
5586 (defun gnus-articles-to-read (group &optional read-all)
5587   "Find out what articles the user wants to read."
5588   (let* ((articles
5589           ;; Select all articles if `read-all' is non-nil, or if there
5590           ;; are no unread articles.
5591           (if (or read-all
5592                   (and (zerop (length gnus-newsgroup-marked))
5593                        (zerop (length gnus-newsgroup-unreads)))
5594                   ;; Fetch all if the predicate is non-nil.
5595                   gnus-newsgroup-display)
5596               ;; We want to select the headers for all the articles in
5597               ;; the group, so we select either all the active
5598               ;; articles in the group, or (if that's nil), the
5599               ;; articles in the cache.
5600               (or
5601                (gnus-uncompress-range (gnus-active group))
5602                (gnus-cache-articles-in-group group))
5603             ;; Select only the "normal" subset of articles.
5604             (gnus-sorted-nunion
5605              (gnus-sorted-union gnus-newsgroup-dormant gnus-newsgroup-marked)
5606              gnus-newsgroup-unreads)))
5607          (scored-list (gnus-killed-articles gnus-newsgroup-killed articles))
5608          (scored (length scored-list))
5609          (number (length articles))
5610          (marked (+ (length gnus-newsgroup-marked)
5611                     (length gnus-newsgroup-dormant)))
5612          (select
5613           (cond
5614            ((numberp read-all)
5615             read-all)
5616            ((numberp gnus-newsgroup-display)
5617             gnus-newsgroup-display)
5618            (t
5619             (condition-case ()
5620                 (cond
5621                  ((and (or (<= scored marked) (= scored number))
5622                        (numberp gnus-large-newsgroup)
5623                        (> number gnus-large-newsgroup))
5624                   (let* ((cursor-in-echo-area nil)
5625                          (initial (gnus-parameter-large-newsgroup-initial
5626                                    gnus-newsgroup-name))
5627                          (input
5628                           (read-string
5629                            (format
5630                             "How many articles from %s (%s %d): "
5631                             (gnus-limit-string
5632                              (gnus-group-decoded-name gnus-newsgroup-name)
5633                              35)
5634                             (if initial "max" "default")
5635                             number)
5636                            (if initial
5637                                (cons (number-to-string initial)
5638                                      0)))))
5639                     (if (string-match "^[ \t]*$" input) number input)))
5640                  ((and (> scored marked) (< scored number)
5641                        (> (- scored number) 20))
5642                   (let ((input
5643                          (read-string
5644                           (format "%s %s (%d scored, %d total): "
5645                                   "How many articles from"
5646                                   (gnus-group-decoded-name group)
5647                                   scored number))))
5648                     (if (string-match "^[ \t]*$" input)
5649                         number input)))
5650                  (t number))
5651               (quit
5652                (message "Quit getting the articles to read")
5653                nil))))))
5654     (setq select (if (stringp select) (string-to-number select) select))
5655     (if (or (null select) (zerop select))
5656         select
5657       (if (and (not (zerop scored)) (<= (abs select) scored))
5658           (progn
5659             (setq articles (sort scored-list '<))
5660             (setq number (length articles)))
5661         (setq articles (copy-sequence articles)))
5662
5663       (when (< (abs select) number)
5664         (if (< select 0)
5665             ;; Select the N oldest articles.
5666             (setcdr (nthcdr (1- (abs select)) articles) nil)
5667           ;; Select the N most recent articles.
5668           (setq articles (nthcdr (- number select) articles))))
5669       (setq gnus-newsgroup-unselected
5670             (gnus-sorted-difference gnus-newsgroup-unreads articles))
5671       (when gnus-alter-articles-to-read-function
5672         (setq articles
5673               (sort
5674                (funcall gnus-alter-articles-to-read-function
5675                         gnus-newsgroup-name articles)
5676                '<)))
5677       articles)))
5678
5679 (defun gnus-killed-articles (killed articles)
5680   (let (out)
5681     (while articles
5682       (when (inline (gnus-member-of-range (car articles) killed))
5683         (push (car articles) out))
5684       (setq articles (cdr articles)))
5685     out))
5686
5687 (defun gnus-uncompress-marks (marks)
5688   "Uncompress the mark ranges in MARKS."
5689   (let ((uncompressed '(score bookmark))
5690         out)
5691     (while marks
5692       (if (memq (caar marks) uncompressed)
5693           (push (car marks) out)
5694         (push (cons (caar marks) (gnus-uncompress-range (cdar marks))) out))
5695       (setq marks (cdr marks)))
5696     out))
5697
5698 (defun gnus-article-mark-to-type (mark)
5699   "Return the type of MARK."
5700   (or (cadr (assq mark gnus-article-special-mark-lists))
5701       'list))
5702
5703 (defun gnus-article-unpropagatable-p (mark)
5704   "Return whether MARK should be propagated to back end."
5705   (memq mark gnus-article-unpropagated-mark-lists))
5706
5707 (defun gnus-adjust-marked-articles (info)
5708   "Set all article lists and remove all marks that are no longer valid."
5709   (let* ((marked-lists (gnus-info-marks info))
5710          (active (gnus-active (gnus-info-group info)))
5711          (min (car active))
5712          (max (cdr active))
5713          (types gnus-article-mark-lists)
5714          marks var articles article mark mark-type
5715          bgn end)
5716
5717     (dolist (marks marked-lists)
5718       (setq mark (car marks)
5719             mark-type (gnus-article-mark-to-type mark)
5720             var (intern (format "gnus-newsgroup-%s" (car (rassq mark types)))))
5721
5722       ;; We set the variable according to the type of the marks list,
5723       ;; and then adjust the marks to a subset of the active articles.
5724       (cond
5725        ;; Adjust "simple" lists - compressed yet unsorted
5726        ((eq mark-type 'list)
5727         ;; Simultaneously uncompress and clip to active range
5728         ;; See gnus-uncompress-range for a description of possible marks
5729         (let (l lh)
5730           (if (not (cadr marks))
5731               (set var nil)
5732             (setq articles (if (numberp (cddr marks))
5733                                (list (cdr marks))
5734                              (cdr marks))
5735                   lh (cons nil nil)
5736                   l lh)
5737
5738             (while (setq article (pop articles))
5739               (cond ((consp article)
5740                      (setq bgn (max (car article) min)
5741                            end (min (cdr article) max))
5742                      (while (<= bgn end)
5743                        (setq l (setcdr l (cons bgn nil))
5744                              bgn (1+ bgn))))
5745                     ((and (<= min article)
5746                           (>= max article))
5747                      (setq l (setcdr l (cons article nil))))))
5748             (set var (cdr lh)))))
5749        ;; Adjust assocs.
5750        ((eq mark-type 'tuple)
5751         (set var (setq articles (cdr marks)))
5752         (when (not (listp (cdr (symbol-value var))))
5753           (set var (list (symbol-value var))))
5754         (when (not (listp (cdr articles)))
5755           (setq articles (list articles)))
5756         (while articles
5757           (when (or (not (consp (setq article (pop articles))))
5758                     (< (car article) min)
5759                     (> (car article) max))
5760             (set var (delq article (symbol-value var))))))
5761        ;; Adjust ranges (sloppily).
5762        ((eq mark-type 'range)
5763         (cond
5764          ((eq mark 'seen)
5765           ;; Fix the record for `seen' if it looks like (seen NUM1 . NUM2).
5766           ;; It should be (seen (NUM1 . NUM2)).
5767           (when (numberp (cddr marks))
5768             (setcdr marks (list (cdr marks))))
5769           (setq articles (cdr marks))
5770           (while (and articles
5771                       (or (and (consp (car articles))
5772                                (> min (cdar articles)))
5773                           (and (numberp (car articles))
5774                                (> min (car articles)))))
5775             (pop articles))
5776           (set var articles))))))))
5777
5778 (defun gnus-update-missing-marks (missing)
5779   "Go through the list of MISSING articles and remove them from the mark lists."
5780   (when missing
5781     (let (var m)
5782       ;; Go through all types.
5783       (dolist (elem gnus-article-mark-lists)
5784         (when (eq (gnus-article-mark-to-type (cdr elem)) 'list)
5785           (setq var (intern (format "gnus-newsgroup-%s" (car elem))))
5786           (when (symbol-value var)
5787             ;; This list has articles.  So we delete all missing
5788             ;; articles from it.
5789             (setq m missing)
5790             (while m
5791               (set var (delq (pop m) (symbol-value var))))))))))
5792
5793 (defun gnus-update-marks ()
5794   "Enter the various lists of marked articles into the newsgroup info list."
5795   (let ((types gnus-article-mark-lists)
5796         (info (gnus-get-info gnus-newsgroup-name))
5797         type list newmarked symbol delta-marks)
5798     (when info
5799       ;; Add all marks lists to the list of marks lists.
5800       (while (setq type (pop types))
5801         (setq list (symbol-value
5802                     (setq symbol
5803                           (intern (format "gnus-newsgroup-%s" (car type))))))
5804
5805         (when list
5806           ;; Get rid of the entries of the articles that have the
5807           ;; default score.
5808           (when (and (eq (cdr type) 'score)
5809                      gnus-save-score
5810                      list)
5811             (let* ((arts list)
5812                    (prev (cons nil list))
5813                    (all prev))
5814               (while arts
5815                 (if (or (not (consp (car arts)))
5816                         (= (cdar arts) gnus-summary-default-score))
5817                     (setcdr prev (cdr arts))
5818                   (setq prev arts))
5819                 (setq arts (cdr arts)))
5820               (setq list (cdr all)))))
5821
5822         (when (eq (cdr type) 'seen)
5823           (setq list (gnus-range-add list gnus-newsgroup-unseen)))
5824
5825         (when (eq (gnus-article-mark-to-type (cdr type)) 'list)
5826           (setq list (gnus-compress-sequence (set symbol (sort list '<)) t)))
5827
5828         (when (and (gnus-check-backend-function
5829                     'request-set-mark gnus-newsgroup-name)
5830                    (not (gnus-article-unpropagatable-p (cdr type))))
5831           (let* ((old (cdr (assq (cdr type) (gnus-info-marks info))))
5832                  (del (gnus-remove-from-range (gnus-copy-sequence old) list))
5833                  (add (gnus-remove-from-range
5834                        (gnus-copy-sequence list) old)))
5835             (when add
5836               (push (list add 'add (list (cdr type))) delta-marks))
5837             (when del
5838               (push (list del 'del (list (cdr type))) delta-marks))))
5839
5840         (when list
5841           (push (cons (cdr type) list) newmarked)))
5842
5843       (when delta-marks
5844         (unless (gnus-check-group gnus-newsgroup-name)
5845           (error "Can't open server for %s" gnus-newsgroup-name))
5846         (gnus-request-set-mark gnus-newsgroup-name delta-marks))
5847
5848       ;; Enter these new marks into the info of the group.
5849       (if (nthcdr 3 info)
5850           (setcar (nthcdr 3 info) newmarked)
5851         ;; Add the marks lists to the end of the info.
5852         (when newmarked
5853           (setcdr (nthcdr 2 info) (list newmarked))))
5854
5855       ;; Cut off the end of the info if there's nothing else there.
5856       (let ((i 5))
5857         (while (and (> i 2)
5858                     (not (nth i info)))
5859           (when (nthcdr (decf i) info)
5860             (setcdr (nthcdr i info) nil)))))))
5861
5862 (defun gnus-set-mode-line (where)
5863   "Set the mode line of the article or summary buffers.
5864 If WHERE is `summary', the summary mode line format will be used."
5865   ;; Is this mode line one we keep updated?
5866   (when (and (memq where gnus-updated-mode-lines)
5867              (symbol-value
5868               (intern (format "gnus-%s-mode-line-format-spec" where))))
5869     (let (mode-string)
5870       (save-excursion
5871         ;; We evaluate this in the summary buffer since these
5872         ;; variables are buffer-local to that buffer.
5873         (set-buffer gnus-summary-buffer)
5874        ;; We bind all these variables that are used in the `eval' form
5875         ;; below.
5876         (let* ((mformat (symbol-value
5877                          (intern
5878                           (format "gnus-%s-mode-line-format-spec" where))))
5879                (gnus-tmp-group-name (gnus-mode-string-quote
5880                                      (gnus-group-decoded-name
5881                                       gnus-newsgroup-name)))
5882                (gnus-tmp-article-number (or gnus-current-article 0))
5883                (gnus-tmp-unread gnus-newsgroup-unreads)
5884                (gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads))
5885                (gnus-tmp-unselected (length gnus-newsgroup-unselected))
5886                (gnus-tmp-unread-and-unselected
5887                 (cond ((and (zerop gnus-tmp-unread-and-unticked)
5888                             (zerop gnus-tmp-unselected))
5889                        "")
5890                       ((zerop gnus-tmp-unselected)
5891                        (format "{%d more}" gnus-tmp-unread-and-unticked))
5892                       (t (format "{%d(+%d) more}"
5893                                  gnus-tmp-unread-and-unticked
5894                                  gnus-tmp-unselected))))
5895                (gnus-tmp-subject
5896                 (if (and gnus-current-headers
5897                          (vectorp gnus-current-headers))
5898                     (gnus-mode-string-quote
5899                      (mail-header-subject gnus-current-headers))
5900                   ""))
5901                bufname-length max-len
5902                gnus-tmp-header) ;; passed as argument to any user-format-funcs
5903           (setq mode-string (eval mformat))
5904           (setq bufname-length (if (string-match "%b" mode-string)
5905                                    (- (length
5906                                        (buffer-name
5907                                         (if (eq where 'summary)
5908                                             nil
5909                                           (get-buffer gnus-article-buffer))))
5910                                       2)
5911                                  0))
5912           (setq max-len (max 4 (if gnus-mode-non-string-length
5913                                    (- (window-width)
5914                                       gnus-mode-non-string-length
5915                                       bufname-length)
5916                                  (length mode-string))))
5917           ;; We might have to chop a bit of the string off...
5918           (when (> (length mode-string) max-len)
5919             (setq mode-string
5920                   (concat (truncate-string-to-width mode-string (- max-len 3))
5921                           "...")))
5922           ;; Pad the mode string a bit.
5923           (setq mode-string (format (format "%%-%ds" max-len) mode-string))))
5924       ;; Update the mode line.
5925       (setq mode-line-buffer-identification
5926             (gnus-mode-line-buffer-identification (list mode-string)))
5927       (set-buffer-modified-p t))))
5928
5929 (defun gnus-create-xref-hashtb (from-newsgroup headers unreads)
5930   "Go through the HEADERS list and add all Xrefs to a hash table.
5931 The resulting hash table is returned, or nil if no Xrefs were found."
5932   (let* ((virtual (gnus-virtual-group-p from-newsgroup))
5933          (prefix (if virtual "" (gnus-group-real-prefix from-newsgroup)))
5934          (xref-hashtb (gnus-make-hashtable))
5935          start group entry number xrefs header)
5936     (while headers
5937       (setq header (pop headers))
5938       (when (and (setq xrefs (mail-header-xref header))
5939                  (not (memq (setq number (mail-header-number header))
5940                             unreads)))
5941         (setq start 0)
5942         (while (string-match "\\([^ ]+\\)[:/]\\([0-9]+\\)" xrefs start)
5943           (setq start (match-end 0))
5944           (setq group (if prefix
5945                           (concat prefix (substring xrefs (match-beginning 1)
5946                                                     (match-end 1)))
5947                         (substring xrefs (match-beginning 1) (match-end 1))))
5948           (setq number
5949                 (string-to-number (substring xrefs (match-beginning 2)
5950                                           (match-end 2))))
5951           (if (setq entry (gnus-gethash group xref-hashtb))
5952               (setcdr entry (cons number (cdr entry)))
5953             (gnus-sethash group (cons number nil) xref-hashtb)))))
5954     (and start xref-hashtb)))
5955
5956 (defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads)
5957   "Look through all the headers and mark the Xrefs as read."
5958   (let ((virtual (gnus-virtual-group-p from-newsgroup))
5959         name info xref-hashtb idlist method nth4)
5960     (save-excursion
5961       (set-buffer gnus-group-buffer)
5962       (when (setq xref-hashtb
5963                   (gnus-create-xref-hashtb from-newsgroup headers unreads))
5964         (mapatoms
5965          (lambda (group)
5966            (unless (string= from-newsgroup (setq name (symbol-name group)))
5967              (setq idlist (symbol-value group))
5968              ;; Dead groups are not updated.
5969              (and (prog1
5970                       (setq info (gnus-get-info name))
5971                     (when (stringp (setq nth4 (gnus-info-method info)))
5972                       (setq nth4 (gnus-server-to-method nth4))))
5973                   ;; Only do the xrefs if the group has the same
5974                   ;; select method as the group we have just read.
5975                   (or (gnus-methods-equal-p
5976                        nth4 (gnus-find-method-for-group from-newsgroup))
5977                       virtual
5978                       (equal nth4 (setq method (gnus-find-method-for-group
5979                                                 from-newsgroup)))
5980                       (and (equal (car nth4) (car method))
5981                            (equal (nth 1 nth4) (nth 1 method))))
5982                   gnus-use-cross-reference
5983                   (or (not (eq gnus-use-cross-reference t))
5984                       virtual
5985                       ;; Only do cross-references on subscribed
5986                       ;; groups, if that is what is wanted.
5987                       (<= (gnus-info-level info) gnus-level-subscribed))
5988                   (gnus-group-make-articles-read name idlist))))
5989          xref-hashtb)))))
5990
5991 (defun gnus-compute-read-articles (group articles)
5992   (let* ((entry (gnus-group-entry group))
5993          (info (nth 2 entry))
5994          (active (gnus-active group))
5995          ninfo)
5996     (when entry
5997       ;; First peel off all invalid article numbers.
5998       (when active
5999         (let ((ids articles)
6000               id first)
6001           (while (setq id (pop ids))
6002             (when (and first (> id (cdr active)))
6003               ;; We'll end up in this situation in one particular
6004               ;; obscure situation.  If you re-scan a group and get
6005               ;; a new article that is cross-posted to a different
6006               ;; group that has not been re-scanned, you might get
6007               ;; crossposted article that has a higher number than
6008               ;; Gnus believes possible.  So we re-activate this
6009               ;; group as well.  This might mean doing the
6010               ;; crossposting thingy will *increase* the number
6011               ;; of articles in some groups.  Tsk, tsk.
6012               (setq active (or (gnus-activate-group group) active)))
6013             (when (or (> id (cdr active))
6014                       (< id (car active)))
6015               (setq articles (delq id articles))))))
6016       ;; If the read list is nil, we init it.
6017       (if (and active
6018                (null (gnus-info-read info))
6019                (> (car active) 1))
6020           (setq ninfo (cons 1 (1- (car active))))
6021         (setq ninfo (gnus-info-read info)))
6022       ;; Then we add the read articles to the range.
6023       (gnus-add-to-range
6024        ninfo (setq articles (sort articles '<))))))
6025
6026 (defun gnus-group-make-articles-read (group articles)
6027   "Update the info of GROUP to say that ARTICLES are read."
6028   (let* ((num 0)
6029          (entry (gnus-group-entry group))
6030          (info (nth 2 entry))
6031          (active (gnus-active group))
6032          range)
6033     (when entry
6034       (setq range (gnus-compute-read-articles group articles))
6035       (with-current-buffer gnus-group-buffer
6036         (gnus-undo-register
6037           `(progn
6038              (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
6039              (gnus-info-set-read ',info ',(gnus-info-read info))
6040              (gnus-get-unread-articles-in-group ',info (gnus-active ,group))
6041              (gnus-request-set-mark ,group (list (list ',range 'del '(read))))
6042              (gnus-group-update-group ,group t))))
6043       ;; Add the read articles to the range.
6044       (gnus-info-set-read info range)
6045       (gnus-request-set-mark group (list (list range 'add '(read))))
6046       ;; Then we have to re-compute how many unread
6047       ;; articles there are in this group.
6048       (when active
6049         (cond
6050          ((not range)
6051           (setq num (- (1+ (cdr active)) (car active))))
6052          ((not (listp (cdr range)))
6053           (setq num (- (cdr active) (- (1+ (cdr range))
6054                                        (car range)))))
6055          (t
6056           (while range
6057             (if (numberp (car range))
6058                 (setq num (1+ num))
6059               (setq num (+ num (- (1+ (cdar range)) (caar range)))))
6060             (setq range (cdr range)))
6061           (setq num (- (cdr active) num))))
6062         ;; Update the number of unread articles.
6063         (setcar entry num)
6064         ;; Update the group buffer.
6065         (unless (gnus-ephemeral-group-p group)
6066           (gnus-group-update-group group t))))))
6067
6068 (defvar gnus-newsgroup-none-id 0)
6069
6070 (defun gnus-get-newsgroup-headers (&optional dependencies force-new)
6071   (let ((cur nntp-server-buffer)
6072         (dependencies
6073          (or dependencies
6074              (with-current-buffer gnus-summary-buffer
6075                gnus-newsgroup-dependencies)))
6076         headers id end ref number
6077         (mail-parse-charset gnus-newsgroup-charset)
6078         (mail-parse-ignored-charsets
6079          (save-excursion (condition-case nil
6080                              (set-buffer gnus-summary-buffer)
6081                            (error))
6082                          gnus-newsgroup-ignored-charsets)))
6083     (save-excursion
6084       (set-buffer nntp-server-buffer)
6085       ;; Translate all TAB characters into SPACE characters.
6086       (subst-char-in-region (point-min) (point-max) ?\t ?  t)
6087       (subst-char-in-region (point-min) (point-max) ?\r ?  t)
6088       (ietf-drums-unfold-fws)
6089       (gnus-run-hooks 'gnus-parse-headers-hook)
6090       (let ((case-fold-search t)
6091             in-reply-to header p lines chars)
6092         (goto-char (point-min))
6093         ;; Search to the beginning of the next header.  Error messages
6094         ;; do not begin with 2 or 3.
6095         (while (re-search-forward "^[23][0-9]+ " nil t)
6096           (setq id nil
6097                 ref nil)
6098           ;; This implementation of this function, with nine
6099           ;; search-forwards instead of the one re-search-forward and
6100           ;; a case (which basically was the old function) is actually
6101           ;; about twice as fast, even though it looks messier.  You
6102           ;; can't have everything, I guess.  Speed and elegance
6103           ;; doesn't always go hand in hand.
6104           (setq
6105            header
6106            (vector
6107             ;; Number.
6108             (prog1
6109                 (setq number (read cur))
6110               (end-of-line)
6111               (setq p (point))
6112               (narrow-to-region (point)
6113                                 (or (and (search-forward "\n.\n" nil t)
6114                                          (- (point) 2))
6115                                     (point))))
6116             ;; Subject.
6117             (progn
6118               (goto-char p)
6119               (if (search-forward "\nsubject:" nil t)
6120                   (funcall gnus-decode-encoded-word-function
6121                            (nnheader-header-value))
6122                 "(none)"))
6123             ;; From.
6124             (progn
6125               (goto-char p)
6126               (if (search-forward "\nfrom:" nil t)
6127                   (funcall gnus-decode-encoded-address-function
6128                            (nnheader-header-value))
6129                 "(nobody)"))
6130             ;; Date.
6131             (progn
6132               (goto-char p)
6133               (if (search-forward "\ndate:" nil t)
6134                   (nnheader-header-value) ""))
6135             ;; Message-ID.
6136             (progn
6137               (goto-char p)
6138               (setq id (if (re-search-forward
6139                             "^message-id: *\\(<[^\n\t> ]+>\\)" nil t)
6140                            ;; We do it this way to make sure the Message-ID
6141                            ;; is (somewhat) syntactically valid.
6142                            (buffer-substring (match-beginning 1)
6143                                              (match-end 1))
6144                          ;; If there was no message-id, we just fake one
6145                          ;; to make subsequent routines simpler.
6146                          (nnheader-generate-fake-message-id number))))
6147             ;; References.
6148             (progn
6149               (goto-char p)
6150               (if (search-forward "\nreferences:" nil t)
6151                   (progn
6152                     (setq end (point))
6153                     (prog1
6154                         (nnheader-header-value)
6155                       (setq ref
6156                             (buffer-substring
6157                              (progn
6158                                (end-of-line)
6159                                (search-backward ">" end t)
6160                                (1+ (point)))
6161                              (progn
6162                                (search-backward "<" end t)
6163                                (point))))))
6164                 ;; Get the references from the in-reply-to header if there
6165                 ;; were no references and the in-reply-to header looks
6166                 ;; promising.
6167                 (if (and (search-forward "\nin-reply-to:" nil t)
6168                          (setq in-reply-to (nnheader-header-value))
6169                          (string-match "<[^>]+>" in-reply-to))
6170                     (let (ref2)
6171                       (setq ref (substring in-reply-to (match-beginning 0)
6172                                            (match-end 0)))
6173                       (while (string-match "<[^>]+>" in-reply-to (match-end 0))
6174                         (setq ref2 (substring in-reply-to (match-beginning 0)
6175                                               (match-end 0)))
6176                         (when (> (length ref2) (length ref))
6177                           (setq ref ref2)))
6178                       ref)
6179                   (setq ref nil))))
6180             ;; Chars.
6181             (progn
6182               (goto-char p)
6183               (if (search-forward "\nchars: " nil t)
6184                   (if (numberp (setq chars (ignore-errors (read cur))))
6185                       chars -1)
6186                 -1))
6187             ;; Lines.
6188             (progn
6189               (goto-char p)
6190               (if (search-forward "\nlines: " nil t)
6191                   (if (numberp (setq lines (ignore-errors (read cur))))
6192                       lines -1)
6193                 -1))
6194             ;; Xref.
6195             (progn
6196               (goto-char p)
6197               (and (search-forward "\nxref:" nil t)
6198                    (nnheader-header-value)))
6199             ;; Extra.
6200             (when gnus-extra-headers
6201               (let ((extra gnus-extra-headers)
6202                     out)
6203                 (while extra
6204                   (goto-char p)
6205                   (when (search-forward
6206                          (concat "\n" (symbol-name (car extra)) ":") nil t)
6207                     (push (cons (car extra) (nnheader-header-value))
6208                           out))
6209                   (pop extra))
6210                 out))))
6211           (when (equal id ref)
6212             (setq ref nil))
6213
6214           (when gnus-alter-header-function
6215             (funcall gnus-alter-header-function header)
6216             (setq id (mail-header-id header)
6217                   ref (gnus-parent-id (mail-header-references header))))
6218
6219           (when (setq header
6220                       (gnus-dependencies-add-header
6221                        header dependencies force-new))
6222             (push header headers))
6223           (goto-char (point-max))
6224           (widen))
6225         (nreverse headers)))))
6226
6227 ;; Goes through the xover lines and returns a list of vectors
6228 (defun gnus-get-newsgroup-headers-xover (sequence &optional
6229                                                   force-new dependencies
6230                                                   group also-fetch-heads)
6231   "Parse the news overview data in the server buffer.
6232 Return a list of headers that match SEQUENCE (see
6233 `nntp-retrieve-headers')."
6234   ;; Get the Xref when the users reads the articles since most/some
6235   ;; NNTP servers do not include Xrefs when using XOVER.
6236   (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
6237   (let ((mail-parse-charset gnus-newsgroup-charset)
6238         (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)
6239         (cur nntp-server-buffer)
6240         (dependencies (or dependencies gnus-newsgroup-dependencies))
6241         (allp (cond
6242                ((eq gnus-read-all-available-headers t)
6243                 t)
6244                ((and (stringp gnus-read-all-available-headers)
6245                      group)
6246                 (string-match gnus-read-all-available-headers group))
6247                (t
6248                 nil)))
6249         number headers header)
6250     (save-excursion
6251       (set-buffer nntp-server-buffer)
6252       (subst-char-in-region (point-min) (point-max) ?\r ?  t)
6253       ;; Allow the user to mangle the headers before parsing them.
6254       (gnus-run-hooks 'gnus-parse-headers-hook)
6255       (goto-char (point-min))
6256       (gnus-parse-without-error
6257         (while (and (or sequence allp)
6258                     (not (eobp)))
6259           (setq number (read cur))
6260           (when (not allp)
6261             (while (and sequence
6262                         (< (car sequence) number))
6263               (setq sequence (cdr sequence))))
6264           (when (and (or allp
6265                          (and sequence
6266                               (eq number (car sequence))))
6267                      (progn
6268                        (setq sequence (cdr sequence))
6269                        (setq header (inline
6270                                       (gnus-nov-parse-line
6271                                        number dependencies force-new)))))
6272             (push header headers))
6273           (forward-line 1)))
6274       ;; A common bug in inn is that if you have posted an article and
6275       ;; then retrieves the active file, it will answer correctly --
6276       ;; the new article is included.  However, a NOV entry for the
6277       ;; article may not have been generated yet, so this may fail.
6278       ;; We work around this problem by retrieving the last few
6279       ;; headers using HEAD.
6280       (if (or (not also-fetch-heads)
6281               (not sequence))
6282           ;; We (probably) got all the headers.
6283           (nreverse headers)
6284         (let ((gnus-nov-is-evil t))
6285           (nconc
6286            (nreverse headers)
6287            (when (eq (gnus-retrieve-headers sequence group) 'headers)
6288              (gnus-get-newsgroup-headers))))))))
6289
6290 (defun gnus-article-get-xrefs ()
6291   "Fill in the Xref value in `gnus-current-headers', if necessary.
6292 This is meant to be called in `gnus-article-internal-prepare-hook'."
6293   (let ((headers (with-current-buffer gnus-summary-buffer
6294                    gnus-current-headers)))
6295     (or (not gnus-use-cross-reference)
6296         (not headers)
6297         (and (mail-header-xref headers)
6298              (not (string= (mail-header-xref headers) "")))
6299         (let ((case-fold-search t)
6300               xref)
6301           (save-restriction
6302             (nnheader-narrow-to-headers)
6303             (goto-char (point-min))
6304             (when (or (and (not (eobp))
6305                            (eq (downcase (char-after)) ?x)
6306                            (looking-at "Xref:"))
6307                       (search-forward "\nXref:" nil t))
6308               (goto-char (1+ (match-end 0)))
6309               (setq xref (buffer-substring (point) (point-at-eol)))
6310               (mail-header-set-xref headers xref)))))))
6311
6312 (defun gnus-summary-insert-subject (id &optional old-header use-old-header)
6313   "Find article ID and insert the summary line for that article.
6314 OLD-HEADER can either be a header or a line number to insert
6315 the subject line on."
6316   (let* ((line (and (numberp old-header) old-header))
6317          (old-header (and (vectorp old-header) old-header))
6318          (header (cond ((and old-header use-old-header)
6319                         old-header)
6320                        ((and (numberp id)
6321                              (gnus-number-to-header id))
6322                         (gnus-number-to-header id))
6323                        (t
6324                         (gnus-read-header id))))
6325          (number (and (numberp id) id))
6326          d)
6327     (when header
6328       ;; Rebuild the thread that this article is part of and go to the
6329       ;; article we have fetched.
6330       (when (and (not gnus-show-threads)
6331                  old-header)
6332         (when (and number
6333                    (setq d (gnus-data-find (mail-header-number old-header))))
6334           (goto-char (gnus-data-pos d))
6335           (gnus-data-remove
6336            number
6337            (- (point-at-bol)
6338               (prog1
6339                   (1+ (point-at-eol))
6340                 (gnus-delete-line))))))
6341       ;; Remove list identifiers from subject.
6342       (when gnus-list-identifiers
6343         (let ((gnus-newsgroup-headers (list header)))
6344           (gnus-summary-remove-list-identifiers)))
6345       (when old-header
6346         (mail-header-set-number header (mail-header-number old-header)))
6347       (setq gnus-newsgroup-sparse
6348             (delq (setq number (mail-header-number header))
6349                   gnus-newsgroup-sparse))
6350       (setq gnus-newsgroup-ancient (delq number gnus-newsgroup-ancient))
6351       (push number gnus-newsgroup-limit)
6352       (gnus-rebuild-thread (mail-header-id header) line)
6353       (gnus-summary-goto-subject number nil t))
6354     (when (and (numberp number)
6355                (> number 0))
6356       ;; We have to update the boundaries even if we can't fetch the
6357       ;; article if ID is a number -- so that the next `P' or `N'
6358       ;; command will fetch the previous (or next) article even
6359       ;; if the one we tried to fetch this time has been canceled.
6360       (when (> number gnus-newsgroup-end)
6361         (setq gnus-newsgroup-end number))
6362       (when (< number gnus-newsgroup-begin)
6363         (setq gnus-newsgroup-begin number))
6364       (setq gnus-newsgroup-unselected
6365             (delq number gnus-newsgroup-unselected)))
6366     ;; Report back a success?
6367     (and header (mail-header-number header))))
6368
6369 ;;; Process/prefix in the summary buffer
6370
6371 (defun gnus-summary-work-articles (n)
6372   "Return a list of articles to be worked upon.
6373 The prefix argument, the list of process marked articles, and the
6374 current article will be taken into consideration."
6375   (save-excursion
6376     (set-buffer gnus-summary-buffer)
6377     (cond
6378      (n
6379       ;; A numerical prefix has been given.
6380       (setq n (prefix-numeric-value n))
6381       (let ((backward (< n 0))
6382             (n (abs (prefix-numeric-value n)))
6383             articles article)
6384         (save-excursion
6385           (while
6386               (and (> n 0)
6387                    (push (setq article (gnus-summary-article-number))
6388                          articles)
6389                    (if backward
6390                        (gnus-summary-find-prev nil article)
6391                      (gnus-summary-find-next nil article)))
6392             (decf n)))
6393         (nreverse articles)))
6394      ((and (gnus-region-active-p) (mark))
6395       (message "region active")
6396       ;; Work on the region between point and mark.
6397       (let ((max (max (point) (mark)))
6398             articles article)
6399         (save-excursion
6400           (goto-char (min (point) (mark)))
6401           (while
6402               (and
6403                (push (setq article (gnus-summary-article-number)) articles)
6404                (gnus-summary-find-next nil article)
6405                (< (point) max)))
6406           (nreverse articles))))
6407      (gnus-newsgroup-processable
6408       ;; There are process-marked articles present.
6409       ;; Save current state.
6410       (gnus-summary-save-process-mark)
6411       ;; Return the list.
6412       (reverse gnus-newsgroup-processable))
6413      (t
6414       ;; Just return the current article.
6415       (list (gnus-summary-article-number))))))
6416
6417 (defmacro gnus-summary-iterate (arg &rest forms)
6418   "Iterate over the process/prefixed articles and do FORMS.
6419 ARG is the interactive prefix given to the command.  FORMS will be
6420 executed with point over the summary line of the articles."
6421   (let ((articles (make-symbol "gnus-summary-iterate-articles")))
6422     `(let ((,articles (gnus-summary-work-articles ,arg)))
6423        (while ,articles
6424          (gnus-summary-goto-subject (car ,articles))
6425          ,@forms
6426          (pop ,articles)))))
6427
6428 (put 'gnus-summary-iterate 'lisp-indent-function 1)
6429 (put 'gnus-summary-iterate 'edebug-form-spec '(form body))
6430
6431 (defun gnus-summary-save-process-mark ()
6432   "Push the current set of process marked articles on the stack."
6433   (interactive)
6434   (push (copy-sequence gnus-newsgroup-processable)
6435         gnus-newsgroup-process-stack))
6436
6437 (defun gnus-summary-kill-process-mark ()
6438   "Push the current set of process marked articles on the stack and unmark."
6439   (interactive)
6440   (gnus-summary-save-process-mark)
6441   (gnus-summary-unmark-all-processable))
6442
6443 (defun gnus-summary-yank-process-mark ()
6444   "Pop the last process mark state off the stack and restore it."
6445   (interactive)
6446   (unless gnus-newsgroup-process-stack
6447     (error "Empty mark stack"))
6448   (gnus-summary-process-mark-set (pop gnus-newsgroup-process-stack)))
6449
6450 (defun gnus-summary-process-mark-set (set)
6451   "Make SET into the current process marked articles."
6452   (gnus-summary-unmark-all-processable)
6453   (mapc 'gnus-summary-set-process-mark set))
6454
6455 ;;; Searching and stuff
6456
6457 (defun gnus-summary-search-group (&optional backward use-level)
6458   "Search for next unread newsgroup.
6459 If optional argument BACKWARD is non-nil, search backward instead."
6460   (save-excursion
6461     (set-buffer gnus-group-buffer)
6462     (when (gnus-group-search-forward
6463            backward nil (if use-level (gnus-group-group-level) nil))
6464       (gnus-group-group-name))))
6465
6466 (defun gnus-summary-best-group (&optional exclude-group)
6467   "Find the name of the best unread group.
6468 If EXCLUDE-GROUP, do not go to this group."
6469   (with-current-buffer gnus-group-buffer
6470     (save-excursion
6471       (gnus-group-best-unread-group exclude-group))))
6472
6473 (defun gnus-summary-find-next (&optional unread article backward)
6474   (if backward
6475       (gnus-summary-find-prev unread article)
6476     (let* ((dummy (gnus-summary-article-intangible-p))
6477            (article (or article (gnus-summary-article-number)))
6478            (data (gnus-data-find-list article))
6479            result)
6480       (when (and (not dummy)
6481                  (or (not gnus-summary-check-current)
6482                      (not unread)
6483                      (not (gnus-data-unread-p (car data)))))
6484         (setq data (cdr data)))
6485       (when (setq result
6486                   (if unread
6487                       (progn
6488                         (while data
6489                           (unless (memq (gnus-data-number (car data))
6490                                         (cond
6491                                          ((eq gnus-auto-goto-ignores
6492                                               'always-undownloaded)
6493                                           gnus-newsgroup-undownloaded)
6494                                          (gnus-plugged
6495                                           nil)
6496                                          ((eq gnus-auto-goto-ignores
6497                                               'unfetched)
6498                                           gnus-newsgroup-unfetched)
6499                                          ((eq gnus-auto-goto-ignores
6500                                               'undownloaded)
6501                                           gnus-newsgroup-undownloaded)))
6502                             (when (gnus-data-unread-p (car data))
6503                               (setq result (car data)
6504                                     data nil)))
6505                           (setq data (cdr data)))
6506                         result)
6507                     (car data)))
6508         (goto-char (gnus-data-pos result))
6509         (gnus-data-number result)))))
6510
6511 (defun gnus-summary-find-prev (&optional unread article)
6512   (let* ((eobp (eobp))
6513          (article (or article (gnus-summary-article-number)))
6514          (data (gnus-data-find-list article (gnus-data-list 'rev)))
6515          result)
6516     (when (and (not eobp)
6517                (or (not gnus-summary-check-current)
6518                    (not unread)
6519                    (not (gnus-data-unread-p (car data)))))
6520       (setq data (cdr data)))
6521     (when (setq result
6522                 (if unread
6523                     (progn
6524                       (while data
6525                         (unless (memq (gnus-data-number (car data))
6526                                       (cond
6527                                        ((eq gnus-auto-goto-ignores
6528                                             'always-undownloaded)
6529                                         gnus-newsgroup-undownloaded)
6530                                        (gnus-plugged
6531                                         nil)
6532                                        ((eq gnus-auto-goto-ignores
6533                                             'unfetched)
6534                                         gnus-newsgroup-unfetched)
6535                                        ((eq gnus-auto-goto-ignores
6536                                             'undownloaded)
6537                                         gnus-newsgroup-undownloaded)))
6538                           (when (gnus-data-unread-p (car data))
6539                             (setq result (car data)
6540                                   data nil)))
6541                         (setq data (cdr data)))
6542                       result)
6543                   (car data)))
6544       (goto-char (gnus-data-pos result))
6545       (gnus-data-number result))))
6546
6547 (defun gnus-summary-find-subject (subject &optional unread backward article)
6548   (let* ((simp-subject (gnus-simplify-subject-fully subject))
6549          (article (or article (gnus-summary-article-number)))
6550          (articles (gnus-data-list backward))
6551          (arts (gnus-data-find-list article articles))
6552          result)
6553     (when (or (not gnus-summary-check-current)
6554               (not unread)
6555               (not (gnus-data-unread-p (car arts))))
6556       (setq arts (cdr arts)))
6557     (while arts
6558       (and (or (not unread)
6559                (gnus-data-unread-p (car arts)))
6560            (vectorp (gnus-data-header (car arts)))
6561            (gnus-subject-equal
6562             simp-subject (mail-header-subject (gnus-data-header (car arts))) t)
6563            (setq result (car arts)
6564                  arts nil))
6565       (setq arts (cdr arts)))
6566     (and result
6567          (goto-char (gnus-data-pos result))
6568          (gnus-data-number result))))
6569
6570 (defun gnus-summary-search-forward (&optional unread subject backward)
6571   "Search forward for an article.
6572 If UNREAD, look for unread articles.  If SUBJECT, look for
6573 articles with that subject.  If BACKWARD, search backward instead."
6574   (cond (subject (gnus-summary-find-subject subject unread backward))
6575         (backward (gnus-summary-find-prev unread))
6576         (t (gnus-summary-find-next unread))))
6577
6578 (defun gnus-recenter (&optional n)
6579   "Center point in window and redisplay frame.
6580 Also do horizontal recentering."
6581   (interactive "P")
6582   (when (and gnus-auto-center-summary
6583              (not (eq gnus-auto-center-summary 'vertical)))
6584     (gnus-horizontal-recenter))
6585   (recenter n))
6586
6587 (defun gnus-summary-recenter ()
6588   "Center point in the summary window.
6589 If `gnus-auto-center-summary' is nil, or the article buffer isn't
6590 displayed, no centering will be performed."
6591   ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
6592   ;; Recenter only when requested.  Suggested by popovich@park.cs.columbia.edu.
6593   (interactive)
6594   ;; The user has to want it.
6595   (when gnus-auto-center-summary
6596     (let* ((top (cond ((< (window-height) 4) 0)
6597                       ((< (window-height) 7) 1)
6598                       (t (if (numberp gnus-auto-center-summary)
6599                              gnus-auto-center-summary
6600                            (/ (1- (window-height)) 2)))))
6601            (height (1- (window-height)))
6602            (bottom (save-excursion (goto-char (point-max))
6603                                    (forward-line (- height))
6604                                    (point)))
6605            (window (get-buffer-window (current-buffer))))
6606       (when (get-buffer-window gnus-article-buffer)
6607         ;; Only do recentering when the article buffer is displayed,
6608         ;; Set the window start to either `bottom', which is the biggest
6609         ;; possible valid number, or the second line from the top,
6610         ;; whichever is the least.
6611         (let ((top-pos (save-excursion (forward-line (- top)) (point))))
6612           (if (> bottom top-pos)
6613               ;; Keep the second line from the top visible
6614               (set-window-start window top-pos)
6615             ;; Try to keep the bottom line visible; if it's partially
6616             ;; obscured, either scroll one more line to make it fully
6617             ;; visible, or revert to using TOP-POS.
6618             (save-excursion
6619               (goto-char (point-max))
6620               (forward-line -1)
6621               (let ((last-line-start (point)))
6622                 (goto-char bottom)
6623                 (set-window-start window (point) t)
6624                 (when (not (pos-visible-in-window-p last-line-start window))
6625                   (forward-line 1)
6626                   (set-window-start window (min (point) top-pos) t)))))))
6627       ;; Do horizontal recentering while we're at it.
6628       (when (and (get-buffer-window (current-buffer) t)
6629                  (not (eq gnus-auto-center-summary 'vertical)))
6630         (let ((selected (selected-window)))
6631           (select-window (get-buffer-window (current-buffer) t))
6632           (gnus-summary-position-point)
6633           (gnus-horizontal-recenter)
6634           (select-window selected))))))
6635
6636 (defun gnus-summary-jump-to-group (newsgroup)
6637   "Move point to NEWSGROUP in group mode buffer."
6638   ;; Keep update point of group mode buffer if visible.
6639   (if (eq (current-buffer) (get-buffer gnus-group-buffer))
6640       (save-window-excursion
6641         ;; Take care of tree window mode.
6642         (when (get-buffer-window gnus-group-buffer)
6643           (pop-to-buffer gnus-group-buffer))
6644         (gnus-group-jump-to-group newsgroup))
6645     (save-excursion
6646       ;; Take care of tree window mode.
6647       (if (get-buffer-window gnus-group-buffer)
6648           (pop-to-buffer gnus-group-buffer)
6649         (set-buffer gnus-group-buffer))
6650       (gnus-group-jump-to-group newsgroup))))
6651
6652 ;; This function returns a list of article numbers based on the
6653 ;; difference between the ranges of read articles in this group and
6654 ;; the range of active articles.
6655 (defun gnus-list-of-unread-articles (group)
6656   (let* ((read (gnus-info-read (gnus-get-info group)))
6657          (active (or (gnus-active group) (gnus-activate-group group)))
6658          (last (or (cdr active)
6659                    (error "Group %s couldn't be activated " group)))
6660          first nlast unread)
6661     ;; If none are read, then all are unread.
6662     (if (not read)
6663         (setq first (car active))
6664       ;; If the range of read articles is a single range, then the
6665       ;; first unread article is the article after the last read
6666       ;; article.  Sounds logical, doesn't it?
6667       (if (and (not (listp (cdr read)))
6668                (or (< (car read) (car active))
6669                    (progn (setq read (list read))
6670                           nil)))
6671           (setq first (max (car active) (1+ (cdr read))))
6672         ;; `read' is a list of ranges.
6673         (when (/= (setq nlast (or (and (numberp (car read)) (car read))
6674                                   (caar read)))
6675                   1)
6676           (setq first (car active)))
6677         (while read
6678           (when first
6679             (while (< first nlast)
6680               (setq unread (cons first unread)
6681                     first (1+ first))))
6682           (setq first (1+ (if (atom (car read)) (car read) (cdar read))))
6683           (setq nlast (if (atom (cadr read)) (cadr read) (caadr read)))
6684           (setq read (cdr read)))))
6685     ;; And add the last unread articles.
6686     (while (<= first last)
6687       (setq unread (cons first unread)
6688             first (1+ first)))
6689     ;; Return the list of unread articles.
6690     (delq 0 (nreverse unread))))
6691
6692 (defun gnus-list-of-read-articles (group)
6693   "Return a list of unread, unticked and non-dormant articles."
6694   (let* ((info (gnus-get-info group))
6695          (marked (gnus-info-marks info))
6696          (active (gnus-active group)))
6697     (and info active
6698          (gnus-list-range-difference
6699           (gnus-list-range-difference
6700            (gnus-sorted-complement
6701             (gnus-uncompress-range active)
6702             (gnus-list-of-unread-articles group))
6703            (cdr (assq 'dormant marked)))
6704           (cdr (assq 'tick marked))))))
6705
6706 ;; This function returns a sequence of article numbers based on the
6707 ;; difference between the ranges of read articles in this group and
6708 ;; the range of active articles.
6709 (defun gnus-sequence-of-unread-articles (group)
6710   (let* ((read (gnus-info-read (gnus-get-info group)))
6711          (active (or (gnus-active group) (gnus-activate-group group)))
6712          (last (cdr active))
6713          first nlast unread)
6714     ;; If none are read, then all are unread.
6715     (if (not read)
6716         (setq first (car active))
6717       ;; If the range of read articles is a single range, then the
6718       ;; first unread article is the article after the last read
6719       ;; article.  Sounds logical, doesn't it?
6720       (if (and (not (listp (cdr read)))
6721                (or (< (car read) (car active))
6722                    (progn (setq read (list read))
6723                           nil)))
6724           (setq first (max (car active) (1+ (cdr read))))
6725         ;; `read' is a list of ranges.
6726         (when (/= (setq nlast (or (and (numberp (car read)) (car read))
6727                                   (caar read)))
6728                   1)
6729           (setq first (car active)))
6730         (while read
6731           (when first
6732             (push (cons first nlast) unread))
6733           (setq first (1+ (if (atom (car read)) (car read) (cdar read))))
6734           (setq nlast (if (atom (cadr read)) (cadr read) (caadr read)))
6735           (setq read (cdr read)))))
6736     ;; And add the last unread articles.
6737     (cond ((not (and first last))
6738            nil)
6739           ((< first last)
6740            (push (cons first last) unread))
6741           ((= first last)
6742            (push first unread)))
6743     ;; Return the sequence of unread articles.
6744     (delq 0 (nreverse unread))))
6745
6746 ;; Various summary commands
6747
6748 (defun gnus-summary-select-article-buffer ()
6749   "Reconfigure windows to show article buffer."
6750   (interactive)
6751   (if (not (gnus-buffer-live-p gnus-article-buffer))
6752       (error "There is no article buffer for this summary buffer")
6753     (gnus-configure-windows 'article)
6754     (select-window (get-buffer-window gnus-article-buffer))))
6755
6756 (defun gnus-summary-universal-argument (arg)
6757   "Perform any operation on all articles that are process/prefixed."
6758   (interactive "P")
6759   (let ((articles (gnus-summary-work-articles arg))
6760         func article)
6761     (if (eq
6762          (setq
6763           func
6764           (key-binding
6765            (read-key-sequence
6766             (substitute-command-keys
6767              "\\<gnus-summary-mode-map>\\[gnus-summary-universal-argument]"))))
6768          'undefined)
6769         (gnus-error 1 "Undefined key")
6770       (save-excursion
6771         (while articles
6772           (gnus-summary-goto-subject (setq article (pop articles)))
6773           (let (gnus-newsgroup-processable)
6774             (command-execute func))
6775           (gnus-summary-remove-process-mark article)))))
6776   (gnus-summary-position-point))
6777
6778 (defun gnus-summary-toggle-truncation (&optional arg)
6779   "Toggle truncation of summary lines.
6780 With ARG, turn line truncation on if ARG is positive."
6781   (interactive "P")
6782   (setq truncate-lines
6783         (if (null arg) (not truncate-lines)
6784           (> (prefix-numeric-value arg) 0)))
6785   (redraw-display))
6786
6787 (defun gnus-summary-find-for-reselect ()
6788   "Return the number of an article to stay on across a reselect.
6789 The current article is considered, then following articles, then previous
6790 articles.  An article is sought which is not cancelled and isn't a temporary
6791 insertion from another group.  If there's no such then return a dummy 0."
6792   (let (found)
6793     (dolist (rev '(nil t))
6794       (unless found      ; don't demand the reverse list if we don't need it
6795         (let ((data (gnus-data-find-list
6796                      (gnus-summary-article-number) (gnus-data-list rev))))
6797           (while (and data (not found))
6798             (if (and (< 0 (gnus-data-number (car data)))
6799                      (not (eq gnus-canceled-mark (gnus-data-mark (car data)))))
6800                 (setq found (gnus-data-number (car data))))
6801             (setq data (cdr data))))))
6802     (or found 0)))
6803
6804 (defun gnus-summary-reselect-current-group (&optional all rescan)
6805   "Exit and then reselect the current newsgroup.
6806 The prefix argument ALL means to select all articles."
6807   (interactive "P")
6808   (when (gnus-ephemeral-group-p gnus-newsgroup-name)
6809     (error "Ephemeral groups can't be reselected"))
6810   (let ((current-subject (gnus-summary-find-for-reselect))
6811         (group gnus-newsgroup-name))
6812     (setq gnus-newsgroup-begin nil)
6813     (gnus-summary-exit nil 'leave-hidden)
6814     ;; We have to adjust the point of group mode buffer because
6815     ;; point was moved to the next unread newsgroup by exiting.
6816     (gnus-summary-jump-to-group group)
6817     (when rescan
6818       (save-excursion
6819         (gnus-group-get-new-news-this-group 1)))
6820     (gnus-group-read-group all t)
6821     (gnus-summary-goto-subject current-subject nil t)))
6822
6823 (defun gnus-summary-rescan-group (&optional all)
6824   "Exit the newsgroup, ask for new articles, and select the newsgroup."
6825   (interactive "P")
6826   (gnus-summary-reselect-current-group all t))
6827
6828 (defun gnus-summary-update-info (&optional non-destructive)
6829   (save-excursion
6830     (let ((group gnus-newsgroup-name))
6831       (when group
6832         (when gnus-newsgroup-kill-headers
6833           (setq gnus-newsgroup-killed
6834                 (gnus-compress-sequence
6835                  (gnus-sorted-union
6836                   (gnus-list-range-intersection
6837                    gnus-newsgroup-unselected gnus-newsgroup-killed)
6838                   gnus-newsgroup-unreads)
6839                  t)))
6840         (unless (listp (cdr gnus-newsgroup-killed))
6841           (setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
6842         (let ((headers gnus-newsgroup-headers))
6843           ;; Set the new ranges of read articles.
6844           (with-current-buffer gnus-group-buffer
6845             (gnus-undo-force-boundary))
6846           (gnus-update-read-articles
6847            group (gnus-sorted-union
6848                   gnus-newsgroup-unreads gnus-newsgroup-unselected))
6849           ;; Set the current article marks.
6850           (let ((gnus-newsgroup-scored
6851                  (if (and (not gnus-save-score)
6852                           (not non-destructive))
6853                      nil
6854                    gnus-newsgroup-scored)))
6855             (save-excursion
6856               (gnus-update-marks)))
6857           ;; Do the cross-ref thing.
6858           (when gnus-use-cross-reference
6859             (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads))
6860           ;; Do not switch windows but change the buffer to work.
6861           (set-buffer gnus-group-buffer)
6862           (unless (gnus-ephemeral-group-p group)
6863             (gnus-group-update-group group)))))))
6864
6865 (defun gnus-summary-save-newsrc (&optional force)
6866   "Save the current number of read/marked articles in the dribble buffer.
6867 The dribble buffer will then be saved.
6868 If FORCE (the prefix), also save the .newsrc file(s)."
6869   (interactive "P")
6870   (gnus-summary-update-info t)
6871   (if force
6872       (gnus-save-newsrc-file)
6873     (gnus-dribble-save)))
6874
6875 (defun gnus-summary-exit (&optional temporary leave-hidden)
6876   "Exit reading current newsgroup, and then return to group selection mode.
6877 `gnus-exit-group-hook' is called with no arguments if that value is non-nil."
6878   (interactive)
6879   (gnus-set-global-variables)
6880   (when (gnus-buffer-live-p gnus-article-buffer)
6881     (save-excursion
6882       (set-buffer gnus-article-buffer)
6883       (mm-destroy-parts gnus-article-mime-handles)
6884       ;; Set it to nil for safety reason.
6885       (setq gnus-article-mime-handle-alist nil)
6886       (setq gnus-article-mime-handles nil)))
6887   (gnus-kill-save-kill-buffer)
6888   (gnus-async-halt-prefetch)
6889   (let* ((group gnus-newsgroup-name)
6890          (quit-config (gnus-group-quit-config gnus-newsgroup-name))
6891          (gnus-group-is-exiting-p t)
6892          (mode major-mode)
6893          (group-point nil)
6894          (buf (current-buffer)))
6895     (unless quit-config
6896       ;; Do adaptive scoring, and possibly save score files.
6897       (when gnus-newsgroup-adaptive
6898         (gnus-score-adaptive))
6899       (when gnus-use-scoring
6900         (gnus-score-save)))
6901     (gnus-run-hooks 'gnus-summary-prepare-exit-hook)
6902     ;; If we have several article buffers, we kill them at exit.
6903     (unless gnus-single-article-buffer
6904       (gnus-kill-buffer gnus-article-buffer)
6905       (gnus-kill-buffer gnus-original-article-buffer)
6906       (setq gnus-article-current nil))
6907     (when gnus-use-cache
6908       (gnus-cache-possibly-remove-articles)
6909       (gnus-cache-save-buffers))
6910     (gnus-async-prefetch-remove-group group)
6911     (when gnus-suppress-duplicates
6912       (gnus-dup-enter-articles))
6913     (when gnus-use-trees
6914       (gnus-tree-close group))
6915     (when gnus-use-cache
6916       (gnus-cache-write-active))
6917     ;; Remove entries for this group.
6918     (nnmail-purge-split-history (gnus-group-real-name group))
6919     ;; Make all changes in this group permanent.
6920     (unless quit-config
6921       (gnus-run-hooks 'gnus-exit-group-hook)
6922       (gnus-summary-update-info))
6923     (gnus-close-group group)
6924     ;; Make sure where we were, and go to next newsgroup.
6925     (set-buffer gnus-group-buffer)
6926     (unless quit-config
6927       (gnus-group-jump-to-group group))
6928     (gnus-run-hooks 'gnus-summary-exit-hook)
6929     (unless (or quit-config
6930                 ;; If this group has disappeared from the summary
6931                 ;; buffer, don't skip forwards.
6932                 (not (string= group (gnus-group-group-name))))
6933       (gnus-group-next-unread-group 1))
6934     (setq group-point (point))
6935     (if temporary
6936         nil                             ;Nothing to do.
6937       ;; If we have several article buffers, we kill them at exit.
6938       (unless gnus-single-article-buffer
6939         (gnus-kill-buffer gnus-article-buffer)
6940         (gnus-kill-buffer gnus-original-article-buffer)
6941         (setq gnus-article-current nil))
6942       (set-buffer buf)
6943       (if (not gnus-kill-summary-on-exit)
6944           (progn
6945             (gnus-deaden-summary)
6946             (setq mode nil))
6947         ;; We set all buffer-local variables to nil.  It is unclear why
6948         ;; this is needed, but if we don't, buffer-local variables are
6949         ;; not garbage-collected, it seems.  This would the lead to en
6950         ;; ever-growing Emacs.
6951         (gnus-summary-clear-local-variables)
6952         (let ((gnus-summary-local-variables gnus-newsgroup-variables))
6953           (gnus-summary-clear-local-variables))
6954         (when (get-buffer gnus-article-buffer)
6955           (bury-buffer gnus-article-buffer))
6956         ;; Return to group mode buffer.
6957         (when (eq mode 'gnus-summary-mode)
6958           (gnus-kill-buffer buf)))
6959       (setq gnus-current-select-method gnus-select-method)
6960       (set-buffer gnus-group-buffer)
6961       (if quit-config
6962           (gnus-handle-ephemeral-exit quit-config)
6963         (goto-char group-point)
6964         ;; If gnus-group-buffer is already displayed, make sure we also move
6965         ;; the cursor in the window that displays it.
6966         (let ((win (get-buffer-window (current-buffer) 0)))
6967           (if win (set-window-point win (point))))
6968         (unless leave-hidden
6969           (gnus-configure-windows 'group 'force)))
6970       ;; Clear the current group name.
6971       (unless quit-config
6972         (setq gnus-newsgroup-name nil)))))
6973
6974 (defalias 'gnus-summary-quit 'gnus-summary-exit-no-update)
6975 (defun gnus-summary-exit-no-update (&optional no-questions)
6976   "Quit reading current newsgroup without updating read article info."
6977   (interactive)
6978   (let* ((group gnus-newsgroup-name)
6979          (gnus-group-is-exiting-p t)
6980          (gnus-group-is-exiting-without-update-p t)
6981          (quit-config (gnus-group-quit-config group)))
6982     (when (or no-questions
6983               gnus-expert-user
6984               (gnus-y-or-n-p "Discard changes to this group and exit? "))
6985       (gnus-async-halt-prefetch)
6986       (run-hooks 'gnus-summary-prepare-exit-hook)
6987       (when (gnus-buffer-live-p gnus-article-buffer)
6988         (save-excursion
6989           (set-buffer gnus-article-buffer)
6990           (mm-destroy-parts gnus-article-mime-handles)
6991           ;; Set it to nil for safety reason.
6992           (setq gnus-article-mime-handle-alist nil)
6993           (setq gnus-article-mime-handles nil)))
6994       ;; If we have several article buffers, we kill them at exit.
6995       (unless gnus-single-article-buffer
6996         (gnus-kill-buffer gnus-article-buffer)
6997         (gnus-kill-buffer gnus-original-article-buffer)
6998         (setq gnus-article-current nil))
6999       (if (not gnus-kill-summary-on-exit)
7000           (gnus-deaden-summary)
7001         (gnus-close-group group)
7002         (gnus-summary-clear-local-variables)
7003         (let ((gnus-summary-local-variables gnus-newsgroup-variables))
7004           (gnus-summary-clear-local-variables))
7005         (gnus-kill-buffer gnus-summary-buffer))
7006       (unless gnus-single-article-buffer
7007         (setq gnus-article-current nil))
7008       (when gnus-use-trees
7009         (gnus-tree-close group))
7010       (gnus-async-prefetch-remove-group group)
7011       (when (get-buffer gnus-article-buffer)
7012         (bury-buffer gnus-article-buffer))
7013       ;; Return to the group buffer.
7014       (gnus-configure-windows 'group 'force)
7015       ;; Clear the current group name.
7016       (setq gnus-newsgroup-name nil)
7017       (unless (gnus-ephemeral-group-p group)
7018         (gnus-group-update-group group))
7019       (when (equal (gnus-group-group-name) group)
7020         (gnus-group-next-unread-group 1))
7021       (when quit-config
7022         (gnus-handle-ephemeral-exit quit-config)))))
7023
7024 (defun gnus-handle-ephemeral-exit (quit-config)
7025   "Handle movement when leaving an ephemeral group.
7026 The state which existed when entering the ephemeral is reset."
7027   (if (not (buffer-name (car quit-config)))
7028       (gnus-configure-windows 'group 'force)
7029     (set-buffer (car quit-config))
7030     (cond ((eq major-mode 'gnus-summary-mode)
7031            (gnus-set-global-variables))
7032           ((eq major-mode 'gnus-article-mode)
7033            (save-excursion
7034              ;; The `gnus-summary-buffer' variable may point
7035              ;; to the old summary buffer when using a single
7036              ;; article buffer.
7037              (unless (gnus-buffer-live-p gnus-summary-buffer)
7038                (set-buffer gnus-group-buffer))
7039              (set-buffer gnus-summary-buffer)
7040              (gnus-set-global-variables))))
7041     (if (or (eq (cdr quit-config) 'article)
7042             (eq (cdr quit-config) 'pick))
7043         (if (and (boundp 'gnus-pick-mode) (symbol-value 'gnus-pick-mode))
7044             (gnus-configure-windows 'pick 'force)
7045           (gnus-configure-windows (cdr quit-config) 'force))
7046       (gnus-configure-windows (cdr quit-config) 'force))
7047     (when (eq major-mode 'gnus-summary-mode)
7048       (gnus-summary-recenter)
7049       (gnus-summary-position-point))))
7050
7051 ;;; Dead summaries.
7052
7053 (defvar gnus-dead-summary-mode-map nil)
7054
7055 (unless gnus-dead-summary-mode-map
7056   (setq gnus-dead-summary-mode-map (make-keymap))
7057   (suppress-keymap gnus-dead-summary-mode-map)
7058   (substitute-key-definition
7059    'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-mode-map)
7060   (dolist (key '("\C-d" "\r" "\177" [delete]))
7061     (define-key gnus-dead-summary-mode-map
7062       key 'gnus-summary-wake-up-the-dead))
7063   (dolist (key '("q" "Q"))
7064     (define-key gnus-dead-summary-mode-map key 'bury-buffer)))
7065
7066 (defvar gnus-dead-summary-mode nil
7067   "Minor mode for Gnus summary buffers.")
7068
7069 (defun gnus-dead-summary-mode (&optional arg)
7070   "Minor mode for Gnus summary buffers."
7071   (interactive "P")
7072   (when (eq major-mode 'gnus-summary-mode)
7073     (make-local-variable 'gnus-dead-summary-mode)
7074     (setq gnus-dead-summary-mode
7075           (if (null arg) (not gnus-dead-summary-mode)
7076             (> (prefix-numeric-value arg) 0)))
7077     (when gnus-dead-summary-mode
7078       (add-minor-mode
7079        'gnus-dead-summary-mode " Dead" gnus-dead-summary-mode-map))))
7080
7081 (defun gnus-deaden-summary ()
7082   "Make the current summary buffer into a dead summary buffer."
7083   ;; Kill any previous dead summary buffer.
7084   (when (and gnus-dead-summary
7085              (buffer-name gnus-dead-summary))
7086     (with-current-buffer gnus-dead-summary
7087       (when gnus-dead-summary-mode
7088         (kill-buffer (current-buffer)))))
7089   ;; Make this the current dead summary.
7090   (setq gnus-dead-summary (current-buffer))
7091   (gnus-dead-summary-mode 1)
7092   (let ((name (buffer-name)))
7093     (when (string-match "Summary" name)
7094       (rename-buffer
7095        (concat (substring name 0 (match-beginning 0)) "Dead "
7096                (substring name (match-beginning 0)))
7097        t)
7098       (bury-buffer))))
7099
7100 (defun gnus-kill-or-deaden-summary (buffer)
7101   "Kill or deaden the summary BUFFER."
7102   (save-excursion
7103     (when (and (buffer-name buffer)
7104                (not gnus-single-article-buffer))
7105       (with-current-buffer buffer
7106         (gnus-kill-buffer gnus-article-buffer)
7107         (gnus-kill-buffer gnus-original-article-buffer)))
7108     (cond
7109      ;; Kill the buffer.
7110      (gnus-kill-summary-on-exit
7111       (when (and gnus-use-trees
7112                  (gnus-buffer-exists-p buffer))
7113         (save-excursion
7114           (set-buffer buffer)
7115           (gnus-tree-close gnus-newsgroup-name)))
7116       (gnus-kill-buffer buffer))
7117      ;; Deaden the buffer.
7118      ((gnus-buffer-exists-p buffer)
7119       (save-excursion
7120         (set-buffer buffer)
7121         (gnus-deaden-summary))))))
7122
7123 (defun gnus-summary-wake-up-the-dead (&rest args)
7124   "Wake up the dead summary buffer."
7125   (interactive)
7126   (gnus-dead-summary-mode -1)
7127   (let ((name (buffer-name)))
7128     (when (string-match "Dead " name)
7129       (rename-buffer
7130        (concat (substring name 0 (match-beginning 0))
7131                (substring name (match-end 0)))
7132        t)))
7133   (gnus-message 3 "This dead summary is now alive again"))
7134
7135 ;; Suggested by Andrew Eskilsson <pi92ae@pt.hk-r.se>.
7136 (defun gnus-summary-fetch-faq (&optional faq-dir)
7137   "Fetch the FAQ for the current group.
7138 If FAQ-DIR (the prefix), prompt for a directory to search for the faq
7139 in."
7140   (interactive
7141    (list
7142     (when current-prefix-arg
7143       (completing-read
7144        "FAQ dir: " (and (listp gnus-group-faq-directory)
7145                         (mapcar 'list
7146                                 gnus-group-faq-directory))))))
7147   (let (gnus-faq-buffer)
7148     (when (setq gnus-faq-buffer
7149                 (gnus-group-fetch-faq gnus-newsgroup-name faq-dir))
7150       (gnus-configure-windows 'summary-faq))))
7151
7152 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
7153 (defun gnus-summary-describe-group (&optional force)
7154   "Describe the current newsgroup."
7155   (interactive "P")
7156   (gnus-group-describe-group force gnus-newsgroup-name))
7157
7158 (defun gnus-summary-describe-briefly ()
7159   "Describe summary mode commands briefly."
7160   (interactive)
7161   (gnus-message 6 (substitute-command-keys "\\<gnus-summary-mode-map>\\[gnus-summary-next-page]:Select  \\[gnus-summary-next-unread-article]:Forward  \\[gnus-summary-prev-unread-article]:Backward  \\[gnus-summary-exit]:Exit  \\[gnus-info-find-node]:Run Info        \\[gnus-summary-describe-briefly]:This help")))
7162
7163 ;; Walking around group mode buffer from summary mode.
7164
7165 (defun gnus-summary-next-group (&optional no-article target-group backward)
7166   "Exit current newsgroup and then select next unread newsgroup.
7167 If prefix argument NO-ARTICLE is non-nil, no article is selected
7168 initially.  If TARGET-GROUP, go to this group.  If BACKWARD, go to
7169 previous group instead."
7170   (interactive "P")
7171   ;; Stop pre-fetching.
7172   (gnus-async-halt-prefetch)
7173   (let ((current-group gnus-newsgroup-name)
7174         (current-buffer (current-buffer))
7175         entered)
7176     ;; First we semi-exit this group to update Xrefs and all variables.
7177     ;; We can't do a real exit, because the window conf must remain
7178     ;; the same in case the user is prompted for info, and we don't
7179     ;; want the window conf to change before that...
7180     (gnus-summary-exit t)
7181     (while (not entered)
7182       ;; Then we find what group we are supposed to enter.
7183       (set-buffer gnus-group-buffer)
7184       (gnus-group-jump-to-group current-group)
7185       (setq target-group
7186             (or target-group
7187                 (if (eq gnus-keep-same-level 'best)
7188                     (gnus-summary-best-group gnus-newsgroup-name)
7189                   (gnus-summary-search-group backward gnus-keep-same-level))))
7190       (if (not target-group)
7191           ;; There are no further groups, so we return to the group
7192           ;; buffer.
7193           (progn
7194             (gnus-message 5 "Returning to the group buffer")
7195             (setq entered t)
7196             (when (gnus-buffer-live-p current-buffer)
7197               (set-buffer current-buffer)
7198               (gnus-summary-exit))
7199             (gnus-run-hooks 'gnus-group-no-more-groups-hook))
7200         ;; We try to enter the target group.
7201         (gnus-group-jump-to-group target-group)
7202         (let ((unreads (gnus-group-group-unread)))
7203           (if (and (or (eq t unreads)
7204                        (and unreads (not (zerop unreads))))
7205                    (gnus-summary-read-group
7206                     target-group nil no-article
7207                     (and (buffer-name current-buffer) current-buffer)
7208                     nil backward))
7209               (setq entered t)
7210             (setq current-group target-group
7211                   target-group nil)))))))
7212
7213 (defun gnus-summary-prev-group (&optional no-article)
7214   "Exit current newsgroup and then select previous unread newsgroup.
7215 If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
7216   (interactive "P")
7217   (gnus-summary-next-group no-article nil t))
7218
7219 ;; Walking around summary lines.
7220
7221 (defun gnus-summary-first-subject (&optional unread undownloaded unseen)
7222   "Go to the first subject satisfying any non-nil constraint.
7223 If UNREAD is non-nil, the article should be unread.
7224 If UNDOWNLOADED is non-nil, the article should be undownloaded.
7225 If UNSEEN is non-nil, the article should be unseen.
7226 Returns the article selected or nil if there are no matching articles."
7227   (interactive "P")
7228   (cond
7229    ;; Empty summary.
7230    ((null gnus-newsgroup-data)
7231     (gnus-message 3 "No articles in the group")
7232     nil)
7233    ;; Pick the first article.
7234    ((not (or unread undownloaded unseen))
7235     (goto-char (gnus-data-pos (car gnus-newsgroup-data)))
7236     (gnus-data-number (car gnus-newsgroup-data)))
7237    ;; Find the first unread article.
7238    (t
7239     (let ((data gnus-newsgroup-data))
7240       (while (and data
7241                   (let ((num (gnus-data-number (car data))))
7242                     (or (memq num gnus-newsgroup-unfetched)
7243                         (not (or (and unread
7244                                       (memq num gnus-newsgroup-unreads))
7245                                  (and undownloaded
7246                                       (memq num gnus-newsgroup-undownloaded))
7247                                  (and unseen
7248                                       (memq num gnus-newsgroup-unseen)))))))
7249         (setq data (cdr data)))
7250       (prog1
7251           (if data
7252               (progn
7253                 (goto-char (gnus-data-pos (car data)))
7254                 (gnus-data-number (car data)))
7255             (gnus-message 3 "No more%s articles"
7256                           (let* ((r (when unread " unread"))
7257                                  (d (when undownloaded " undownloaded"))
7258                                  (s (when unseen " unseen"))
7259                                  (l (delq nil (list r d s))))
7260                             (cond ((= 3 (length l))
7261                                    (concat r "," d ", or" s))
7262                                   ((= 2 (length l))
7263                                    (concat (car l) ", or" (cadr l)))
7264                                   ((= 1 (length l))
7265                                    (car l))
7266                                   (t
7267                                    ""))))
7268             nil
7269             )
7270         (gnus-summary-position-point))))))
7271
7272 (defun gnus-summary-next-subject (n &optional unread dont-display)
7273   "Go to next N'th summary line.
7274 If N is negative, go to the previous N'th subject line.
7275 If UNREAD is non-nil, only unread articles are selected.
7276 The difference between N and the actual number of steps taken is
7277 returned."
7278   (interactive "p")
7279   (let ((backward (< n 0))
7280         (n (abs n)))
7281     (while (and (> n 0)
7282                 (if backward
7283                     (gnus-summary-find-prev unread)
7284                   (gnus-summary-find-next unread)))
7285       (unless (zerop (setq n (1- n)))
7286         (gnus-summary-show-thread)))
7287     (when (/= 0 n)
7288       (gnus-message 7 "No more%s articles"
7289                     (if unread " unread" "")))
7290     (unless dont-display
7291       (gnus-summary-recenter)
7292       (gnus-summary-position-point))
7293     n))
7294
7295 (defun gnus-summary-next-unread-subject (n)
7296   "Go to next N'th unread summary line."
7297   (interactive "p")
7298   (gnus-summary-next-subject n t))
7299
7300 (defun gnus-summary-prev-subject (n &optional unread)
7301   "Go to previous N'th summary line.
7302 If optional argument UNREAD is non-nil, only unread article is selected."
7303   (interactive "p")
7304   (gnus-summary-next-subject (- n) unread))
7305
7306 (defun gnus-summary-prev-unread-subject (n)
7307   "Go to previous N'th unread summary line."
7308   (interactive "p")
7309   (gnus-summary-next-subject (- n) t))
7310
7311 (defun gnus-summary-goto-subjects (articles)
7312   "Insert the subject header for ARTICLES in the current buffer."
7313   (save-excursion
7314     (dolist (article articles)
7315       (gnus-summary-goto-subject article t)))
7316   (gnus-summary-limit (append articles gnus-newsgroup-limit))
7317   (gnus-summary-position-point))
7318
7319 (defun gnus-summary-goto-subject (article &optional force silent)
7320   "Go the subject line of ARTICLE.
7321 If FORCE, also allow jumping to articles not currently shown."
7322   (interactive "nArticle number: ")
7323   (unless (numberp article)
7324     (error "Article %s is not a number" article))
7325   (let ((b (point))
7326         (data (gnus-data-find article)))
7327     ;; We read in the article if we have to.
7328     (and (not data)
7329          force
7330          (gnus-summary-insert-subject
7331           article
7332           (if (or (numberp force) (vectorp force)) force)
7333           t)
7334          (setq data (gnus-data-find article)))
7335     (goto-char b)
7336     (if (not data)
7337         (progn
7338           (unless silent
7339             (gnus-message 3 "Can't find article %d" article))
7340           nil)
7341       (let ((pt (gnus-data-pos data)))
7342         (goto-char pt)
7343         (gnus-summary-set-article-display-arrow pt))
7344       (gnus-summary-position-point)
7345       article)))
7346
7347 ;; Walking around summary lines with displaying articles.
7348
7349 (defun gnus-summary-expand-window (&optional arg)
7350   "Make the summary buffer take up the entire Emacs frame.
7351 Given a prefix, will force an `article' buffer configuration."
7352   (interactive "P")
7353   (if arg
7354       (gnus-configure-windows 'article 'force)
7355     (gnus-configure-windows 'summary 'force)))
7356
7357 (defun gnus-summary-display-article (article &optional all-header)
7358   "Display ARTICLE in article buffer."
7359   (when (gnus-buffer-live-p gnus-article-buffer)
7360     (with-current-buffer gnus-article-buffer
7361       (mm-enable-multibyte)))
7362   (gnus-set-global-variables)
7363   (when (gnus-buffer-live-p gnus-article-buffer)
7364     (with-current-buffer gnus-article-buffer
7365       (setq gnus-article-charset gnus-newsgroup-charset)
7366       (setq gnus-article-ignored-charsets gnus-newsgroup-ignored-charsets)
7367       (mm-enable-multibyte)))
7368   (if (null article)
7369       nil
7370     (prog1
7371         (if gnus-summary-display-article-function
7372             (funcall gnus-summary-display-article-function article all-header)
7373           (gnus-article-prepare article all-header))
7374       (gnus-run-hooks 'gnus-select-article-hook)
7375       (when (and gnus-current-article
7376                  (not (zerop gnus-current-article)))
7377         (gnus-summary-goto-subject gnus-current-article))
7378       (gnus-summary-recenter)
7379       (when (and gnus-use-trees gnus-show-threads)
7380         (gnus-possibly-generate-tree article)
7381         (gnus-highlight-selected-tree article))
7382       ;; Successfully display article.
7383       (gnus-article-set-window-start
7384        (cdr (assq article gnus-newsgroup-bookmarks))))))
7385
7386 (defun gnus-summary-select-article (&optional all-headers force pseudo article)
7387   "Select the current article.
7388 If ALL-HEADERS is non-nil, show all header fields.  If FORCE is
7389 non-nil, the article will be re-fetched even if it already present in
7390 the article buffer.  If PSEUDO is non-nil, pseudo-articles will also
7391 be displayed."
7392   ;; Make sure we are in the summary buffer to work around bbdb bug.
7393   (unless (eq major-mode 'gnus-summary-mode)
7394     (set-buffer gnus-summary-buffer))
7395   (let ((article (or article (gnus-summary-article-number)))
7396         (all-headers (not (not all-headers))) ;Must be t or nil.
7397         gnus-summary-display-article-function)
7398     (and (not pseudo)
7399          (gnus-summary-article-pseudo-p article)
7400          (error "This is a pseudo-article"))
7401     (save-excursion
7402       (set-buffer gnus-summary-buffer)
7403       (if (or (and gnus-single-article-buffer
7404                    (or (null gnus-current-article)
7405                        (null gnus-article-current)
7406                        (null (get-buffer gnus-article-buffer))
7407                        (not (eq article (cdr gnus-article-current)))
7408                        (not (equal (car gnus-article-current)
7409                                    gnus-newsgroup-name))))
7410               (and (not gnus-single-article-buffer)
7411                    (or (null gnus-current-article)
7412                        (not (eq gnus-current-article article))))
7413               force)
7414           ;; The requested article is different from the current article.
7415           (progn
7416             (gnus-summary-display-article article all-headers)
7417             (when (gnus-buffer-live-p gnus-article-buffer)
7418               (with-current-buffer gnus-article-buffer
7419                 (if (not gnus-article-decoded-p) ;; a local variable
7420                     (mm-disable-multibyte))))
7421             (gnus-article-set-window-start
7422              (cdr (assq article gnus-newsgroup-bookmarks)))
7423             article)
7424         'old))))
7425
7426 (defun gnus-summary-force-verify-and-decrypt ()
7427   "Display buttons for signed/encrypted parts and verify/decrypt them."
7428   (interactive)
7429   (let ((mm-verify-option 'known)
7430         (mm-decrypt-option 'known)
7431         (gnus-article-emulate-mime t)
7432         (gnus-buttonized-mime-types (append (list "multipart/signed"
7433                                                   "multipart/encrypted")
7434                                             gnus-buttonized-mime-types)))
7435     (gnus-summary-select-article nil 'force)))
7436
7437 (defun gnus-summary-set-current-mark (&optional current-mark)
7438   "Obsolete function."
7439   nil)
7440
7441 (defun gnus-summary-next-article (&optional unread subject backward push)
7442   "Select the next article.
7443 If UNREAD, only unread articles are selected.
7444 If SUBJECT, only articles with SUBJECT are selected.
7445 If BACKWARD, the previous article is selected instead of the next."
7446   (interactive "P")
7447   ;; Make sure we are in the summary buffer.
7448   (unless (eq major-mode 'gnus-summary-mode)
7449     (set-buffer gnus-summary-buffer))
7450   (cond
7451    ;; Is there such an article?
7452    ((and (gnus-summary-search-forward unread subject backward)
7453          (or (gnus-summary-display-article (gnus-summary-article-number))
7454              (eq (gnus-summary-article-mark) gnus-canceled-mark)))
7455     (gnus-summary-position-point))
7456    ;; If not, we try the first unread, if that is wanted.
7457    ((and subject
7458          gnus-auto-select-same
7459          (gnus-summary-first-unread-article))
7460     (gnus-summary-position-point)
7461     (gnus-message 6 "Wrapped"))
7462    ;; Try to get next/previous article not displayed in this group.
7463    ((and gnus-auto-extend-newsgroup
7464          (not unread) (not subject))
7465     (gnus-summary-goto-article
7466      (if backward (1- gnus-newsgroup-begin) (1+ gnus-newsgroup-end))
7467      nil (count-lines (point-min) (point))))
7468    ;; Go to next/previous group.
7469    (t
7470     (unless (gnus-ephemeral-group-p gnus-newsgroup-name)
7471       (gnus-summary-jump-to-group gnus-newsgroup-name))
7472     (let ((cmd last-command-char)
7473           (point
7474            (with-current-buffer gnus-group-buffer
7475              (point)))
7476           (group
7477            (if (eq gnus-keep-same-level 'best)
7478                (gnus-summary-best-group gnus-newsgroup-name)
7479              (gnus-summary-search-group backward gnus-keep-same-level))))
7480       ;; For some reason, the group window gets selected.  We change
7481       ;; it back.
7482       (select-window (get-buffer-window (current-buffer)))
7483       ;; Select next unread newsgroup automagically.
7484       (cond
7485        ((or (not gnus-auto-select-next)
7486             (not cmd))
7487         (gnus-message 7 "No more%s articles" (if unread " unread" "")))
7488        ((or (eq gnus-auto-select-next 'quietly)
7489             (and (eq gnus-auto-select-next 'slightly-quietly)
7490                  push)
7491             (and (eq gnus-auto-select-next 'almost-quietly)
7492                  (gnus-summary-last-article-p)))
7493         ;; Select quietly.
7494         (if (gnus-ephemeral-group-p gnus-newsgroup-name)
7495             (gnus-summary-exit)
7496           (gnus-message 7 "No more%s articles (%s)..."
7497                         (if unread " unread" "")
7498                         (if group (concat "selecting " group)
7499                           "exiting"))
7500           (gnus-summary-next-group nil group backward)))
7501        (t
7502         (when (gnus-key-press-event-p last-input-event)
7503           (gnus-summary-walk-group-buffer
7504            gnus-newsgroup-name cmd unread backward point))))))))
7505
7506 (defun gnus-summary-walk-group-buffer (from-group cmd unread backward start)
7507   (let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1))
7508                       (?\C-p (gnus-group-prev-unread-group 1))))
7509         (cursor-in-echo-area t)
7510         keve key group ended prompt)
7511     (save-excursion
7512       (set-buffer gnus-group-buffer)
7513       (goto-char start)
7514       (setq group
7515             (if (eq gnus-keep-same-level 'best)
7516                 (gnus-summary-best-group gnus-newsgroup-name)
7517               (gnus-summary-search-group backward gnus-keep-same-level))))
7518     (while (not ended)
7519       (setq prompt
7520             (format
7521              "No more%s articles%s " (if unread " unread" "")
7522              (if (and group
7523                       (not (gnus-ephemeral-group-p gnus-newsgroup-name)))
7524                  (format " (Type %s for %s [%s])"
7525                          (single-key-description cmd)
7526                          (gnus-group-decoded-name group)
7527                          (gnus-group-unread group))
7528                (format " (Type %s to exit %s)"
7529                        (single-key-description cmd)
7530                        (gnus-group-decoded-name gnus-newsgroup-name)))))
7531       ;; Confirm auto selection.
7532       (setq key (car (setq keve (gnus-read-event-char prompt)))
7533             ended t)
7534       (cond
7535        ((assq key keystrokes)
7536         (let ((obuf (current-buffer)))
7537           (switch-to-buffer gnus-group-buffer)
7538           (when group
7539             (gnus-group-jump-to-group group))
7540           (eval (cadr (assq key keystrokes)))
7541           (setq group (gnus-group-group-name))
7542           (switch-to-buffer obuf))
7543         (setq ended nil))
7544        ((equal key cmd)
7545         (if (or (not group)
7546                 (gnus-ephemeral-group-p gnus-newsgroup-name))
7547             (gnus-summary-exit)
7548           (gnus-summary-next-group nil group backward)))
7549        (t
7550         (push (cdr keve) unread-command-events))))))
7551
7552 (defun gnus-summary-next-unread-article ()
7553   "Select unread article after current one."
7554   (interactive)
7555   (gnus-summary-next-article
7556    (or (not (eq gnus-summary-goto-unread 'never))
7557        (gnus-summary-last-article-p (gnus-summary-article-number)))
7558    (and gnus-auto-select-same
7559         (gnus-summary-article-subject))))
7560
7561 (defun gnus-summary-prev-article (&optional unread subject)
7562   "Select the article after the current one.
7563 If UNREAD is non-nil, only unread articles are selected."
7564   (interactive "P")
7565   (gnus-summary-next-article unread subject t))
7566
7567 (defun gnus-summary-prev-unread-article ()
7568   "Select unread article before current one."
7569   (interactive)
7570   (gnus-summary-prev-article
7571    (or (not (eq gnus-summary-goto-unread 'never))
7572        (gnus-summary-first-article-p (gnus-summary-article-number)))
7573    (and gnus-auto-select-same
7574         (gnus-summary-article-subject))))
7575
7576 (defun gnus-summary-next-page (&optional lines circular stop)
7577   "Show next page of the selected article.
7578 If at the end of the current article, select the next article.
7579 LINES says how many lines should be scrolled up.
7580
7581 If CIRCULAR is non-nil, go to the start of the article instead of
7582 selecting the next article when reaching the end of the current
7583 article.
7584
7585 If STOP is non-nil, just stop when reaching the end of the message.
7586
7587 Also see the variable `gnus-article-skip-boring'."
7588   (interactive "P")
7589   (setq gnus-summary-buffer (current-buffer))
7590   (gnus-set-global-variables)
7591   (let ((article (gnus-summary-article-number))
7592         (article-window (get-buffer-window gnus-article-buffer t))
7593         endp)
7594     ;; If the buffer is empty, we have no article.
7595     (unless article
7596       (error "No article to select"))
7597     (gnus-configure-windows 'article)
7598     (if (eq (cdr (assq article gnus-newsgroup-reads)) gnus-canceled-mark)
7599         (if (and (eq gnus-summary-goto-unread 'never)
7600                  (not (gnus-summary-last-article-p article)))
7601             (gnus-summary-next-article)
7602           (gnus-summary-next-unread-article))
7603       (if (or (null gnus-current-article)
7604               (null gnus-article-current)
7605               (/= article (cdr gnus-article-current))
7606               (not (equal (car gnus-article-current) gnus-newsgroup-name)))
7607           ;; Selected subject is different from current article's.
7608           (gnus-summary-display-article article)
7609         (when article-window
7610           (gnus-eval-in-buffer-window gnus-article-buffer
7611             (setq endp (or (gnus-article-next-page lines)
7612                            (gnus-article-only-boring-p))))
7613           (when endp
7614             (cond (stop
7615                    (gnus-message 3 "End of message"))
7616                   (circular
7617                    (gnus-summary-beginning-of-article))
7618                   (lines
7619                    (gnus-message 3 "End of message"))
7620                   ((null lines)
7621                    (if (and (eq gnus-summary-goto-unread 'never)
7622                             (not (gnus-summary-last-article-p article)))
7623                        (gnus-summary-next-article)
7624                      (gnus-summary-next-unread-article))))))))
7625     (gnus-summary-recenter)
7626     (gnus-summary-position-point)))
7627
7628 (defun gnus-summary-prev-page (&optional lines move)
7629   "Show previous page of selected article.
7630 Argument LINES specifies lines to be scrolled down.
7631 If MOVE, move to the previous unread article if point is at
7632 the beginning of the buffer."
7633   (interactive "P")
7634   (let ((article (gnus-summary-article-number))
7635         (article-window (get-buffer-window gnus-article-buffer t))
7636         endp)
7637     (gnus-configure-windows 'article)
7638     (if (or (null gnus-current-article)
7639             (null gnus-article-current)
7640             (/= article (cdr gnus-article-current))
7641             (not (equal (car gnus-article-current) gnus-newsgroup-name)))
7642         ;; Selected subject is different from current article's.
7643         (gnus-summary-display-article article)
7644       (gnus-summary-recenter)
7645       (when article-window
7646         (gnus-eval-in-buffer-window gnus-article-buffer
7647           (setq endp (gnus-article-prev-page lines)))
7648         (when (and move endp)
7649           (cond (lines
7650                  (gnus-message 3 "Beginning of message"))
7651                 ((null lines)
7652                  (if (and (eq gnus-summary-goto-unread 'never)
7653                           (not (gnus-summary-first-article-p article)))
7654                      (gnus-summary-prev-article)
7655                    (gnus-summary-prev-unread-article))))))))
7656   (gnus-summary-position-point))
7657
7658 (defun gnus-summary-prev-page-or-article (&optional lines)
7659   "Show previous page of selected article.
7660 Argument LINES specifies lines to be scrolled down.
7661 If at the beginning of the article, go to the next article."
7662   (interactive "P")
7663   (gnus-summary-prev-page lines t))
7664
7665 (defun gnus-summary-scroll-up (lines)
7666   "Scroll up (or down) one line current article.
7667 Argument LINES specifies lines to be scrolled up (or down if negative)."
7668   (interactive "p")
7669   (gnus-configure-windows 'article)
7670   (gnus-summary-show-thread)
7671   (when (eq (gnus-summary-select-article nil nil 'pseudo) 'old)
7672     (gnus-eval-in-buffer-window gnus-article-buffer
7673       (cond ((> lines 0)
7674              (when (gnus-article-next-page lines)
7675                (gnus-message 3 "End of message")))
7676             ((< lines 0)
7677              (gnus-article-prev-page (- lines))))))
7678   (gnus-summary-recenter)
7679   (gnus-summary-position-point))
7680
7681 (defun gnus-summary-scroll-down (lines)
7682   "Scroll down (or up) one line current article.
7683 Argument LINES specifies lines to be scrolled down (or up if negative)."
7684   (interactive "p")
7685   (gnus-summary-scroll-up (- lines)))
7686
7687 (defun gnus-summary-next-same-subject ()
7688   "Select next article which has the same subject as current one."
7689   (interactive)
7690   (gnus-summary-next-article nil (gnus-summary-article-subject)))
7691
7692 (defun gnus-summary-prev-same-subject ()
7693   "Select previous article which has the same subject as current one."
7694   (interactive)
7695   (gnus-summary-prev-article nil (gnus-summary-article-subject)))
7696
7697 (defun gnus-summary-next-unread-same-subject ()
7698   "Select next unread article which has the same subject as current one."
7699   (interactive)
7700   (gnus-summary-next-article t (gnus-summary-article-subject)))
7701
7702 (defun gnus-summary-prev-unread-same-subject ()
7703   "Select previous unread article which has the same subject as current one."
7704   (interactive)
7705   (gnus-summary-prev-article t (gnus-summary-article-subject)))
7706
7707 (defun gnus-summary-first-unread-article ()
7708   "Select the first unread article.
7709 Return nil if there are no unread articles."
7710   (interactive)
7711   (prog1
7712       (when (gnus-summary-first-subject t)
7713         (gnus-summary-show-thread)
7714         (gnus-summary-first-subject t)
7715         (gnus-summary-display-article (gnus-summary-article-number)))
7716     (gnus-summary-position-point)))
7717
7718 (defun gnus-summary-first-unread-subject ()
7719   "Place the point on the subject line of the first unread article.
7720 Return nil if there are no unread articles."
7721   (interactive)
7722   (prog1
7723       (when (gnus-summary-first-subject t)
7724         (gnus-summary-show-thread)
7725         (gnus-summary-first-subject t))
7726     (gnus-summary-position-point)))
7727
7728 (defun gnus-summary-first-unseen-subject ()
7729   "Place the point on the subject line of the first unseen article.
7730 Return nil if there are no unseen articles."
7731   (interactive)
7732   (prog1
7733       (when (gnus-summary-first-subject nil nil t)
7734         (gnus-summary-show-thread)
7735         (gnus-summary-first-subject nil nil t))
7736     (gnus-summary-position-point)))
7737
7738 (defun gnus-summary-first-unseen-or-unread-subject ()
7739   "Place the point on the subject line of the first unseen article or,
7740 if all article have been seen, on the subject line of the first unread
7741 article."
7742   (interactive)
7743   (prog1
7744       (unless (when (gnus-summary-first-subject nil nil t)
7745                 (gnus-summary-show-thread)
7746                 (gnus-summary-first-subject nil nil t))
7747         (when (gnus-summary-first-subject t)
7748           (gnus-summary-show-thread)
7749           (gnus-summary-first-subject t)))
7750     (gnus-summary-position-point)))
7751
7752 (defun gnus-summary-first-article ()
7753   "Select the first article.
7754 Return nil if there are no articles."
7755   (interactive)
7756   (prog1
7757       (when (gnus-summary-first-subject)
7758         (gnus-summary-show-thread)
7759         (gnus-summary-first-subject)
7760         (gnus-summary-display-article (gnus-summary-article-number)))
7761     (gnus-summary-position-point)))
7762
7763 (defun gnus-summary-best-unread-article (&optional arg)
7764   "Select the unread article with the highest score.
7765 If given a prefix argument, select the next unread article that has a
7766 score higher than the default score."
7767   (interactive "P")
7768   (let ((article (if arg
7769                      (gnus-summary-better-unread-subject)
7770                    (gnus-summary-best-unread-subject))))
7771     (if article
7772         (gnus-summary-goto-article article)
7773       (error "No unread articles"))))
7774
7775 (defun gnus-summary-best-unread-subject ()
7776   "Select the unread subject with the highest score."
7777   (interactive)
7778   (let ((best -1000000)
7779         (data gnus-newsgroup-data)
7780         article score)
7781     (while data
7782       (and (gnus-data-unread-p (car data))
7783            (> (setq score
7784                     (gnus-summary-article-score (gnus-data-number (car data))))
7785               best)
7786            (setq best score
7787                  article (gnus-data-number (car data))))
7788       (setq data (cdr data)))
7789     (when article
7790       (gnus-summary-goto-subject article))
7791     (gnus-summary-position-point)
7792     article))
7793
7794 (defun gnus-summary-better-unread-subject ()
7795   "Select the first unread subject that has a score over the default score."
7796   (interactive)
7797   (let ((data gnus-newsgroup-data)
7798         article score)
7799     (while (and (setq article (gnus-data-number (car data)))
7800                 (or (gnus-data-read-p (car data))
7801                     (not (> (gnus-summary-article-score article)
7802                             gnus-summary-default-score))))
7803       (setq data (cdr data)))
7804     (when article
7805       (gnus-summary-goto-subject article))
7806     (gnus-summary-position-point)
7807     article))
7808
7809 (defun gnus-summary-last-subject ()
7810   "Go to the last displayed subject line in the group."
7811   (let ((article (gnus-data-number (car (gnus-data-list t)))))
7812     (when article
7813       (gnus-summary-goto-subject article))))
7814
7815 (defun gnus-summary-goto-article (article &optional all-headers force)
7816   "Fetch ARTICLE (article number or Message-ID) and display it if it exists.
7817 If ALL-HEADERS is non-nil, no header lines are hidden.
7818 If FORCE, go to the article even if it isn't displayed.  If FORCE
7819 is a number, it is the line the article is to be displayed on."
7820   (interactive
7821    (list
7822     (completing-read
7823      "Article number or Message-ID: "
7824      (mapcar (lambda (number) (list (int-to-string number)))
7825              gnus-newsgroup-limit))
7826     current-prefix-arg
7827     t))
7828   (prog1
7829       (if (and (stringp article)
7830                (string-match "@\\|%40" article))
7831           (gnus-summary-refer-article article)
7832         (when (stringp article)
7833           (setq article (string-to-number article)))
7834         (if (gnus-summary-goto-subject article force)
7835             (gnus-summary-display-article article all-headers)
7836           (gnus-message 4 "Couldn't go to article %s" article) nil))
7837     (gnus-summary-position-point)))
7838
7839 (defun gnus-summary-goto-last-article ()
7840   "Go to the previously read article."
7841   (interactive)
7842   (prog1
7843       (when gnus-last-article
7844         (gnus-summary-goto-article gnus-last-article nil t))
7845     (gnus-summary-position-point)))
7846
7847 (defun gnus-summary-pop-article (number)
7848   "Pop one article off the history and go to the previous.
7849 NUMBER articles will be popped off."
7850   (interactive "p")
7851   (let (to)
7852     (setq gnus-newsgroup-history
7853           (cdr (setq to (nthcdr number gnus-newsgroup-history))))
7854     (if to
7855         (gnus-summary-goto-article (car to) nil t)
7856       (error "Article history empty")))
7857   (gnus-summary-position-point))
7858
7859 ;; Summary commands and functions for limiting the summary buffer.
7860
7861 (defun gnus-summary-limit-to-articles (n)
7862   "Limit the summary buffer to the next N articles.
7863 If not given a prefix, use the process marked articles instead."
7864   (interactive "P")
7865   (prog1
7866       (let ((articles (gnus-summary-work-articles n)))
7867         (setq gnus-newsgroup-processable nil)
7868         (gnus-summary-limit articles))
7869     (gnus-summary-position-point)))
7870
7871 (defun gnus-summary-pop-limit (&optional total)
7872   "Restore the previous limit.
7873 If given a prefix, remove all limits."
7874   (interactive "P")
7875   (when total
7876     (setq gnus-newsgroup-limits
7877           (list (mapcar (lambda (h) (mail-header-number h))
7878                         gnus-newsgroup-headers))))
7879   (unless gnus-newsgroup-limits
7880     (error "No limit to pop"))
7881   (prog1
7882       (gnus-summary-limit nil 'pop)
7883     (gnus-summary-position-point)))
7884
7885 (defun gnus-summary-limit-to-subject (subject &optional header not-matching)
7886   "Limit the summary buffer to articles that have subjects that match a regexp.
7887 If NOT-MATCHING, excluding articles that have subjects that match a regexp."
7888   (interactive
7889    (list (read-string (if current-prefix-arg
7890                           "Exclude subject (regexp): "
7891                         "Limit to subject (regexp): "))
7892          nil current-prefix-arg))
7893   (unless header
7894     (setq header "subject"))
7895   (when (not (equal "" subject))
7896     (prog1
7897         (let ((articles (gnus-summary-find-matching
7898                          (or header "subject") subject 'all nil nil
7899                          not-matching)))
7900           (unless articles
7901             (error "Found no matches for \"%s\"" subject))
7902           (gnus-summary-limit articles))
7903       (gnus-summary-position-point))))
7904
7905 (defun gnus-summary-limit-to-author (from &optional not-matching)
7906   "Limit the summary buffer to articles that have authors that match a regexp.
7907 If NOT-MATCHING, excluding articles that have authors that match a regexp."
7908   (interactive
7909    (list (read-string (if current-prefix-arg
7910                           "Exclude author (regexp): "
7911                         "Limit to author (regexp): "))
7912          current-prefix-arg))
7913   (gnus-summary-limit-to-subject from "from" not-matching))
7914
7915 (defun gnus-summary-limit-to-recipient (recipient &optional not-matching)
7916   "Limit the summary buffer to articles with the given RECIPIENT.
7917
7918 If NOT-MATCHING, exclude RECIPIENT.
7919
7920 To and Cc headers are checked.  You need to include them in
7921 `nnmail-extra-headers'."
7922   ;; Unlike `rmail-summary-by-recipients', doesn't include From.
7923   (interactive
7924    (list (read-string (format "%s recipient (regexp): "
7925                               (if current-prefix-arg "Exclude" "Limit to")))
7926          current-prefix-arg))
7927   (when (not (equal "" recipient))
7928     (prog1 (let* ((to
7929                    (if (memq 'To nnmail-extra-headers)
7930                        (gnus-summary-find-matching
7931                         (cons 'extra 'To) recipient 'all nil nil
7932                         not-matching)
7933                      (gnus-message
7934                       1 "`To' isn't present in `nnmail-extra-headers'")
7935                      (sit-for 1)
7936                      nil))
7937                   (cc
7938                    (if (memq 'Cc nnmail-extra-headers)
7939                        (gnus-summary-find-matching
7940                         (cons 'extra 'Cc) recipient 'all nil nil
7941                         not-matching)
7942                      (gnus-message
7943                       1 "`Cc' isn't present in `nnmail-extra-headers'")
7944                      (sit-for 1)
7945                      nil))
7946                   (articles
7947                    (if not-matching
7948                        ;; We need the numbers that are in both lists:
7949                        (mapcar (lambda (a)
7950                                  (and (memq a to) a))
7951                                cc)
7952                      (nconc to cc))))
7953              (unless articles
7954                (error "Found no matches for \"%s\"" recipient))
7955              (gnus-summary-limit articles))
7956       (gnus-summary-position-point))))
7957
7958 (defun gnus-summary-limit-strange-charsets-predicate (header)
7959   (let ((string (concat (mail-header-subject header)
7960                         (mail-header-from header)))
7961         charset found)
7962     (dotimes (i (1- (length string)))
7963       (setq charset (format "%s" (char-charset (aref string (1+ i)))))
7964       (when (string-match "unicode\\|big\\|japanese" charset)
7965         (setq found t)))
7966     found))
7967
7968 (defun gnus-summary-limit-to-predicate (predicate)
7969   "Limit to articles where PREDICATE returns non-nil.
7970 PREDICATE will be called with the header structures of the
7971 articles."
7972   (let ((articles nil)
7973         (case-fold-search t))
7974     (dolist (header gnus-newsgroup-headers)
7975       (when (funcall predicate header)
7976         (push (mail-header-number header) articles)))
7977     (gnus-summary-limit (nreverse articles))))
7978
7979 (defun gnus-summary-limit-to-age (age &optional younger-p)
7980   "Limit the summary buffer to articles that are older than (or equal) AGE days.
7981 If YOUNGER-P (the prefix) is non-nil, limit the summary buffer to
7982 articles that are younger than AGE days."
7983   (interactive
7984    (let ((younger current-prefix-arg)
7985          (days-got nil)
7986          days)
7987      (while (not days-got)
7988        (setq days (if younger
7989                       (read-string "Limit to articles younger than (in days, older when negative): ")
7990                     (read-string
7991                      "Limit to articles older than (in days, younger when negative): ")))
7992        (when (> (length days) 0)
7993          (setq days (read days)))
7994        (if (numberp days)
7995            (progn
7996              (setq days-got t)
7997              (when (< days 0)
7998                (setq younger (not younger))
7999                (setq days (* days -1))))
8000          (message "Please enter a number.")
8001          (sleep-for 1)))
8002      (list days younger)))
8003   (prog1
8004       (let ((data gnus-newsgroup-data)
8005             (cutoff (days-to-time age))
8006             articles d date is-younger)
8007         (while (setq d (pop data))
8008           (when (and (vectorp (gnus-data-header d))
8009                      (setq date (mail-header-date (gnus-data-header d))))
8010             (setq is-younger (time-less-p
8011                               (time-since (condition-case ()
8012                                               (date-to-time date)
8013                                             (error '(0 0))))
8014                               cutoff))
8015             (when (if younger-p
8016                       is-younger
8017                     (not is-younger))
8018               (push (gnus-data-number d) articles))))
8019         (gnus-summary-limit (nreverse articles)))
8020     (gnus-summary-position-point)))
8021
8022 (defun gnus-summary-limit-to-extra (header regexp &optional not-matching)
8023   "Limit the summary buffer to articles that match an 'extra' header."
8024   (interactive
8025    (let ((header
8026           (intern
8027            (gnus-completing-read-with-default
8028             (symbol-name (car gnus-extra-headers))
8029             (if current-prefix-arg
8030                 "Exclude extra header"
8031               "Limit extra header")
8032             (mapcar (lambda (x)
8033                       (cons (symbol-name x) x))
8034                     gnus-extra-headers)
8035             nil
8036             t))))
8037      (list header
8038            (read-string (format "%s header %s (regexp): "
8039                                 (if current-prefix-arg "Exclude" "Limit to")
8040                                 header))
8041            current-prefix-arg)))
8042   (when (not (equal "" regexp))
8043     (prog1
8044         (let ((articles (gnus-summary-find-matching
8045                          (cons 'extra header) regexp 'all nil nil
8046                          not-matching)))
8047           (unless articles
8048             (error "Found no matches for \"%s\"" regexp))
8049           (gnus-summary-limit articles))
8050       (gnus-summary-position-point))))
8051
8052 (defun gnus-summary-limit-to-display-predicate ()
8053   "Limit the summary buffer to the predicated in the `display' group parameter."
8054   (interactive)
8055   (unless gnus-newsgroup-display
8056     (error "There is no `display' group parameter"))
8057   (let (articles)
8058     (dolist (number gnus-newsgroup-articles)
8059       (when (funcall gnus-newsgroup-display)
8060         (push number articles)))
8061     (gnus-summary-limit articles))
8062   (gnus-summary-position-point))
8063
8064 (defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
8065 (make-obsolete
8066  'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
8067
8068 (defun gnus-summary-limit-to-unread (&optional all)
8069   "Limit the summary buffer to articles that are not marked as read.
8070 If ALL is non-nil, limit strictly to unread articles."
8071   (interactive "P")
8072   (if all
8073       (gnus-summary-limit-to-marks (char-to-string gnus-unread-mark))
8074     (gnus-summary-limit-to-marks
8075      ;; Concat all the marks that say that an article is read and have
8076      ;; those removed.
8077      (list gnus-del-mark gnus-read-mark gnus-ancient-mark
8078            gnus-killed-mark gnus-spam-mark gnus-kill-file-mark
8079            gnus-low-score-mark gnus-expirable-mark
8080            gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark
8081            gnus-duplicate-mark gnus-souped-mark)
8082      'reverse)))
8083
8084 (defun gnus-summary-limit-to-headers (match &optional reverse)
8085   "Limit the summary buffer to articles that have headers that match MATCH.
8086 If REVERSE (the prefix), limit to articles that don't match."
8087   (interactive "sMatch headers (regexp): \nP")
8088   (gnus-summary-limit-to-bodies match reverse t))
8089
8090 (defun gnus-summary-limit-to-bodies (match &optional reverse headersp)
8091   "Limit the summary buffer to articles that have bodies that match MATCH.
8092 If REVERSE (the prefix), limit to articles that don't match."
8093   (interactive "sMatch body (regexp): \nP")
8094   (let ((articles nil)
8095         (gnus-select-article-hook nil)  ;Disable hook.
8096         (gnus-article-prepare-hook nil)
8097         (gnus-use-article-prefetch nil)
8098         (gnus-keep-backlog nil)
8099         (gnus-break-pages nil)
8100         (gnus-summary-display-arrow nil)
8101         (gnus-updated-mode-lines nil)
8102         (gnus-auto-center-summary nil)
8103         (gnus-display-mime-function nil))
8104     (dolist (data gnus-newsgroup-data)
8105       (let (gnus-mark-article-hook)
8106         (gnus-summary-select-article t t nil (gnus-data-number data)))
8107       (save-excursion
8108         (set-buffer gnus-article-buffer)
8109         (article-goto-body)
8110         (let* ((case-fold-search t)
8111                (found (if headersp
8112                           (re-search-backward match nil t)
8113                         (re-search-forward match nil t))))
8114           (when (or (and found
8115                          (not reverse))
8116                     (and (not found)
8117                          reverse))
8118             (push (gnus-data-number data) articles)))))
8119     (if (not articles)
8120         (message "No messages matched")
8121       (gnus-summary-limit articles)))
8122   (gnus-summary-position-point))
8123
8124 (defun gnus-summary-limit-to-singletons (&optional threadsp)
8125   "Limit the summary buffer to articles that aren't part on any thread.
8126 If THREADSP (the prefix), limit to articles that are in threads."
8127   (interactive "P")
8128   (let ((articles nil)
8129         thread-articles
8130         threads)
8131     (dolist (thread gnus-newsgroup-threads)
8132       (if (stringp (car thread))
8133           (dolist (thread (cdr thread))
8134             (push thread threads))
8135         (push thread threads)))
8136     (dolist (thread threads)
8137       (setq thread-articles (gnus-articles-in-thread thread))
8138       (when (or (and threadsp
8139                      (> (length thread-articles) 1))
8140                 (and (not threadsp)
8141                      (= (length thread-articles) 1)))
8142         (setq articles (nconc thread-articles articles))))
8143     (if (not articles)
8144         (message "No messages matched")
8145       (gnus-summary-limit articles))
8146     (gnus-summary-position-point)))
8147
8148 (defun gnus-summary-limit-to-replied (&optional unreplied)
8149   "Limit the summary buffer to replied articles.
8150 If UNREPLIED (the prefix), limit to unreplied articles."
8151   (interactive "P")
8152   (if unreplied
8153       (gnus-summary-limit
8154        (gnus-set-difference gnus-newsgroup-articles
8155         gnus-newsgroup-replied))
8156     (gnus-summary-limit gnus-newsgroup-replied))
8157   (gnus-summary-position-point))
8158
8159 (defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-exclude-marks)
8160 (make-obsolete 'gnus-summary-delete-marked-with
8161                'gnus-summary-limit-exclude-marks)
8162
8163 (defun gnus-summary-limit-exclude-marks (marks &optional reverse)
8164   "Exclude articles that are marked with MARKS (e.g. \"DK\").
8165 If REVERSE, limit the summary buffer to articles that are marked
8166 with MARKS.  MARKS can either be a string of marks or a list of marks.
8167 Returns how many articles were removed."
8168   (interactive "sMarks: ")
8169   (gnus-summary-limit-to-marks marks t))
8170
8171 (defun gnus-summary-limit-to-marks (marks &optional reverse)
8172   "Limit the summary buffer to articles that are marked with MARKS (e.g. \"DK\").
8173 If REVERSE (the prefix), limit the summary buffer to articles that are
8174 not marked with MARKS.  MARKS can either be a string of marks or a
8175 list of marks.
8176 Returns how many articles were removed."
8177   (interactive "sMarks: \nP")
8178   (prog1
8179       (let ((data gnus-newsgroup-data)
8180             (marks (if (listp marks) marks
8181                      (append marks nil))) ; Transform to list.
8182             articles)
8183         (while data
8184           (when (if reverse (not (memq (gnus-data-mark (car data)) marks))
8185                   (memq (gnus-data-mark (car data)) marks))
8186             (push (gnus-data-number (car data)) articles))
8187           (setq data (cdr data)))
8188         (gnus-summary-limit articles))
8189     (gnus-summary-position-point)))
8190
8191 (defun gnus-summary-limit-to-score (score)
8192   "Limit to articles with score at or above SCORE."
8193   (interactive "NLimit to articles with score of at least: ")
8194   (let ((data gnus-newsgroup-data)
8195         articles)
8196     (while data
8197       (when (>= (gnus-summary-article-score (gnus-data-number (car data)))
8198                 score)
8199         (push (gnus-data-number (car data)) articles))
8200       (setq data (cdr data)))
8201     (prog1
8202         (gnus-summary-limit articles)
8203       (gnus-summary-position-point))))
8204
8205 (defun gnus-summary-limit-to-unseen ()
8206   "Limit to unseen articles."
8207   (interactive)
8208   (prog1
8209       (gnus-summary-limit gnus-newsgroup-unseen)
8210     (gnus-summary-position-point)))
8211
8212 (defun gnus-summary-limit-include-thread (id)
8213   "Display all the hidden articles that is in the thread with ID in it.
8214 When called interactively, ID is the Message-ID of the current
8215 article."
8216   (interactive (list (mail-header-id (gnus-summary-article-header))))
8217   (let ((articles (gnus-articles-in-thread
8218                    (gnus-id-to-thread (gnus-root-id id)))))
8219     (prog1
8220         (gnus-summary-limit (nconc articles gnus-newsgroup-limit))
8221       (gnus-summary-limit-include-matching-articles
8222        "subject"
8223        (regexp-quote (gnus-simplify-subject-re
8224                       (mail-header-subject (gnus-id-to-header id)))))
8225       (gnus-summary-position-point))))
8226
8227 (defun gnus-summary-limit-include-matching-articles (header regexp)
8228   "Display all the hidden articles that have HEADERs that match REGEXP."
8229   (interactive (list (read-string "Match on header: ")
8230                      (read-string "Regexp: ")))
8231   (let ((articles (gnus-find-matching-articles header regexp)))
8232     (prog1
8233         (gnus-summary-limit (nconc articles gnus-newsgroup-limit))
8234       (gnus-summary-position-point))))
8235
8236 (defun gnus-summary-insert-dormant-articles ()
8237   "Insert all the dormant articles for this group into the current buffer."
8238   (interactive)
8239   (let ((gnus-verbose (max 6 gnus-verbose)))
8240     (if (not gnus-newsgroup-dormant)
8241         (gnus-message 3 "No dormant articles for this group")
8242       (gnus-summary-goto-subjects gnus-newsgroup-dormant))))
8243
8244 (defun gnus-summary-insert-ticked-articles ()
8245   "Insert ticked articles for this group into the current buffer."
8246   (interactive)
8247   (let ((gnus-verbose (max 6 gnus-verbose)))
8248     (if (not gnus-newsgroup-marked)
8249         (gnus-message 3 "No ticked articles for this group")
8250       (gnus-summary-goto-subjects gnus-newsgroup-marked))))
8251
8252 (defun gnus-summary-limit-include-dormant ()
8253   "Display all the hidden articles that are marked as dormant.
8254 Note that this command only works on a subset of the articles currently
8255 fetched for this group."
8256   (interactive)
8257   (unless gnus-newsgroup-dormant
8258     (error "There are no dormant articles in this group"))
8259   (prog1
8260       (gnus-summary-limit (append gnus-newsgroup-dormant gnus-newsgroup-limit))
8261     (gnus-summary-position-point)))
8262
8263 (defun gnus-summary-limit-exclude-dormant ()
8264   "Hide all dormant articles."
8265   (interactive)
8266   (prog1
8267       (gnus-summary-limit-to-marks (list gnus-dormant-mark) 'reverse)
8268     (gnus-summary-position-point)))
8269
8270 (defun gnus-summary-limit-exclude-childless-dormant ()
8271   "Hide all dormant articles that have no children."
8272   (interactive)
8273   (let ((data (gnus-data-list t))
8274         articles d children)
8275     ;; Find all articles that are either not dormant or have
8276     ;; children.
8277     (while (setq d (pop data))
8278       (when (or (not (= (gnus-data-mark d) gnus-dormant-mark))
8279                 (and (setq children
8280                            (gnus-article-children (gnus-data-number d)))
8281                      (let (found)
8282                        (while children
8283                          (when (memq (car children) articles)
8284                            (setq children nil
8285                                  found t))
8286                          (pop children))
8287                        found)))
8288         (push (gnus-data-number d) articles)))
8289     ;; Do the limiting.
8290     (prog1
8291         (gnus-summary-limit articles)
8292       (gnus-summary-position-point))))
8293
8294 (defun gnus-summary-limit-mark-excluded-as-read (&optional all)
8295   "Mark all unread excluded articles as read.
8296 If ALL, mark even excluded ticked and dormants as read."
8297   (interactive "P")
8298   (setq gnus-newsgroup-limit (sort gnus-newsgroup-limit '<))
8299   (let ((articles (gnus-sorted-ndifference
8300                    (sort
8301                     (mapcar (lambda (h) (mail-header-number h))
8302                             gnus-newsgroup-headers)
8303                     '<)
8304                    gnus-newsgroup-limit))
8305         article)
8306     (setq gnus-newsgroup-unreads
8307           (gnus-sorted-intersection gnus-newsgroup-unreads
8308                                     gnus-newsgroup-limit))
8309     (if all
8310         (setq gnus-newsgroup-dormant nil
8311               gnus-newsgroup-marked nil
8312               gnus-newsgroup-reads
8313               (nconc
8314                (mapcar (lambda (n) (cons n gnus-catchup-mark)) articles)
8315                gnus-newsgroup-reads))
8316       (while (setq article (pop articles))
8317         (unless (or (memq article gnus-newsgroup-dormant)
8318                     (memq article gnus-newsgroup-marked))
8319           (push (cons article gnus-catchup-mark) gnus-newsgroup-reads))))))
8320
8321 (defun gnus-summary-limit (articles &optional pop)
8322   (if pop
8323       ;; We pop the previous limit off the stack and use that.
8324       (setq articles (car gnus-newsgroup-limits)
8325             gnus-newsgroup-limits (cdr gnus-newsgroup-limits))
8326     ;; We use the new limit, so we push the old limit on the stack.
8327     (push gnus-newsgroup-limit gnus-newsgroup-limits))
8328   ;; Set the limit.
8329   (setq gnus-newsgroup-limit articles)
8330   (let ((total (length gnus-newsgroup-data))
8331         (data (gnus-data-find-list (gnus-summary-article-number)))
8332         (gnus-summary-mark-below nil)   ; Inhibit this.
8333         found)
8334     ;; This will do all the work of generating the new summary buffer
8335     ;; according to the new limit.
8336     (gnus-summary-prepare)
8337     ;; Hide any threads, possibly.
8338     (gnus-summary-maybe-hide-threads)
8339     ;; Try to return to the article you were at, or one in the
8340     ;; neighborhood.
8341     (when data
8342       ;; We try to find some article after the current one.
8343       (while data
8344         (when (gnus-summary-goto-subject (gnus-data-number (car data)) nil t)
8345           (setq data nil
8346                 found t))
8347         (setq data (cdr data))))
8348     (unless found
8349       ;; If there is no data, that means that we were after the last
8350       ;; article.  The same goes when we can't find any articles
8351       ;; after the current one.
8352       (goto-char (point-max))
8353       (gnus-summary-find-prev))
8354     (gnus-set-mode-line 'summary)
8355     ;; We return how many articles were removed from the summary
8356     ;; buffer as a result of the new limit.
8357     (- total (length gnus-newsgroup-data))))
8358
8359 (defsubst gnus-invisible-cut-children (threads)
8360   (let ((num 0))
8361     (while threads
8362       (when (memq (mail-header-number (caar threads)) gnus-newsgroup-limit)
8363         (incf num))
8364       (pop threads))
8365     (< num 2)))
8366
8367 (defsubst gnus-cut-thread (thread)
8368   "Go forwards in the thread until we find an article that we want to display."
8369   (when (or (eq gnus-fetch-old-headers 'some)
8370             (eq gnus-fetch-old-headers 'invisible)
8371             (numberp gnus-fetch-old-headers)
8372             (eq gnus-build-sparse-threads 'some)
8373             (eq gnus-build-sparse-threads 'more))
8374     ;; Deal with old-fetched headers and sparse threads.
8375     (while (and
8376             thread
8377             (or
8378              (gnus-summary-article-sparse-p (mail-header-number (car thread)))
8379              (gnus-summary-article-ancient-p
8380               (mail-header-number (car thread))))
8381             (if (or (<= (length (cdr thread)) 1)
8382                     (eq gnus-fetch-old-headers 'invisible))
8383                 (setq gnus-newsgroup-limit
8384                       (delq (mail-header-number (car thread))
8385                             gnus-newsgroup-limit)
8386                       thread (cadr thread))
8387               (when (gnus-invisible-cut-children (cdr thread))
8388                 (let ((th (cdr thread)))
8389                   (while th
8390                     (if (memq (mail-header-number (caar th))
8391                               gnus-newsgroup-limit)
8392                         (setq thread (car th)
8393                               th nil)
8394                       (setq th (cdr th))))))))))
8395   thread)
8396
8397 (defun gnus-cut-threads (threads)
8398   "Cut off all uninteresting articles from the beginning of THREADS."
8399   (when (or (eq gnus-fetch-old-headers 'some)
8400             (eq gnus-fetch-old-headers 'invisible)
8401             (numberp gnus-fetch-old-headers)
8402             (eq gnus-build-sparse-threads 'some)
8403             (eq gnus-build-sparse-threads 'more))
8404     (let ((th threads))
8405       (while th
8406         (setcar th (gnus-cut-thread (car th)))
8407         (setq th (cdr th)))))
8408   ;; Remove nixed out threads.
8409   (delq nil threads))
8410
8411 (defun gnus-summary-initial-limit (&optional show-if-empty)
8412   "Figure out what the initial limit is supposed to be on group entry.
8413 This entails weeding out unwanted dormants, low-scored articles,
8414 fetch-old-headers verbiage, and so on."
8415   ;; Most groups have nothing to remove.
8416   (if (or gnus-inhibit-limiting
8417           (and (null gnus-newsgroup-dormant)
8418                (eq gnus-newsgroup-display 'gnus-not-ignore)
8419                (not (eq gnus-fetch-old-headers 'some))
8420                (not (numberp gnus-fetch-old-headers))
8421                (not (eq gnus-fetch-old-headers 'invisible))
8422                (null gnus-summary-expunge-below)
8423                (not (eq gnus-build-sparse-threads 'some))
8424                (not (eq gnus-build-sparse-threads 'more))
8425                (null gnus-thread-expunge-below)
8426                (not gnus-use-nocem)))
8427       ()                                ; Do nothing.
8428     (push gnus-newsgroup-limit gnus-newsgroup-limits)
8429     (setq gnus-newsgroup-limit nil)
8430     (mapatoms
8431      (lambda (node)
8432        (unless (car (symbol-value node))
8433          ;; These threads have no parents -- they are roots.
8434          (let ((nodes (cdr (symbol-value node)))
8435                thread)
8436            (while nodes
8437              (if (and gnus-thread-expunge-below
8438                       (< (gnus-thread-total-score (car nodes))
8439                          gnus-thread-expunge-below))
8440                  (gnus-expunge-thread (pop nodes))
8441                (setq thread (pop nodes))
8442                (gnus-summary-limit-children thread))))))
8443      gnus-newsgroup-dependencies)
8444     ;; If this limitation resulted in an empty group, we might
8445     ;; pop the previous limit and use it instead.
8446     (when (and (not gnus-newsgroup-limit)
8447                show-if-empty)
8448       (setq gnus-newsgroup-limit (pop gnus-newsgroup-limits)))
8449     gnus-newsgroup-limit))
8450
8451 (defun gnus-summary-limit-children (thread)
8452   "Return 1 if this subthread is visible and 0 if it is not."
8453   ;; First we get the number of visible children to this thread.  This
8454   ;; is done by recursing down the thread using this function, so this
8455   ;; will really go down to a leaf article first, before slowly
8456   ;; working its way up towards the root.
8457   (when thread
8458     (let* ((max-lisp-eval-depth (max 5000 max-lisp-eval-depth))
8459            (children
8460            (if (cdr thread)
8461                (apply '+ (mapcar 'gnus-summary-limit-children
8462                                  (cdr thread)))
8463              0))
8464           (number (mail-header-number (car thread)))
8465           score)
8466       (if (and
8467            (not (memq number gnus-newsgroup-marked))
8468            (or
8469             ;; If this article is dormant and has absolutely no visible
8470             ;; children, then this article isn't visible.
8471             (and (memq number gnus-newsgroup-dormant)
8472                  (zerop children))
8473             ;; If this is "fetch-old-headered" and there is no
8474             ;; visible children, then we don't want this article.
8475             (and (or (eq gnus-fetch-old-headers 'some)
8476                      (numberp gnus-fetch-old-headers))
8477                  (gnus-summary-article-ancient-p number)
8478                  (zerop children))
8479             ;; If this is "fetch-old-headered" and `invisible', then
8480             ;; we don't want this article.
8481             (and (eq gnus-fetch-old-headers 'invisible)
8482                  (gnus-summary-article-ancient-p number))
8483             ;; If this is a sparsely inserted article with no children,
8484             ;; we don't want it.
8485             (and (eq gnus-build-sparse-threads 'some)
8486                  (gnus-summary-article-sparse-p number)
8487                  (zerop children))
8488             ;; If we use expunging, and this article is really
8489             ;; low-scored, then we don't want this article.
8490             (when (and gnus-summary-expunge-below
8491                        (< (setq score
8492                                 (or (cdr (assq number gnus-newsgroup-scored))
8493                                     gnus-summary-default-score))
8494                           gnus-summary-expunge-below))
8495               ;; We increase the expunge-tally here, but that has
8496               ;; nothing to do with the limits, really.
8497               (incf gnus-newsgroup-expunged-tally)
8498               ;; We also mark as read here, if that's wanted.
8499               (when (and gnus-summary-mark-below
8500                          (< score gnus-summary-mark-below))
8501                 (setq gnus-newsgroup-unreads
8502                       (delq number gnus-newsgroup-unreads))
8503                 (if gnus-newsgroup-auto-expire
8504                     (push number gnus-newsgroup-expirable)
8505                   (push (cons number gnus-low-score-mark)
8506                         gnus-newsgroup-reads)))
8507               t)
8508             ;; Do the `display' group parameter.
8509             (and gnus-newsgroup-display
8510                  (not (funcall gnus-newsgroup-display)))
8511             ;; Check NoCeM things.
8512             (when (and gnus-use-nocem
8513                        (gnus-nocem-unwanted-article-p
8514                         (mail-header-id (car thread))))
8515               (setq gnus-newsgroup-unreads
8516                     (delq number gnus-newsgroup-unreads))
8517               t)))
8518           ;; Nope, invisible article.
8519           0
8520         ;; Ok, this article is to be visible, so we add it to the limit
8521         ;; and return 1.
8522         (push number gnus-newsgroup-limit)
8523         1))))
8524
8525 (defun gnus-expunge-thread (thread)
8526   "Mark all articles in THREAD as read."
8527   (let* ((number (mail-header-number (car thread))))
8528     (incf gnus-newsgroup-expunged-tally)
8529     ;; We also mark as read here, if that's wanted.
8530     (setq gnus-newsgroup-unreads
8531           (delq number gnus-newsgroup-unreads))
8532     (if gnus-newsgroup-auto-expire
8533         (push number gnus-newsgroup-expirable)
8534       (push (cons number gnus-low-score-mark)
8535             gnus-newsgroup-reads)))
8536   ;; Go recursively through all subthreads.
8537   (mapcar 'gnus-expunge-thread (cdr thread)))
8538
8539 ;; Summary article oriented commands
8540
8541 (defun gnus-summary-refer-parent-article (n)
8542   "Refer parent article N times.
8543 If N is negative, go to ancestor -N instead.
8544 The difference between N and the number of articles fetched is returned."
8545   (interactive "p")
8546   (let ((skip 1)
8547         error header ref)
8548     (when (not (natnump n))
8549       (setq skip (abs n)
8550             n 1))
8551     (while (and (> n 0)
8552                 (not error))
8553       (setq header (gnus-summary-article-header))
8554       (if (and (eq (mail-header-number header)
8555                    (cdr gnus-article-current))
8556                (equal gnus-newsgroup-name
8557                       (car gnus-article-current)))
8558           ;; If we try to find the parent of the currently
8559           ;; displayed article, then we take a look at the actual
8560           ;; References header, since this is slightly more
8561           ;; reliable than the References field we got from the
8562           ;; server.
8563           (save-excursion
8564             (set-buffer gnus-original-article-buffer)
8565             (nnheader-narrow-to-headers)
8566             (unless (setq ref (message-fetch-field "references"))
8567               (when (setq ref (message-fetch-field "in-reply-to"))
8568                 (setq ref (gnus-extract-message-id-from-in-reply-to ref))))
8569             (widen))
8570         (setq ref
8571               ;; It's not the current article, so we take a bet on
8572               ;; the value we got from the server.
8573               (mail-header-references header)))
8574       (if (and ref
8575                (not (equal ref "")))
8576           (unless (gnus-summary-refer-article (gnus-parent-id ref skip))
8577             (gnus-message 1 "Couldn't find parent"))
8578         (gnus-message 1 "No references in article %d"
8579                       (gnus-summary-article-number))
8580         (setq error t))
8581       (decf n))
8582     (gnus-summary-position-point)
8583     n))
8584
8585 (defun gnus-summary-refer-references ()
8586   "Fetch all articles mentioned in the References header.
8587 Return the number of articles fetched."
8588   (interactive)
8589   (let ((ref (mail-header-references (gnus-summary-article-header)))
8590         (current (gnus-summary-article-number))
8591         (n 0))
8592     (if (or (not ref)
8593             (equal ref ""))
8594         (error "No References in the current article")
8595       ;; For each Message-ID in the References header...
8596       (while (string-match "<[^>]*>" ref)
8597         (incf n)
8598         ;; ... fetch that article.
8599         (gnus-summary-refer-article
8600          (prog1 (match-string 0 ref)
8601            (setq ref (substring ref (match-end 0))))))
8602       (gnus-summary-goto-subject current)
8603       (gnus-summary-position-point)
8604       n)))
8605
8606 (defun gnus-summary-refer-thread (&optional limit)
8607   "Fetch all articles in the current thread.
8608 If LIMIT (the numerical prefix), fetch that many old headers instead
8609 of what's specified by the `gnus-refer-thread-limit' variable."
8610   (interactive "P")
8611   (let ((id (mail-header-id (gnus-summary-article-header)))
8612         (limit (if limit (prefix-numeric-value limit)
8613                  gnus-refer-thread-limit)))
8614     (unless (eq gnus-fetch-old-headers 'invisible)
8615       (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name)
8616       ;; Retrieve the headers and read them in.
8617       (if (eq (if (numberp limit)
8618                   (gnus-retrieve-headers
8619                    (list (min
8620                           (+ (mail-header-number
8621                               (gnus-summary-article-header))
8622                              limit)
8623                           gnus-newsgroup-end))
8624                    gnus-newsgroup-name (* limit 2))
8625                 ;; gnus-refer-thread-limit is t, i.e. fetch _all_
8626                 ;; headers.
8627                 (gnus-retrieve-headers (list gnus-newsgroup-end)
8628                                        gnus-newsgroup-name limit))
8629               'nov)
8630           (gnus-build-all-threads)
8631         (error "Can't fetch thread from back ends that don't support NOV"))
8632       (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name))
8633     (gnus-summary-limit-include-thread id)))
8634
8635 (defun gnus-summary-refer-article (message-id)
8636   "Fetch an article specified by MESSAGE-ID."
8637   (interactive "sMessage-ID: ")
8638   (when (and (stringp message-id)
8639              (not (zerop (length message-id))))
8640     (setq message-id (gnus-replace-in-string message-id " " ""))
8641     ;; Construct the correct Message-ID if necessary.
8642     ;; Suggested by tale@pawl.rpi.edu.
8643     (unless (string-match "^<" message-id)
8644       (setq message-id (concat "<" message-id)))
8645     (unless (string-match ">$" message-id)
8646       (setq message-id (concat message-id ">")))
8647     ;; People often post MIDs from URLs, so unhex it:
8648     (unless (string-match "@" message-id)
8649       (setq message-id (gnus-url-unhex-string message-id)))
8650     (let* ((header (gnus-id-to-header message-id))
8651            (sparse (and header
8652                         (gnus-summary-article-sparse-p
8653                          (mail-header-number header))
8654                         (memq (mail-header-number header)
8655                               gnus-newsgroup-limit)))
8656            number)
8657       (cond
8658        ;; If the article is present in the buffer we just go to it.
8659        ((and header
8660              (or (not (gnus-summary-article-sparse-p
8661                        (mail-header-number header)))
8662                  sparse))
8663         (prog1
8664             (gnus-summary-goto-article
8665              (mail-header-number header) nil t)
8666           (when sparse
8667             (gnus-summary-update-article (mail-header-number header)))))
8668        (t
8669         ;; We fetch the article.
8670         (catch 'found
8671           (dolist (gnus-override-method (gnus-refer-article-methods))
8672             (when (and (gnus-check-server gnus-override-method)
8673                        ;; Fetch the header,
8674                        (setq number (gnus-summary-insert-subject message-id)))
8675               ;; and display the article.
8676               (gnus-summary-select-article nil nil nil number)
8677               (throw 'found t)))
8678           (gnus-message 3 "Couldn't fetch article %s" message-id)))))))
8679
8680 (defun gnus-refer-article-methods ()
8681   "Return a list of referable methods."
8682   (cond
8683    ;; No method, so we default to current and native.
8684    ((null gnus-refer-article-method)
8685     (list gnus-current-select-method gnus-select-method))
8686    ;; Current.
8687    ((eq 'current gnus-refer-article-method)
8688     (list gnus-current-select-method))
8689    ;; List of select methods.
8690    ((not (and (symbolp (car gnus-refer-article-method))
8691               (assq (car gnus-refer-article-method) nnoo-definition-alist)))
8692     (let (out)
8693       (dolist (method gnus-refer-article-method)
8694         (push (if (eq 'current method)
8695                   gnus-current-select-method
8696                 method)
8697               out))
8698       (nreverse out)))
8699    ;; One single select method.
8700    (t
8701     (list gnus-refer-article-method))))
8702
8703 (defun gnus-summary-edit-parameters ()
8704   "Edit the group parameters of the current group."
8705   (interactive)
8706   (gnus-group-edit-group gnus-newsgroup-name 'params))
8707
8708 (defun gnus-summary-customize-parameters ()
8709   "Customize the group parameters of the current group."
8710   (interactive)
8711   (gnus-group-customize gnus-newsgroup-name))
8712
8713 (defun gnus-summary-enter-digest-group (&optional force)
8714   "Enter an nndoc group based on the current article.
8715 If FORCE, force a digest interpretation.  If not, try
8716 to guess what the document format is."
8717   (interactive "P")
8718   (let ((conf gnus-current-window-configuration))
8719     (save-window-excursion
8720       (save-excursion
8721         (let (gnus-article-prepare-hook
8722               gnus-display-mime-function
8723               gnus-break-pages)
8724           (gnus-summary-select-article))))
8725     (setq gnus-current-window-configuration conf)
8726     (let* ((name (format "%s-%d"
8727                          (gnus-group-prefixed-name
8728                           gnus-newsgroup-name (list 'nndoc ""))
8729                          (with-current-buffer gnus-summary-buffer
8730                            gnus-current-article)))
8731            (ogroup gnus-newsgroup-name)
8732            (params (append (gnus-info-params (gnus-get-info ogroup))
8733                            (list (cons 'to-group ogroup))
8734                            (list (cons 'parent-group ogroup))
8735                            (list (cons 'save-article-group ogroup))))
8736            (case-fold-search t)
8737            (buf (current-buffer))
8738            dig to-address)
8739       (save-excursion
8740         (set-buffer gnus-original-article-buffer)
8741         ;; Have the digest group inherit the main mail address of
8742         ;; the parent article.
8743         (when (setq to-address (or (gnus-fetch-field "reply-to")
8744                                    (gnus-fetch-field "from")))
8745           (setq params
8746                 (append
8747                  (list (cons 'to-address
8748                              (funcall gnus-decode-encoded-address-function
8749                                       to-address))))))
8750         (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*"))
8751         (insert-buffer-substring gnus-original-article-buffer)
8752         ;; Remove lines that may lead nndoc to misinterpret the
8753         ;; document type.
8754         (narrow-to-region
8755          (goto-char (point-min))
8756          (or (search-forward "\n\n" nil t) (point)))
8757         (goto-char (point-min))
8758         (delete-matching-lines "^Path:\\|^From ")
8759         (widen))
8760       (unwind-protect
8761           (if (let ((gnus-newsgroup-ephemeral-charset gnus-newsgroup-charset)
8762                     (gnus-newsgroup-ephemeral-ignored-charsets
8763                      gnus-newsgroup-ignored-charsets))
8764                 (gnus-group-read-ephemeral-group
8765                  name `(nndoc ,name (nndoc-address ,(get-buffer dig))
8766                               (nndoc-article-type
8767                                ,(if force 'mbox 'guess)))
8768                  t nil nil nil
8769                  `((adapt-file . ,(gnus-score-file-name gnus-newsgroup-name
8770                                                         "ADAPT")))))
8771               ;; Make all postings to this group go to the parent group.
8772               (nconc (gnus-info-params (gnus-get-info name))
8773                      params)
8774             ;; Couldn't select this doc group.
8775             (switch-to-buffer buf)
8776             (gnus-set-global-variables)
8777             (gnus-configure-windows 'summary)
8778             (gnus-message 3 "Article couldn't be entered?"))
8779         (kill-buffer dig)))))
8780
8781 (defun gnus-summary-read-document (n)
8782   "Open a new group based on the current article(s).
8783 This will allow you to read digests and other similar
8784 documents as newsgroups.
8785 Obeys the standard process/prefix convention."
8786   (interactive "P")
8787   (let* ((ogroup gnus-newsgroup-name)
8788          (params (append (gnus-info-params (gnus-get-info ogroup))
8789                          (list (cons 'to-group ogroup))))
8790          group egroup groups vgroup)
8791     (dolist (article (gnus-summary-work-articles n))
8792       (setq group (format "%s-%d" gnus-newsgroup-name article))
8793       (gnus-summary-remove-process-mark article)
8794       (when (gnus-summary-display-article article)
8795         (save-excursion
8796           (with-temp-buffer
8797             (insert-buffer-substring gnus-original-article-buffer)
8798             ;; Remove some headers that may lead nndoc to make
8799             ;; the wrong guess.
8800             (message-narrow-to-head)
8801             (goto-char (point-min))
8802             (delete-matching-lines "^Path:\\|^From ")
8803             (widen)
8804             (if (setq egroup
8805                       (gnus-group-read-ephemeral-group
8806                        group `(nndoc ,group (nndoc-address ,(current-buffer))
8807                                      (nndoc-article-type guess))
8808                        t nil t))
8809                 (progn
8810             ;; Make all postings to this group go to the parent group.
8811                   (nconc (gnus-info-params (gnus-get-info egroup))
8812                          params)
8813                   (push egroup groups))
8814               ;; Couldn't select this doc group.
8815               (gnus-error 3 "Article couldn't be entered"))))))
8816     ;; Now we have selected all the documents.
8817     (cond
8818      ((not groups)
8819       (error "None of the articles could be interpreted as documents"))
8820      ((gnus-group-read-ephemeral-group
8821        (setq vgroup (format
8822                      "nnvirtual:%s-%s" gnus-newsgroup-name
8823                      (format-time-string "%Y%m%dT%H%M%S" (current-time))))
8824        `(nnvirtual ,vgroup (nnvirtual-component-groups ,groups))
8825        t
8826        (cons (current-buffer) 'summary)))
8827      (t
8828       (error "Couldn't select virtual nndoc group")))))
8829
8830 (defun gnus-summary-isearch-article (&optional regexp-p)
8831   "Do incremental search forward on the current article.
8832 If REGEXP-P (the prefix) is non-nil, do regexp isearch."
8833   (interactive "P")
8834   (gnus-summary-select-article)
8835   (gnus-configure-windows 'article)
8836   (gnus-eval-in-buffer-window gnus-article-buffer
8837     (save-restriction
8838       (widen)
8839       (isearch-forward regexp-p))))
8840
8841 (defun gnus-summary-repeat-search-article-forward ()
8842   "Repeat the previous search forwards."
8843   (interactive)
8844   (unless gnus-last-search-regexp
8845     (error "No previous search"))
8846   (gnus-summary-search-article-forward gnus-last-search-regexp))
8847
8848 (defun gnus-summary-repeat-search-article-backward ()
8849   "Repeat the previous search backwards."
8850   (interactive)
8851   (unless gnus-last-search-regexp
8852     (error "No previous search"))
8853   (gnus-summary-search-article-forward gnus-last-search-regexp t))
8854
8855 (defun gnus-summary-search-article-forward (regexp &optional backward)
8856   "Search for an article containing REGEXP forward.
8857 If BACKWARD, search backward instead."
8858   (interactive
8859    (list (read-string
8860           (format "Search article %s (regexp%s): "
8861                   (if current-prefix-arg "backward" "forward")
8862                   (if gnus-last-search-regexp
8863                       (concat ", default " gnus-last-search-regexp)
8864                     "")))
8865          current-prefix-arg))
8866   (if (string-equal regexp "")
8867       (setq regexp (or gnus-last-search-regexp ""))
8868     (setq gnus-last-search-regexp regexp)
8869     (setq gnus-article-before-search gnus-current-article))
8870   ;; Intentionally set gnus-last-article.
8871   (setq gnus-last-article gnus-article-before-search)
8872   (let ((gnus-last-article gnus-last-article))
8873     (if (gnus-summary-search-article regexp backward)
8874         (gnus-summary-show-thread)
8875       (signal 'search-failed (list regexp)))))
8876
8877 (defun gnus-summary-search-article-backward (regexp)
8878   "Search for an article containing REGEXP backward."
8879   (interactive
8880    (list (read-string
8881           (format "Search article backward (regexp%s): "
8882                   (if gnus-last-search-regexp
8883                       (concat ", default " gnus-last-search-regexp)
8884                     "")))))
8885   (gnus-summary-search-article-forward regexp 'backward))
8886
8887 (defun gnus-summary-search-article (regexp &optional backward)
8888   "Search for an article containing REGEXP.
8889 Optional argument BACKWARD means do search for backward.
8890 `gnus-select-article-hook' is not called during the search."
8891   ;; We have to require this here to make sure that the following
8892   ;; dynamic binding isn't shadowed by autoloading.
8893   (require 'gnus-async)
8894   (require 'gnus-art)
8895   (let ((gnus-select-article-hook nil)  ;Disable hook.
8896         (gnus-article-prepare-hook nil)
8897         (gnus-mark-article-hook nil)    ;Inhibit marking as read.
8898         (gnus-use-article-prefetch nil)
8899         (gnus-xmas-force-redisplay nil) ;Inhibit XEmacs redisplay.
8900         (gnus-use-trees nil)            ;Inhibit updating tree buffer.
8901         (gnus-visual nil)
8902         (gnus-keep-backlog nil)
8903         (gnus-break-pages nil)
8904         (gnus-summary-display-arrow nil)
8905         (gnus-updated-mode-lines nil)
8906         (gnus-auto-center-summary nil)
8907         (sum (current-buffer))
8908         (gnus-display-mime-function nil)
8909         (found nil)
8910         point)
8911     (gnus-save-hidden-threads
8912       (gnus-summary-select-article)
8913       (set-buffer gnus-article-buffer)
8914       (goto-char (window-point (get-buffer-window (current-buffer))))
8915       (when backward
8916         (forward-line -1))
8917       (while (not found)
8918         (gnus-message 7 "Searching article: %d..." (cdr gnus-article-current))
8919         (if (if backward
8920                 (re-search-backward regexp nil t)
8921               (re-search-forward regexp nil t))
8922             ;; We found the regexp.
8923             (progn
8924               (setq found 'found)
8925               (beginning-of-line)
8926               (set-window-start
8927                (get-buffer-window (current-buffer))
8928                (point))
8929               (forward-line 1)
8930               (set-window-point
8931                (get-buffer-window (current-buffer))
8932                (point))
8933               (set-buffer sum)
8934               (setq point (point)))
8935           ;; We didn't find it, so we go to the next article.
8936           (set-buffer sum)
8937           (setq found 'not)
8938           (while (eq found 'not)
8939             (if (not (if backward (gnus-summary-find-prev)
8940                        (gnus-summary-find-next)))
8941                 ;; No more articles.
8942                 (setq found t)
8943               ;; Select the next article and adjust point.
8944               (unless (gnus-summary-article-sparse-p
8945                        (gnus-summary-article-number))
8946                 (setq found nil)
8947                 (gnus-summary-select-article)
8948                 (set-buffer gnus-article-buffer)
8949                 (widen)
8950                 (goto-char (if backward (point-max) (point-min))))))))
8951       (gnus-message 7 ""))
8952     ;; Return whether we found the regexp.
8953     (when (eq found 'found)
8954       (goto-char point)
8955       (gnus-summary-show-thread)
8956       (gnus-summary-goto-subject gnus-current-article)
8957       (gnus-summary-position-point)
8958       t)))
8959
8960 (defun gnus-find-matching-articles (header regexp)
8961   "Return a list of all articles that match REGEXP on HEADER.
8962 This search includes all articles in the current group that Gnus has
8963 fetched headers for, whether they are displayed or not."
8964   (let ((articles nil)
8965         (func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))
8966         (case-fold-search t))
8967     (dolist (header gnus-newsgroup-headers)
8968       (when (string-match regexp (funcall func header))
8969         (push (mail-header-number header) articles)))
8970     (nreverse articles)))
8971
8972 (defun gnus-summary-find-matching (header regexp &optional backward unread
8973                                           not-case-fold not-matching)
8974   "Return a list of all articles that match REGEXP on HEADER.
8975 The search stars on the current article and goes forwards unless
8976 BACKWARD is non-nil.  If BACKWARD is `all', do all articles.
8977 If UNREAD is non-nil, only unread articles will
8978 be taken into consideration.  If NOT-CASE-FOLD, case won't be folded
8979 in the comparisons. If NOT-MATCHING, return a list of all articles that
8980 not match REGEXP on HEADER."
8981   (let ((case-fold-search (not not-case-fold))
8982         articles d func)
8983     (if (consp header)
8984         (if (eq (car header) 'extra)
8985             (setq func
8986                   `(lambda (h)
8987                      (or (cdr (assq ',(cdr header) (mail-header-extra h)))
8988                          "")))
8989           (error "%s is an invalid header" header))
8990       (unless (fboundp (intern (concat "mail-header-" header)))
8991         (error "%s is not a valid header" header))
8992       (setq func `(lambda (h) (,(intern (concat "mail-header-" header)) h))))
8993     (dolist (d (if (eq backward 'all)
8994                    gnus-newsgroup-data
8995                  (gnus-data-find-list
8996                   (gnus-summary-article-number)
8997                   (gnus-data-list backward))))
8998       (when (and (or (not unread)       ; We want all articles...
8999                      (gnus-data-unread-p d)) ; Or just unreads.
9000                  (vectorp (gnus-data-header d)) ; It's not a pseudo.
9001                  (if not-matching
9002                      (not (string-match
9003                            regexp
9004                            (funcall func (gnus-data-header d))))
9005                    (string-match regexp
9006                                  (funcall func (gnus-data-header d)))))
9007         (push (gnus-data-number d) articles))) ; Success!
9008     (nreverse articles)))
9009
9010 (defun gnus-summary-execute-command (header regexp command &optional backward)
9011   "Search forward for an article whose HEADER matches REGEXP and execute COMMAND.
9012 If HEADER is an empty string (or nil), the match is done on the entire
9013 article.  If BACKWARD (the prefix) is non-nil, search backward instead."
9014   (interactive
9015    (list (let ((completion-ignore-case t))
9016            (completing-read
9017             "Header name: "
9018             (mapcar (lambda (header) (list (format "%s" header)))
9019                     (append
9020                      '("Number" "Subject" "From" "Lines" "Date"
9021                        "Message-ID" "Xref" "References" "Body")
9022                      gnus-extra-headers))
9023             nil 'require-match))
9024          (read-string "Regexp: ")
9025          (read-key-sequence "Command: ")
9026          current-prefix-arg))
9027   (when (equal header "Body")
9028     (setq header ""))
9029   ;; Hidden thread subtrees must be searched as well.
9030   (gnus-summary-show-all-threads)
9031   ;; We don't want to change current point nor window configuration.
9032   (save-excursion
9033     (save-window-excursion
9034       (let (gnus-visual
9035             gnus-treat-strip-trailing-blank-lines
9036             gnus-treat-strip-leading-blank-lines
9037             gnus-treat-strip-multiple-blank-lines
9038             gnus-treat-hide-boring-headers
9039             gnus-treat-fold-newsgroups
9040             gnus-article-prepare-hook)
9041         (gnus-message 6 "Executing %s..." (key-description command))
9042         ;; We'd like to execute COMMAND interactively so as to give arguments.
9043         (gnus-execute header regexp
9044                       `(call-interactively ',(key-binding command))
9045                       backward)
9046         (gnus-message 6 "Executing %s...done" (key-description command))))))
9047
9048 (defun gnus-summary-beginning-of-article ()
9049   "Scroll the article back to the beginning."
9050   (interactive)
9051   (gnus-summary-select-article)
9052   (gnus-configure-windows 'article)
9053   (gnus-eval-in-buffer-window gnus-article-buffer
9054     (widen)
9055     (goto-char (point-min))
9056     (when gnus-break-pages
9057       (gnus-narrow-to-page))))
9058
9059 (defun gnus-summary-end-of-article ()
9060   "Scroll to the end of the article."
9061   (interactive)
9062   (gnus-summary-select-article)
9063   (gnus-configure-windows 'article)
9064   (gnus-eval-in-buffer-window gnus-article-buffer
9065     (widen)
9066     (goto-char (point-max))
9067     (recenter -3)
9068     (when gnus-break-pages
9069       (when (re-search-backward page-delimiter nil t)
9070         (narrow-to-region (match-end 0) (point-max)))
9071       (gnus-narrow-to-page))))
9072
9073 (defun gnus-summary-print-truncate-and-quote (string &optional len)
9074   "Truncate to LEN and quote all \"(\"'s in STRING."
9075   (gnus-replace-in-string (if (and len (> (length string) len))
9076                               (substring string 0 len)
9077                             string)
9078                           "[()]" "\\\\\\&"))
9079
9080 (defun gnus-summary-print-article (&optional filename n)
9081   "Generate and print a PostScript image of the process-marked (mail) articles.
9082
9083 If used interactively, print the current article if none are
9084 process-marked.  With prefix arg, prompt the user for the name of the
9085 file to save in.
9086
9087 When used from Lisp, accept two optional args FILENAME and N.  N means
9088 to print the next N articles.  If N is negative, print the N previous
9089 articles.  If N is nil and articles have been marked with the process
9090 mark, print these instead.
9091
9092 If the optional first argument FILENAME is nil, send the image to the
9093 printer.  If FILENAME is a string, save the PostScript image in a file with
9094 that name.  If FILENAME is a number, prompt the user for the name of the file
9095 to save in."
9096   (interactive (list (ps-print-preprint current-prefix-arg)))
9097   (dolist (article (gnus-summary-work-articles n))
9098     (gnus-summary-select-article nil nil 'pseudo article)
9099     (gnus-eval-in-buffer-window gnus-article-buffer
9100       (gnus-print-buffer))
9101     (gnus-summary-remove-process-mark article))
9102   (ps-despool filename))
9103
9104 (defun gnus-print-buffer ()
9105   (let ((buffer (generate-new-buffer " *print*")))
9106     (unwind-protect
9107         (progn
9108           (copy-to-buffer buffer (point-min) (point-max))
9109           (set-buffer buffer)
9110           (gnus-remove-text-with-property 'gnus-decoration)
9111           (when (gnus-visual-p 'article-highlight 'highlight)
9112             ;; Copy-to-buffer doesn't copy overlay.  So redo
9113             ;; highlight.
9114             (let ((gnus-article-buffer buffer))
9115               (gnus-article-highlight-citation t)
9116               (gnus-article-highlight-signature)
9117               (gnus-article-emphasize)
9118               (gnus-article-delete-invisible-text)))
9119           (let ((ps-left-header
9120                  (list
9121                   (concat "("
9122                           (gnus-summary-print-truncate-and-quote
9123                            (mail-header-subject gnus-current-headers)
9124                            66) ")")
9125                   (concat "("
9126                           (gnus-summary-print-truncate-and-quote
9127                            (mail-header-from gnus-current-headers)
9128                            45) ")")))
9129                 (ps-right-header
9130                  (list
9131                   "/pagenumberstring load"
9132                   (concat "("
9133                           (mail-header-date gnus-current-headers) ")"))))
9134             (gnus-run-hooks 'gnus-ps-print-hook)
9135             (save-excursion
9136               (if window-system
9137                   (ps-spool-buffer-with-faces)
9138                 (ps-spool-buffer)))))
9139       (kill-buffer buffer))))
9140
9141 (defun gnus-summary-show-article (&optional arg)
9142   "Force redisplaying of the current article.
9143 If ARG (the prefix) is a number, show the article with the charset
9144 defined in `gnus-summary-show-article-charset-alist', or the charset
9145 input.
9146 If ARG (the prefix) is non-nil and not a number, show the raw article
9147 without any article massaging functions being run.  Normally, the key
9148 strokes are `C-u g'."
9149   (interactive "P")
9150   (cond
9151    ((numberp arg)
9152     (gnus-summary-show-article t)
9153     (let ((gnus-newsgroup-charset
9154            (or (cdr (assq arg gnus-summary-show-article-charset-alist))
9155                (mm-read-coding-system
9156                 "View as charset: " ;; actually it is coding system.
9157                 (with-current-buffer gnus-article-buffer
9158                   (mm-detect-coding-region (point) (point-max))))))
9159           (gnus-newsgroup-ignored-charsets 'gnus-all))
9160       (gnus-summary-select-article nil 'force)
9161       (let ((deps gnus-newsgroup-dependencies)
9162             head header lines)
9163         (save-excursion
9164           (set-buffer gnus-original-article-buffer)
9165           (save-restriction
9166             (message-narrow-to-head)
9167             (setq head (buffer-string))
9168             (goto-char (point-min))
9169             (unless (re-search-forward "^lines:[ \t]\\([0-9]+\\)" nil t)
9170               (goto-char (point-max))
9171               (widen)
9172               (setq lines (1- (count-lines (point) (point-max))))))
9173           (with-temp-buffer
9174             (insert (format "211 %d Article retrieved.\n"
9175                             (cdr gnus-article-current)))
9176             (insert head)
9177             (if lines (insert (format "Lines: %d\n" lines)))
9178             (insert ".\n")
9179             (let ((nntp-server-buffer (current-buffer)))
9180               (setq header (car (gnus-get-newsgroup-headers deps t))))))
9181         (gnus-data-set-header
9182          (gnus-data-find (cdr gnus-article-current))
9183          header)
9184         (gnus-summary-update-article-line
9185          (cdr gnus-article-current) header)
9186         (when (gnus-summary-goto-subject (cdr gnus-article-current) nil t)
9187           (gnus-summary-update-secondary-mark (cdr gnus-article-current))))))
9188    ((not arg)
9189     ;; Select the article the normal way.
9190     (gnus-summary-select-article nil 'force))
9191    (t
9192     ;; We have to require this here to make sure that the following
9193     ;; dynamic binding isn't shadowed by autoloading.
9194     (require 'gnus-async)
9195     (require 'gnus-art)
9196     ;; Bind the article treatment functions to nil.
9197     (let ((gnus-have-all-headers t)
9198           gnus-article-prepare-hook
9199           gnus-article-decode-hook
9200           gnus-display-mime-function
9201           gnus-break-pages)
9202       ;; Destroy any MIME parts.
9203       (when (gnus-buffer-live-p gnus-article-buffer)
9204         (save-excursion
9205           (set-buffer gnus-article-buffer)
9206           (mm-destroy-parts gnus-article-mime-handles)
9207           ;; Set it to nil for safety reason.
9208           (setq gnus-article-mime-handle-alist nil)
9209           (setq gnus-article-mime-handles nil)))
9210       (gnus-summary-select-article nil 'force))))
9211   (gnus-summary-goto-subject gnus-current-article)
9212   (gnus-summary-position-point))
9213
9214 (defun gnus-summary-show-raw-article ()
9215   "Show the raw article without any article massaging functions being run."
9216   (interactive)
9217   (gnus-summary-show-article t))
9218
9219 (defun gnus-summary-verbose-headers (&optional arg)
9220   "Toggle permanent full header display.
9221 If ARG is a positive number, turn header display on.
9222 If ARG is a negative number, turn header display off."
9223   (interactive "P")
9224   (setq gnus-show-all-headers
9225         (cond ((or (not (numberp arg))
9226                    (zerop arg))
9227                (not gnus-show-all-headers))
9228               ((natnump arg)
9229                t)))
9230   (gnus-summary-show-article))
9231
9232 (defun gnus-summary-toggle-header (&optional arg)
9233   "Show the headers if they are hidden, or hide them if they are shown.
9234 If ARG is a positive number, show the entire header.
9235 If ARG is a negative number, hide the unwanted header lines."
9236   (interactive "P")
9237   (let ((window (and (gnus-buffer-live-p gnus-article-buffer)
9238                      (get-buffer-window gnus-article-buffer t))))
9239     (with-current-buffer gnus-article-buffer
9240       (widen)
9241       (article-narrow-to-head)
9242       (let* ((buffer-read-only nil)
9243              (inhibit-point-motion-hooks t)
9244              (hidden (if (numberp arg)
9245                          (>= arg 0)
9246                        (or (not (looking-at "[^ \t\n]+:"))
9247                            (gnus-article-hidden-text-p 'headers))))
9248              s e)
9249         (delete-region (point-min) (point-max))
9250         (with-current-buffer gnus-original-article-buffer
9251           (goto-char (setq s (point-min)))
9252           (setq e (if (search-forward "\n\n" nil t)
9253                       (1- (point))
9254                     (point-max))))
9255         (insert-buffer-substring gnus-original-article-buffer s e)
9256         (run-hooks 'gnus-article-decode-hook)
9257         (if hidden
9258             (let ((gnus-treat-hide-headers nil)
9259                   (gnus-treat-hide-boring-headers nil))
9260               (gnus-delete-wash-type 'headers)
9261               (gnus-treat-article 'head))
9262           (gnus-treat-article 'head))
9263         (widen)
9264         (if window
9265             (set-window-start window (goto-char (point-min))))
9266         (if gnus-break-pages
9267             (gnus-narrow-to-page)
9268           (when (gnus-visual-p 'page-marker)
9269             (let ((buffer-read-only nil))
9270               (gnus-remove-text-with-property 'gnus-prev)
9271               (gnus-remove-text-with-property 'gnus-next))))
9272         (gnus-set-mode-line 'article)))))
9273
9274 (defun gnus-summary-show-all-headers ()
9275   "Make all header lines visible."
9276   (interactive)
9277   (gnus-summary-toggle-header 1))
9278
9279 (defun gnus-summary-caesar-message (&optional arg)
9280   "Caesar rotate the current article by 13.
9281 With a non-numerical prefix, also rotate headers.  A numerical
9282 prefix specifies how many places to rotate each letter forward."
9283   (interactive "P")
9284   (gnus-summary-select-article)
9285   (let ((mail-header-separator ""))
9286     (gnus-eval-in-buffer-window gnus-article-buffer
9287       (save-restriction
9288         (widen)
9289         (let ((start (window-start))
9290               buffer-read-only)
9291           (if (equal arg '(4))
9292               (message-caesar-buffer-body nil t)
9293             (message-caesar-buffer-body arg))
9294           (set-window-start (get-buffer-window (current-buffer)) start)))))
9295   ;; Create buttons and stuff...
9296   (gnus-treat-article nil))
9297
9298 (defun gnus-summary-idna-message (&optional arg)
9299   "Decode IDNA encoded domain names in the current articles.
9300 IDNA encoded domain names looks like `xn--bar'.  If a string
9301 remain unencoded after running this function, it is likely an
9302 invalid IDNA string (`xn--bar' is invalid).
9303
9304 You must have GNU Libidn (`http://www.gnu.org/software/libidn/')
9305 installed for this command to work."
9306   (interactive "P")
9307   (if (not (and (condition-case nil (require 'idna)
9308                   (file-error))
9309                 (mm-coding-system-p 'utf-8)
9310                 (executable-find (symbol-value 'idna-program))))
9311       (gnus-message
9312        5 "GNU Libidn not installed properly (`idn' or `idna.el' missing)")
9313     (gnus-summary-select-article)
9314     (let ((mail-header-separator ""))
9315       (gnus-eval-in-buffer-window gnus-article-buffer
9316         (save-restriction
9317           (widen)
9318           (let ((start (window-start))
9319                 buffer-read-only)
9320             (while (re-search-forward "\\(xn--[-0-9a-z]+\\)" nil t)
9321               (replace-match (idna-to-unicode (match-string 1))))
9322             (set-window-start (get-buffer-window (current-buffer)) start)))))))
9323
9324 (defun gnus-summary-morse-message (&optional arg)
9325   "Morse decode the current article."
9326   (interactive "P")
9327   (gnus-summary-select-article)
9328   (let ((mail-header-separator ""))
9329     (gnus-eval-in-buffer-window gnus-article-buffer
9330       (save-excursion
9331         (save-restriction
9332           (widen)
9333           (let ((pos (window-start))
9334                 buffer-read-only)
9335             (goto-char (point-min))
9336             (when (message-goto-body)
9337               (gnus-narrow-to-body))
9338             (goto-char (point-min))
9339             (while (search-forward "·" (point-max) t)
9340               (replace-match "."))
9341             (unmorse-region (point-min) (point-max))
9342             (widen)
9343             (set-window-start (get-buffer-window (current-buffer)) pos)))))))
9344
9345 (defun gnus-summary-stop-page-breaking ()
9346   "Stop page breaking in the current article."
9347   (interactive)
9348   (gnus-summary-select-article)
9349   (gnus-eval-in-buffer-window gnus-article-buffer
9350     (widen)
9351     (when (gnus-visual-p 'page-marker)
9352       (let ((buffer-read-only nil))
9353         (gnus-remove-text-with-property 'gnus-prev)
9354         (gnus-remove-text-with-property 'gnus-next))
9355       (setq gnus-page-broken nil))))
9356
9357 (defun gnus-summary-move-article (&optional n to-newsgroup
9358                                             select-method action)
9359   "Move the current article to a different newsgroup.
9360 If N is a positive number, move the N next articles.
9361 If N is a negative number, move the N previous articles.
9362 If N is nil and any articles have been marked with the process mark,
9363 move those articles instead.
9364 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to.
9365 If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but
9366 re-spool using this method.
9367
9368 When called interactively with TO-NEWSGROUP being nil, the value of
9369 the variable `gnus-move-split-methods' is used for finding a default
9370 for the target newsgroup.
9371
9372 For this function to work, both the current newsgroup and the
9373 newsgroup that you want to move to have to support the `request-move'
9374 and `request-accept' functions.
9375
9376 ACTION can be either `move' (the default), `crosspost' or `copy'."
9377   (interactive "P")
9378   (unless action
9379     (setq action 'move))
9380   ;; Check whether the source group supports the required functions.
9381   (cond ((and (eq action 'move)
9382               (not (gnus-check-backend-function
9383                     'request-move-article gnus-newsgroup-name)))
9384          (error "The current group does not support article moving"))
9385         ((and (eq action 'crosspost)
9386               (not (gnus-check-backend-function
9387                     'request-replace-article gnus-newsgroup-name)))
9388          (error "The current group does not support article editing")))
9389   (let ((articles (gnus-summary-work-articles n))
9390         (prefix (if (gnus-check-backend-function
9391                      'request-move-article gnus-newsgroup-name)
9392                     (funcall gnus-move-group-prefix-function
9393                              gnus-newsgroup-name)
9394                   ""))
9395         (names '((move "Move" "Moving")
9396                  (copy "Copy" "Copying")
9397                  (crosspost "Crosspost" "Crossposting")))
9398         (copy-buf (save-excursion
9399                     (nnheader-set-temp-buffer " *copy article*")))
9400         art-group to-method new-xref article to-groups articles-to-update-marks)
9401     (unless (assq action names)
9402       (error "Unknown action %s" action))
9403     ;; Read the newsgroup name.
9404     (when (and (not to-newsgroup)
9405                (not select-method))
9406       (if (and gnus-move-split-methods
9407                (not
9408                 (and (memq gnus-current-article articles)
9409                      (gnus-buffer-live-p gnus-original-article-buffer))))
9410           ;; When `gnus-move-split-methods' is non-nil, we have to
9411           ;; select an article to give `gnus-read-move-group-name' an
9412           ;; opportunity to suggest an appropriate default.  However,
9413           ;; we needn't render or mark the article.
9414           (let ((gnus-display-mime-function nil)
9415                 (gnus-article-prepare-hook nil)
9416                 (gnus-mark-article-hook nil))
9417             (gnus-summary-select-article nil nil nil (car articles))))
9418       (setq to-newsgroup
9419             (gnus-read-move-group-name
9420              (cadr (assq action names))
9421              (symbol-value (intern (format "gnus-current-%s-group" action)))
9422              articles prefix))
9423       (set (intern (format "gnus-current-%s-group" action)) to-newsgroup))
9424     (setq to-method (or select-method
9425                         (gnus-server-to-method
9426                          (gnus-group-method to-newsgroup))))
9427     ;; Check the method we are to move this article to...
9428     (unless (gnus-check-backend-function
9429              'request-accept-article (car to-method))
9430       (error "%s does not support article copying" (car to-method)))
9431     (unless (gnus-check-server to-method)
9432       (error "Can't open server %s" (car to-method)))
9433     (gnus-message 6 "%s to %s: %s..."
9434                   (caddr (assq action names))
9435                   (or (car select-method) to-newsgroup) articles)
9436     (while articles
9437       (setq article (pop articles))
9438       (setq
9439        art-group
9440        (cond
9441         ;; Move the article.
9442         ((eq action 'move)
9443          ;; Remove this article from future suppression.
9444          (gnus-dup-unsuppress-article article)
9445          (let* ((from-method (gnus-find-method-for-group
9446                               gnus-newsgroup-name))
9447                 (to-method (gnus-find-method-for-group
9448                             to-newsgroup))
9449                 (move-is-internal (gnus-method-equal from-method to-method)))
9450            (gnus-request-move-article
9451             article                     ; Article to move
9452             gnus-newsgroup-name         ; From newsgroup
9453             (nth 1 (gnus-find-method-for-group
9454                     gnus-newsgroup-name)) ; Server
9455             (list 'gnus-request-accept-article
9456                   to-newsgroup (list 'quote select-method)
9457                   (not articles) t)     ; Accept form
9458             (not articles)              ; Only save nov last time
9459             move-is-internal)))         ; is this move internal?
9460         ;; Copy the article.
9461         ((eq action 'copy)
9462          (save-excursion
9463            (set-buffer copy-buf)
9464            (when (gnus-request-article-this-buffer article gnus-newsgroup-name)
9465              (save-restriction
9466                (nnheader-narrow-to-headers)
9467                (dolist (hdr gnus-copy-article-ignored-headers)
9468                  (message-remove-header hdr t)))
9469              (gnus-request-accept-article
9470               to-newsgroup select-method (not articles) t))))
9471         ;; Crosspost the article.
9472         ((eq action 'crosspost)
9473          (let ((xref (message-tokenize-header
9474                       (mail-header-xref (gnus-summary-article-header article))
9475                       " ")))
9476            (setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name)
9477                                   ":" (number-to-string article)))
9478            (unless xref
9479              (setq xref (list (system-name))))
9480            (setq new-xref
9481                  (concat
9482                   (mapconcat 'identity
9483                              (delete "Xref:" (delete new-xref xref))
9484                              " ")
9485                   " " new-xref))
9486            (save-excursion
9487              (set-buffer copy-buf)
9488              ;; First put the article in the destination group.
9489              (gnus-request-article-this-buffer article gnus-newsgroup-name)
9490              (when (consp (setq art-group
9491                                 (gnus-request-accept-article
9492                                  to-newsgroup select-method (not articles) t)))
9493                (setq new-xref (concat new-xref " " (car art-group)
9494                                       ":"
9495                                       (number-to-string (cdr art-group))))
9496                ;; Now we have the new Xrefs header, so we insert
9497                ;; it and replace the new article.
9498                (nnheader-replace-header "Xref" new-xref)
9499                (gnus-request-replace-article
9500                 (cdr art-group) to-newsgroup (current-buffer) t)
9501                art-group))))))
9502       (cond
9503        ((not art-group)
9504         (gnus-message 1 "Couldn't %s article %s: %s"
9505                       (cadr (assq action names)) article
9506                       (nnheader-get-report (car to-method))))
9507        ((eq art-group 'junk)
9508         (when (eq action 'move)
9509           (gnus-summary-mark-article article gnus-canceled-mark)
9510           (gnus-message 4 "Deleted article %s" article)
9511           ;; run the delete hook
9512           (run-hook-with-args 'gnus-summary-article-delete-hook
9513                               action
9514                               (gnus-data-header
9515                                (assoc article (gnus-data-list nil)))
9516                               gnus-newsgroup-name nil
9517                               select-method)))
9518        (t
9519         (let* ((pto-group (gnus-group-prefixed-name
9520                            (car art-group) to-method))
9521                (info (gnus-get-info pto-group))
9522                (to-group (gnus-info-group info))
9523                to-marks)
9524           ;; Update the group that has been moved to.
9525           (when (and info
9526                      (memq action '(move copy)))
9527             (unless (member to-group to-groups)
9528               (push to-group to-groups))
9529
9530             (unless (memq article gnus-newsgroup-unreads)
9531               (push 'read to-marks)
9532               (gnus-info-set-read
9533                info (gnus-add-to-range (gnus-info-read info)
9534                                        (list (cdr art-group)))))
9535
9536             ;; See whether the article is to be put in the cache.
9537             (let ((marks (if (gnus-group-auto-expirable-p to-group)
9538                              gnus-article-mark-lists
9539                            (delete '(expirable . expire)
9540                                    (copy-sequence gnus-article-mark-lists))))
9541                   (to-article (cdr art-group)))
9542
9543               ;; Enter the article into the cache in the new group,
9544               ;; if that is required.
9545               (when gnus-use-cache
9546                 (gnus-cache-possibly-enter-article
9547                  to-group to-article
9548                  (memq article gnus-newsgroup-marked)
9549                  (memq article gnus-newsgroup-dormant)
9550                  (memq article gnus-newsgroup-unreads)))
9551
9552               (when gnus-preserve-marks
9553                 ;; Copy any marks over to the new group.
9554                 (when (and (equal to-group gnus-newsgroup-name)
9555                            (not (memq article gnus-newsgroup-unreads)))
9556                   ;; Mark this article as read in this group.
9557                   (push (cons to-article gnus-read-mark) gnus-newsgroup-reads)
9558                   (setcdr (gnus-active to-group) to-article)
9559                   (setcdr gnus-newsgroup-active to-article))
9560
9561                 (while marks
9562                   (when (eq (gnus-article-mark-to-type (cdar marks)) 'list)
9563                     (when (memq article (symbol-value
9564                                          (intern (format "gnus-newsgroup-%s"
9565                                                          (caar marks)))))
9566                       (push (cdar marks) to-marks)
9567                       ;; If the other group is the same as this group,
9568                       ;; then we have to add the mark to the list.
9569                       (when (equal to-group gnus-newsgroup-name)
9570                         (set (intern (format "gnus-newsgroup-%s" (caar marks)))
9571                              (cons to-article
9572                                    (symbol-value
9573                                     (intern (format "gnus-newsgroup-%s"
9574                                                     (caar marks)))))))
9575                       ;; Copy the marks to other group.
9576                       (gnus-add-marked-articles
9577                        to-group (cdar marks) (list to-article) info)))
9578                   (setq marks (cdr marks)))
9579
9580                 (gnus-request-set-mark
9581                  to-group (list (list (list to-article) 'add to-marks))))
9582
9583               (gnus-dribble-enter
9584                (concat "(gnus-group-set-info '"
9585                        (gnus-prin1-to-string (gnus-get-info to-group))
9586                        ")"))))
9587
9588           ;; Update the Xref header in this article to point to
9589           ;; the new crossposted article we have just created.
9590           (when (eq action 'crosspost)
9591             (save-excursion
9592               (set-buffer copy-buf)
9593               (gnus-request-article-this-buffer article gnus-newsgroup-name)
9594               (nnheader-replace-header "Xref" new-xref)
9595               (gnus-request-replace-article
9596                article gnus-newsgroup-name (current-buffer) t)))
9597
9598           ;; run the move/copy/crosspost/respool hook
9599           (run-hook-with-args 'gnus-summary-article-move-hook
9600                               action
9601                               (gnus-data-header
9602                                (assoc article (gnus-data-list nil)))
9603                               gnus-newsgroup-name
9604                               to-newsgroup
9605                               select-method))
9606
9607         ;;;!!!Why is this necessary?
9608         (set-buffer gnus-summary-buffer)
9609
9610         (gnus-summary-goto-subject article)
9611         (when (eq action 'move)
9612           (gnus-summary-mark-article article gnus-canceled-mark))))
9613       (push article articles-to-update-marks))
9614
9615     (apply 'gnus-summary-remove-process-mark articles-to-update-marks)
9616     ;; Re-activate all groups that have been moved to.
9617     (save-excursion
9618       (set-buffer gnus-group-buffer)
9619       (let ((gnus-group-marked to-groups))
9620         (gnus-group-get-new-news-this-group nil t)))
9621
9622     (gnus-kill-buffer copy-buf)
9623     (gnus-summary-position-point)
9624     (gnus-set-mode-line 'summary)))
9625
9626 (defun gnus-summary-copy-article (&optional n to-newsgroup select-method)
9627   "Copy the current article to some other group.
9628 If TO-NEWSGROUP is string, do not prompt for a newsgroup to copy to.
9629 When called interactively, if TO-NEWSGROUP is nil, use the value of
9630 the variable `gnus-move-split-methods' for finding a default target
9631 newsgroup.
9632 If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but
9633 re-spool using this method."
9634   (interactive "P")
9635   (gnus-summary-move-article n to-newsgroup select-method 'copy))
9636
9637 (defun gnus-summary-crosspost-article (&optional n)
9638   "Crosspost the current article to some other group."
9639   (interactive "P")
9640   (gnus-summary-move-article n nil nil 'crosspost))
9641
9642 (defcustom gnus-summary-respool-default-method nil
9643   "Default method type for respooling an article.
9644 If nil, use to the current newsgroup method."
9645   :type 'symbol
9646   :group 'gnus-summary-mail)
9647
9648 (defcustom gnus-summary-display-while-building nil
9649   "If non-nil, show and update the summary buffer as it's being built.
9650 If the value is t, update the buffer after every line is inserted.  If
9651 the value is an integer (N), update the display every N lines."
9652   :version "22.1"
9653   :group 'gnus-thread
9654   :type '(choice (const :tag "off" nil)
9655                  number
9656                  (const :tag "frequently" t)))
9657
9658 (defun gnus-summary-respool-article (&optional n method)
9659   "Respool the current article.
9660 The article will be squeezed through the mail spooling process again,
9661 which means that it will be put in some mail newsgroup or other
9662 depending on `nnmail-split-methods'.
9663 If N is a positive number, respool the N next articles.
9664 If N is a negative number, respool the N previous articles.
9665 If N is nil and any articles have been marked with the process mark,
9666 respool those articles instead.
9667
9668 Respooling can be done both from mail groups and \"real\" newsgroups.
9669 In the former case, the articles in question will be moved from the
9670 current group into whatever groups they are destined to.  In the
9671 latter case, they will be copied into the relevant groups."
9672   (interactive
9673    (list current-prefix-arg
9674          (let* ((methods (gnus-methods-using 'respool))
9675                 (methname
9676                  (symbol-name (or gnus-summary-respool-default-method
9677                                   (car (gnus-find-method-for-group
9678                                         gnus-newsgroup-name)))))
9679                 (method
9680                  (gnus-completing-read-with-default
9681                   methname "Backend to use when respooling"
9682                   methods nil t nil 'gnus-mail-method-history))
9683                 ms)
9684            (cond
9685             ((zerop (length (setq ms (gnus-servers-using-backend
9686                                       (intern method)))))
9687              (list (intern method) ""))
9688             ((= 1 (length ms))
9689              (car ms))
9690             (t
9691              (let ((ms-alist (mapcar (lambda (m) (cons (cadr m) m)) ms)))
9692                (cdr (assoc (completing-read "Server name: " ms-alist nil t)
9693                            ms-alist))))))))
9694   (unless method
9695     (error "No method given for respooling"))
9696   (if (assoc (symbol-name
9697               (car (gnus-find-method-for-group gnus-newsgroup-name)))
9698              (gnus-methods-using 'respool))
9699       (gnus-summary-move-article n nil method)
9700     (gnus-summary-copy-article n nil method)))
9701
9702 (defun gnus-summary-import-article (file &optional edit)
9703   "Import an arbitrary file into a mail newsgroup."
9704   (interactive "fImport file: \nP")
9705   (let ((group gnus-newsgroup-name)
9706         (now (current-time))
9707         atts lines group-art)
9708     (unless (gnus-check-backend-function 'request-accept-article group)
9709       (error "%s does not support article importing" group))
9710     (or (file-readable-p file)
9711         (not (file-regular-p file))
9712         (error "Can't read %s" file))
9713     (save-excursion
9714       (set-buffer (gnus-get-buffer-create " *import file*"))
9715       (erase-buffer)
9716       (nnheader-insert-file-contents file)
9717       (goto-char (point-min))
9718       (if (nnheader-article-p)
9719           (save-restriction
9720             (goto-char (point-min))
9721             (search-forward "\n\n" nil t)
9722             (narrow-to-region (point-min) (1- (point)))
9723             (goto-char (point-min))
9724             (unless (re-search-forward "^date:" nil t)
9725               (goto-char (point-max))
9726               (insert "Date: " (message-make-date (nth 5 atts)) "\n")))
9727        ;; This doesn't look like an article, so we fudge some headers.
9728         (setq atts (file-attributes file)
9729               lines (count-lines (point-min) (point-max)))
9730         (insert "From: " (read-string "From: ") "\n"
9731                 "Subject: " (read-string "Subject: ") "\n"
9732                 "Date: " (message-make-date (nth 5 atts)) "\n"
9733                 "Message-ID: " (message-make-message-id) "\n"
9734                 "Lines: " (int-to-string lines) "\n"
9735                 "Chars: " (int-to-string (nth 7 atts)) "\n\n"))
9736       (setq group-art (gnus-request-accept-article group nil t))
9737       (kill-buffer (current-buffer)))
9738     (setq gnus-newsgroup-active (gnus-activate-group group))
9739     (forward-line 1)
9740     (gnus-summary-goto-article (cdr group-art) nil t)
9741     (when edit
9742       (gnus-summary-edit-article))))
9743
9744 (defun gnus-summary-create-article ()
9745   "Create an article in a mail newsgroup."
9746   (interactive)
9747   (let ((group gnus-newsgroup-name)
9748         (now (current-time))
9749         group-art)
9750     (unless (gnus-check-backend-function 'request-accept-article group)
9751       (error "%s does not support article importing" group))
9752     (save-excursion
9753       (set-buffer (gnus-get-buffer-create " *import file*"))
9754       (erase-buffer)
9755       (goto-char (point-min))
9756       ;; This doesn't look like an article, so we fudge some headers.
9757       (insert "From: " (read-string "From: ") "\n"
9758               "Subject: " (read-string "Subject: ") "\n"
9759               "Date: " (message-make-date now) "\n"
9760               "Message-ID: " (message-make-message-id) "\n")
9761       (setq group-art (gnus-request-accept-article group nil t))
9762       (kill-buffer (current-buffer)))
9763     (setq gnus-newsgroup-active (gnus-activate-group group))
9764     (forward-line 1)
9765     (gnus-summary-goto-article (cdr group-art) nil t)
9766     (gnus-summary-edit-article)))
9767
9768 (defun gnus-summary-article-posted-p ()
9769   "Say whether the current (mail) article is available from news as well.
9770 This will be the case if the article has both been mailed and posted."
9771   (interactive)
9772   (let ((id (mail-header-references (gnus-summary-article-header)))
9773         (gnus-override-method (car (gnus-refer-article-methods))))
9774     (if (gnus-request-head id "")
9775         (gnus-message 2 "The current message was found on %s"
9776                       gnus-override-method)
9777       (gnus-message 2 "The current message couldn't be found on %s"
9778                     gnus-override-method)
9779       nil)))
9780
9781 (defun gnus-summary-expire-articles (&optional now)
9782   "Expire all articles that are marked as expirable in the current group."
9783   (interactive)
9784   (when (and (not gnus-group-is-exiting-without-update-p)
9785              (gnus-check-backend-function
9786               'request-expire-articles gnus-newsgroup-name))
9787     ;; This backend supports expiry.
9788     (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name))
9789            (expirable (if total
9790                           (progn
9791                             ;; We need to update the info for
9792                             ;; this group for `gnus-list-of-read-articles'
9793                             ;; to give us the right answer.
9794                             (gnus-run-hooks 'gnus-exit-group-hook)
9795                             (gnus-summary-update-info)
9796                             (gnus-list-of-read-articles gnus-newsgroup-name))
9797                         (setq gnus-newsgroup-expirable
9798                               (sort gnus-newsgroup-expirable '<))))
9799            (expiry-wait (if now 'immediate
9800                           (gnus-group-find-parameter
9801                            gnus-newsgroup-name 'expiry-wait)))
9802            (nnmail-expiry-target
9803             (or (gnus-group-find-parameter gnus-newsgroup-name 'expiry-target)
9804                 nnmail-expiry-target))
9805            es)
9806       (when expirable
9807         ;; There are expirable articles in this group, so we run them
9808         ;; through the expiry process.
9809         (gnus-message 6 "Expiring articles...")
9810         (unless (gnus-check-group gnus-newsgroup-name)
9811           (error "Can't open server for %s" gnus-newsgroup-name))
9812         ;; The list of articles that weren't expired is returned.
9813         (save-excursion
9814           (if expiry-wait
9815               (let ((nnmail-expiry-wait-function nil)
9816                     (nnmail-expiry-wait expiry-wait))
9817                 (setq es (gnus-request-expire-articles
9818                           expirable gnus-newsgroup-name)))
9819             (setq es (gnus-request-expire-articles
9820                       expirable gnus-newsgroup-name)))
9821           (unless total
9822             (setq gnus-newsgroup-expirable es))
9823           ;; We go through the old list of expirable, and mark all
9824           ;; really expired articles as nonexistent.
9825           (unless (eq es expirable) ;If nothing was expired, we don't mark.
9826             (let ((gnus-use-cache nil))
9827               (dolist (article expirable)
9828                 (when (and (not (memq article es))
9829                            (gnus-data-find article))
9830                   (gnus-summary-mark-article article gnus-canceled-mark)
9831                   (run-hook-with-args 'gnus-summary-article-expire-hook
9832                                       'delete
9833                                       (gnus-data-header
9834                                        (assoc article (gnus-data-list nil)))
9835                                       gnus-newsgroup-name
9836                                       nil
9837                                       nil))))))
9838         (gnus-message 6 "Expiring articles...done")))))
9839
9840 (defun gnus-summary-expire-articles-now ()
9841   "Expunge all expirable articles in the current group.
9842 This means that *all* articles that are marked as expirable will be
9843 deleted forever, right now."
9844   (interactive)
9845   (or gnus-expert-user
9846       (gnus-yes-or-no-p
9847        "Are you really, really sure you want to delete all expirable messages? ")
9848       (error "Phew!"))
9849   (gnus-summary-expire-articles t))
9850
9851 ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
9852 (defun gnus-summary-delete-article (&optional n)
9853   "Delete the N next (mail) articles.
9854 This command actually deletes articles.  This is not a marking
9855 command.  The article will disappear forever from your life, never to
9856 return.
9857
9858 If N is negative, delete backwards.
9859 If N is nil and articles have been marked with the process mark,
9860 delete these instead.
9861
9862 If `gnus-novice-user' is non-nil you will be asked for
9863 confirmation before the articles are deleted."
9864   (interactive "P")
9865   (unless (gnus-check-backend-function 'request-expire-articles
9866                                        gnus-newsgroup-name)
9867     (error "The current newsgroup does not support article deletion"))
9868   (unless (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
9869     (error "Couldn't open server"))
9870   ;; Compute the list of articles to delete.
9871   (let ((articles (sort (copy-sequence (gnus-summary-work-articles n)) '<))
9872         (nnmail-expiry-target 'delete)
9873         not-deleted)
9874     (if (and gnus-novice-user
9875              (not (gnus-yes-or-no-p
9876                    (format "Do you really want to delete %s forever? "
9877                            (if (> (length articles) 1)
9878                                (format "these %s articles" (length articles))
9879                              "this article")))))
9880         ()
9881       ;; Delete the articles.
9882       (setq not-deleted (gnus-request-expire-articles
9883                          articles gnus-newsgroup-name 'force))
9884       (while articles
9885         (gnus-summary-remove-process-mark (car articles))
9886         ;; The backend might not have been able to delete the article
9887         ;; after all.
9888         (unless (memq (car articles) not-deleted)
9889           (gnus-summary-mark-article (car articles) gnus-canceled-mark))
9890         (let* ((article (car articles))
9891                (ghead  (gnus-data-header
9892                                     (assoc article (gnus-data-list nil)))))
9893           (run-hook-with-args 'gnus-summary-article-delete-hook
9894                               'delete ghead gnus-newsgroup-name nil
9895                               nil))
9896         (setq articles (cdr articles)))
9897       (when not-deleted
9898         (gnus-message 4 "Couldn't delete articles %s" not-deleted)))
9899     (gnus-summary-position-point)
9900     (gnus-set-mode-line 'summary)
9901     not-deleted))
9902
9903 (defun gnus-summary-edit-article (&optional arg)
9904   "Edit the current article.
9905 This will have permanent effect only in mail groups.
9906 If ARG is nil, edit the decoded articles.
9907 If ARG is 1, edit the raw articles.
9908 If ARG is 2, edit the raw articles even in read-only groups.
9909 If ARG is 3, edit the articles with the current handles.
9910 Otherwise, allow editing of articles even in read-only
9911 groups."
9912   (interactive "P")
9913   (let (force raw current-handles)
9914     (cond
9915      ((null arg))
9916      ((eq arg 1)
9917       (setq raw t))
9918      ((eq arg 2)
9919       (setq raw t
9920             force t))
9921      ((eq arg 3)
9922       (setq current-handles
9923             (and (gnus-buffer-live-p gnus-article-buffer)
9924                  (with-current-buffer gnus-article-buffer
9925                    (prog1
9926                        gnus-article-mime-handles
9927                      (setq gnus-article-mime-handles nil))))))
9928      (t
9929       (setq force t)))
9930     (when (and raw (not force)
9931                (member gnus-newsgroup-name '("nndraft:delayed"
9932                                              "nndraft:drafts"
9933                                              "nndraft:queue")))
9934       (error "Can't edit the raw article in group %s"
9935              gnus-newsgroup-name))
9936     (save-excursion
9937       (set-buffer gnus-summary-buffer)
9938       (let ((mail-parse-charset gnus-newsgroup-charset)
9939             (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets))
9940         (gnus-set-global-variables)
9941         (when (and (not force)
9942                    (gnus-group-read-only-p))
9943           (error "The current newsgroup does not support article editing"))
9944         (gnus-summary-show-article t)
9945         (when (and (not raw) (gnus-buffer-live-p gnus-article-buffer))
9946           (with-current-buffer gnus-article-buffer
9947             (mm-enable-multibyte)))
9948         (if (member gnus-newsgroup-name '("nndraft:delayed" "nndraft:drafts"))
9949             (setq raw t))
9950         (gnus-article-edit-article
9951          (if raw 'ignore
9952            `(lambda ()
9953               (let ((mbl mml-buffer-list))
9954                 (setq mml-buffer-list nil)
9955                 (let ((rfc2047-quote-decoded-words-containing-tspecials t))
9956                   (mime-to-mml ,'current-handles))
9957                 (let ((mbl1 mml-buffer-list))
9958                   (setq mml-buffer-list mbl)
9959                   (set (make-local-variable 'mml-buffer-list) mbl1))
9960                 (gnus-make-local-hook 'kill-buffer-hook)
9961                 (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))))
9962          `(lambda (no-highlight)
9963             (let ((mail-parse-charset ',gnus-newsgroup-charset)
9964                   (message-options message-options)
9965                   (message-options-set-recipient)
9966                   (mail-parse-ignored-charsets
9967                    ',gnus-newsgroup-ignored-charsets))
9968               ,(if (not raw) '(progn
9969                                 (mml-to-mime)
9970                                 (mml-destroy-buffers)
9971                                 (remove-hook 'kill-buffer-hook
9972                                              'mml-destroy-buffers t)
9973                                 (kill-local-variable 'mml-buffer-list)))
9974               (gnus-summary-edit-article-done
9975                ,(or (mail-header-references gnus-current-headers) "")
9976                ,(gnus-group-read-only-p)
9977                ,gnus-summary-buffer no-highlight))))))))
9978
9979 (defalias 'gnus-summary-edit-article-postpone 'gnus-article-edit-exit)
9980
9981 (defun gnus-summary-edit-article-done (&optional references read-only buffer
9982                                                  no-highlight)
9983   "Make edits to the current article permanent."
9984   (interactive)
9985   (save-excursion
9986    ;; The buffer restriction contains the entire article if it exists.
9987     (when (article-goto-body)
9988       (let ((lines (count-lines (point) (point-max)))
9989             (length (- (point-max) (point)))
9990             (case-fold-search t)
9991             (body (copy-marker (point))))
9992         (goto-char (point-min))
9993         (when (re-search-forward "^content-length:[ \t]\\([0-9]+\\)" body t)
9994           (delete-region (match-beginning 1) (match-end 1))
9995           (insert (number-to-string length)))
9996         (goto-char (point-min))
9997         (when (re-search-forward
9998                "^x-content-length:[ \t]\\([0-9]+\\)" body t)
9999           (delete-region (match-beginning 1) (match-end 1))
10000           (insert (number-to-string length)))
10001         (goto-char (point-min))
10002         (when (re-search-forward "^lines:[ \t]\\([0-9]+\\)" body t)
10003           (delete-region (match-beginning 1) (match-end 1))
10004           (insert (number-to-string lines))))))
10005   ;; Replace the article.
10006   (let ((buf (current-buffer)))
10007     (with-temp-buffer
10008       (insert-buffer-substring buf)
10009
10010       (if (and (not read-only)
10011                (not (gnus-request-replace-article
10012                      (cdr gnus-article-current) (car gnus-article-current)
10013                      (current-buffer) t)))
10014           (error "Couldn't replace article")
10015         ;; Update the summary buffer.
10016         (if (and references
10017                  (equal (message-tokenize-header references " ")
10018                         (message-tokenize-header
10019                          (or (message-fetch-field "references") "") " ")))
10020             ;; We only have to update this line.
10021             (save-excursion
10022               (save-restriction
10023                 (message-narrow-to-head)
10024                 (let ((head (buffer-substring-no-properties
10025                              (point-min) (point-max)))
10026                       header)
10027                   (with-temp-buffer
10028                     (insert (format "211 %d Article retrieved.\n"
10029                                     (cdr gnus-article-current)))
10030                     (insert head)
10031                     (insert ".\n")
10032                     (let ((nntp-server-buffer (current-buffer)))
10033                       (setq header (car (gnus-get-newsgroup-headers
10034                                          nil t))))
10035                     (save-excursion
10036                       (set-buffer gnus-summary-buffer)
10037                       (gnus-data-set-header
10038                        (gnus-data-find (cdr gnus-article-current))
10039                        header)
10040                       (gnus-summary-update-article-line
10041                        (cdr gnus-article-current) header)
10042                       (if (gnus-summary-goto-subject
10043                            (cdr gnus-article-current) nil t)
10044                           (gnus-summary-update-secondary-mark
10045                            (cdr gnus-article-current))))))))
10046           ;; Update threads.
10047           (set-buffer (or buffer gnus-summary-buffer))
10048           (gnus-summary-update-article (cdr gnus-article-current))
10049           (if (gnus-summary-goto-subject (cdr gnus-article-current) nil t)
10050               (gnus-summary-update-secondary-mark
10051                (cdr gnus-article-current))))
10052         ;; Prettify the article buffer again.
10053         (unless no-highlight
10054           (save-excursion
10055             (set-buffer gnus-article-buffer)
10056             ;;;!!! Fix this -- article should be rehighlighted.
10057             ;;;(gnus-run-hooks 'gnus-article-display-hook)
10058             (set-buffer gnus-original-article-buffer)
10059             (gnus-request-article
10060              (cdr gnus-article-current)
10061              (car gnus-article-current) (current-buffer))))
10062         ;; Prettify the summary buffer line.
10063         (when (gnus-visual-p 'summary-highlight 'highlight)
10064           (gnus-run-hooks 'gnus-visual-mark-article-hook))))))
10065
10066 (defun gnus-summary-edit-wash (key)
10067   "Perform editing command KEY in the article buffer."
10068   (interactive
10069    (list
10070     (progn
10071       (message "%s" (concat (this-command-keys) "- "))
10072       (read-char))))
10073   (message "")
10074   (gnus-summary-edit-article)
10075   (execute-kbd-macro (concat (this-command-keys) key))
10076   (gnus-article-edit-done))
10077
10078 ;;; Respooling
10079
10080 (defun gnus-summary-respool-query (&optional silent trace)
10081   "Query where the respool algorithm would put this article."
10082   (interactive)
10083   (let (gnus-mark-article-hook)
10084     (gnus-summary-select-article)
10085     (save-excursion
10086       (set-buffer gnus-original-article-buffer)
10087       (let ((groups (nnmail-article-group 'identity trace)))
10088         (unless silent
10089           (if groups
10090               (message "This message would go to %s"
10091                        (mapconcat 'car groups ", "))
10092             (message "This message would go to no groups"))
10093           groups)))))
10094
10095 (defun gnus-summary-respool-trace ()
10096   "Trace where the respool algorithm would put this article.
10097 Display a buffer showing all fancy splitting patterns which matched."
10098   (interactive)
10099   (gnus-summary-respool-query nil t))
10100
10101 ;; Summary marking commands.
10102
10103 (defun gnus-summary-kill-same-subject-and-select (&optional unmark)
10104   "Mark articles which has the same subject as read, and then select the next.
10105 If UNMARK is positive, remove any kind of mark.
10106 If UNMARK is negative, tick articles."
10107   (interactive "P")
10108   (when unmark
10109     (setq unmark (prefix-numeric-value unmark)))
10110   (let ((count
10111          (gnus-summary-mark-same-subject
10112           (gnus-summary-article-subject) unmark)))
10113     ;; Select next unread article.  If auto-select-same mode, should
10114     ;; select the first unread article.
10115     (gnus-summary-next-article t (and gnus-auto-select-same
10116                                       (gnus-summary-article-subject)))
10117     (gnus-message 7 "%d article%s marked as %s"
10118                   count (if (= count 1) " is" "s are")
10119                   (if unmark "unread" "read"))))
10120
10121 (defun gnus-summary-kill-same-subject (&optional unmark)
10122   "Mark articles which has the same subject as read.
10123 If UNMARK is positive, remove any kind of mark.
10124 If UNMARK is negative, tick articles."
10125   (interactive "P")
10126   (when unmark
10127     (setq unmark (prefix-numeric-value unmark)))
10128   (let ((count
10129          (gnus-summary-mark-same-subject
10130           (gnus-summary-article-subject) unmark)))
10131     ;; If marked as read, go to next unread subject.
10132     (when (null unmark)
10133       ;; Go to next unread subject.
10134       (gnus-summary-next-subject 1 t))
10135     (gnus-message 7 "%d articles are marked as %s"
10136                   count (if unmark "unread" "read"))))
10137
10138 (defun gnus-summary-mark-same-subject (subject &optional unmark)
10139   "Mark articles with same SUBJECT as read, and return marked number.
10140 If optional argument UNMARK is positive, remove any kinds of marks.
10141 If optional argument UNMARK is negative, mark articles as unread instead."
10142   (let ((count 1))
10143     (save-excursion
10144       (cond
10145        ((null unmark)                   ; Mark as read.
10146         (while (and
10147                 (progn
10148                   (gnus-summary-mark-article-as-read gnus-killed-mark)
10149                   (gnus-summary-show-thread) t)
10150                 (gnus-summary-find-subject subject))
10151           (setq count (1+ count))))
10152        ((> unmark 0)                    ; Tick.
10153         (while (and
10154                 (progn
10155                   (gnus-summary-mark-article-as-unread gnus-ticked-mark)
10156                   (gnus-summary-show-thread) t)
10157                 (gnus-summary-find-subject subject))
10158           (setq count (1+ count))))
10159        (t                               ; Mark as unread.
10160         (while (and
10161                 (progn
10162                   (gnus-summary-mark-article-as-unread gnus-unread-mark)
10163                   (gnus-summary-show-thread) t)
10164                 (gnus-summary-find-subject subject))
10165           (setq count (1+ count)))))
10166       (gnus-set-mode-line 'summary)
10167       ;; Return the number of marked articles.
10168       count)))
10169
10170 (defun gnus-summary-mark-as-processable (n &optional unmark)
10171   "Set the process mark on the next N articles.
10172 If N is negative, mark backward instead.  If UNMARK is non-nil, remove
10173 the process mark instead.  The difference between N and the actual
10174 number of articles marked is returned."
10175   (interactive "P")
10176   (if (and (null n) (gnus-region-active-p))
10177       (gnus-uu-mark-region (region-beginning) (region-end) unmark)
10178     (setq n (prefix-numeric-value n))
10179     (let ((backward (< n 0))
10180           (n (abs n)))
10181       (while (and
10182               (> n 0)
10183               (if unmark
10184                   (gnus-summary-remove-process-mark
10185                    (gnus-summary-article-number))
10186                 (gnus-summary-set-process-mark (gnus-summary-article-number)))
10187               (zerop (gnus-summary-next-subject (if backward -1 1) nil t)))
10188         (setq n (1- n)))
10189       (when (/= 0 n)
10190         (gnus-message 7 "No more articles"))
10191       (gnus-summary-recenter)
10192       (gnus-summary-position-point)
10193       n)))
10194
10195 (defun gnus-summary-unmark-as-processable (n)
10196   "Remove the process mark from the next N articles.
10197 If N is negative, unmark backward instead.  The difference between N and
10198 the actual number of articles unmarked is returned."
10199   (interactive "P")
10200   (gnus-summary-mark-as-processable n t))
10201
10202 (defun gnus-summary-unmark-all-processable ()
10203   "Remove the process mark from all articles."
10204   (interactive)
10205   (save-excursion
10206     (while gnus-newsgroup-processable
10207       (gnus-summary-remove-process-mark (car gnus-newsgroup-processable))))
10208   (gnus-summary-position-point))
10209
10210 (defun gnus-summary-add-mark (article type)
10211   "Mark ARTICLE with a mark of TYPE."
10212   (let ((vtype (car (assq type gnus-article-mark-lists)))
10213         var)
10214     (if (not vtype)
10215         (error "No such mark type: %s" type)
10216       (setq var (intern (format "gnus-newsgroup-%s" type)))
10217       (set var (cons article (symbol-value var)))
10218       (if (memq type '(processable cached replied forwarded recent saved))
10219           (gnus-summary-update-secondary-mark article)
10220         ;;; !!! This is bogus.  We should find out what primary
10221         ;;; !!! mark we want to set.
10222         (gnus-summary-update-mark gnus-del-mark 'unread)))))
10223
10224 (defun gnus-summary-mark-as-expirable (n)
10225   "Mark N articles forward as expirable.
10226 If N is negative, mark backward instead.  The difference between N and
10227 the actual number of articles marked is returned."
10228   (interactive "p")
10229   (gnus-summary-mark-forward n gnus-expirable-mark))
10230
10231 (defun gnus-summary-mark-as-spam (n)
10232   "Mark N articles forward as spam.
10233 If N is negative, mark backward instead.  The difference between N and
10234 the actual number of articles marked is returned."
10235   (interactive "p")
10236   (gnus-summary-mark-forward n gnus-spam-mark))
10237
10238 (defun gnus-summary-mark-article-as-replied (article)
10239   "Mark ARTICLE as replied to and update the summary line.
10240 ARTICLE can also be a list of articles."
10241   (interactive (list (gnus-summary-article-number)))
10242   (let ((articles (if (listp article) article (list article))))
10243     (dolist (article articles)
10244       (unless (numberp article)
10245         (error "%s is not a number" article))
10246       (push article gnus-newsgroup-replied)
10247       (let ((buffer-read-only nil))
10248         (when (gnus-summary-goto-subject article nil t)
10249           (gnus-summary-update-secondary-mark article))))))
10250
10251 (defun gnus-summary-mark-article-as-forwarded (article)
10252   "Mark ARTICLE as forwarded and update the summary line.
10253 ARTICLE can also be a list of articles."
10254   (let ((articles (if (listp article) article (list article))))
10255     (dolist (article articles)
10256       (push article gnus-newsgroup-forwarded)
10257       (let ((buffer-read-only nil))
10258         (when (gnus-summary-goto-subject article nil t)
10259           (gnus-summary-update-secondary-mark article))))))
10260
10261 (defun gnus-summary-set-bookmark (article)
10262   "Set a bookmark in current article."
10263   (interactive (list (gnus-summary-article-number)))
10264   (when (or (not (get-buffer gnus-article-buffer))
10265             (not gnus-current-article)
10266             (not gnus-article-current)
10267             (not (equal gnus-newsgroup-name (car gnus-article-current))))
10268     (error "No current article selected"))
10269   ;; Remove old bookmark, if one exists.
10270   (gnus-pull article gnus-newsgroup-bookmarks)
10271   ;; Set the new bookmark, which is on the form
10272   ;; (article-number . line-number-in-body).
10273   (push
10274    (cons article
10275          (with-current-buffer gnus-article-buffer
10276            (count-lines
10277             (min (point)
10278                  (save-excursion
10279                    (article-goto-body)
10280                    (point)))
10281             (point))))
10282    gnus-newsgroup-bookmarks)
10283   (gnus-message 6 "A bookmark has been added to the current article."))
10284
10285 (defun gnus-summary-remove-bookmark (article)
10286   "Remove the bookmark from the current article."
10287   (interactive (list (gnus-summary-article-number)))
10288   ;; Remove old bookmark, if one exists.
10289   (if (not (assq article gnus-newsgroup-bookmarks))
10290       (gnus-message 6 "No bookmark in current article.")
10291     (gnus-pull article gnus-newsgroup-bookmarks)
10292     (gnus-message 6 "Removed bookmark.")))
10293
10294 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
10295 (defun gnus-summary-mark-as-dormant (n)
10296   "Mark N articles forward as dormant.
10297 If N is negative, mark backward instead.  The difference between N and
10298 the actual number of articles marked is returned."
10299   (interactive "p")
10300   (gnus-summary-mark-forward n gnus-dormant-mark))
10301
10302 (defun gnus-summary-set-process-mark (article)
10303   "Set the process mark on ARTICLE and update the summary line."
10304   (setq gnus-newsgroup-processable
10305         (cons article
10306               (delq article gnus-newsgroup-processable)))
10307   (when (gnus-summary-goto-subject article)
10308     (gnus-summary-show-thread)
10309     (gnus-summary-goto-subject article)
10310     (gnus-summary-update-secondary-mark article)))
10311
10312 (defun gnus-summary-remove-process-mark (&rest articles)
10313   "Remove the process mark from ARTICLES and update the summary line."
10314   (dolist (article articles)
10315     (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable))
10316     (when (gnus-summary-goto-subject article)
10317       (gnus-summary-show-thread)
10318       (gnus-summary-goto-subject article)
10319       (gnus-summary-update-secondary-mark article)))
10320   t)
10321
10322 (defun gnus-summary-set-saved-mark (article)
10323   "Set the process mark on ARTICLE and update the summary line."
10324   (push article gnus-newsgroup-saved)
10325   (when (gnus-summary-goto-subject article)
10326     (gnus-summary-update-secondary-mark article)))
10327
10328 (defun gnus-summary-mark-forward (n &optional mark no-expire)
10329   "Mark N articles as read forwards.
10330 If N is negative, mark backwards instead.  Mark with MARK, ?r by default.
10331 The difference between N and the actual number of articles marked is
10332 returned.
10333 If NO-EXPIRE, auto-expiry will be inhibited."
10334   (interactive "p")
10335   (gnus-summary-show-thread)
10336   (let ((backward (< n 0))
10337         (gnus-summary-goto-unread
10338          (and gnus-summary-goto-unread
10339               (not (eq gnus-summary-goto-unread 'never))
10340               (not (memq mark (list gnus-unread-mark gnus-spam-mark
10341                                     gnus-ticked-mark gnus-dormant-mark)))))
10342         (n (abs n))
10343         (mark (or mark gnus-del-mark)))
10344     (while (and (> n 0)
10345                 (gnus-summary-mark-article nil mark no-expire)
10346                 (zerop (gnus-summary-next-subject
10347                         (if backward -1 1)
10348                         (and gnus-summary-goto-unread
10349                              (not (eq gnus-summary-goto-unread 'never)))
10350                         t)))
10351       (setq n (1- n)))
10352     (when (/= 0 n)
10353       (gnus-message 7 "No more %sarticles" (if mark "" "unread ")))
10354     (gnus-summary-recenter)
10355     (gnus-summary-position-point)
10356     (gnus-set-mode-line 'summary)
10357     n))
10358
10359 (defun gnus-summary-mark-article-as-read (mark)
10360   "Mark the current article quickly as read with MARK."
10361   (let ((article (gnus-summary-article-number)))
10362     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
10363     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
10364     (setq gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked))
10365     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
10366     (push (cons article mark) gnus-newsgroup-reads)
10367     ;; Possibly remove from cache, if that is used.
10368     (when gnus-use-cache
10369       (gnus-cache-enter-remove-article article))
10370     ;; Allow the backend to change the mark.
10371     (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
10372     ;; Check for auto-expiry.
10373     (when (and gnus-newsgroup-auto-expire
10374                (memq mark gnus-auto-expirable-marks))
10375       (setq mark gnus-expirable-mark)
10376       ;; Let the backend know about the mark change.
10377       (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
10378       (push article gnus-newsgroup-expirable))
10379     ;; Set the mark in the buffer.
10380     (gnus-summary-update-mark mark 'unread)
10381     t))
10382
10383 (defun gnus-summary-mark-article-as-unread (mark)
10384   "Mark the current article quickly as unread with MARK."
10385   (let* ((article (gnus-summary-article-number))
10386          (old-mark (gnus-summary-article-mark article)))
10387     ;; Allow the backend to change the mark.
10388     (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
10389     (if (eq mark old-mark)
10390         t
10391       (if (<= article 0)
10392           (progn
10393             (gnus-error 1 "Can't mark negative article numbers")
10394             nil)
10395         (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
10396         (setq gnus-newsgroup-spam-marked
10397               (delq article gnus-newsgroup-spam-marked))
10398         (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
10399         (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
10400         (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads))
10401         (cond ((= mark gnus-ticked-mark)
10402                (setq gnus-newsgroup-marked
10403                      (gnus-add-to-sorted-list gnus-newsgroup-marked
10404                                               article)))
10405               ((= mark gnus-spam-mark)
10406                (setq gnus-newsgroup-spam-marked
10407                      (gnus-add-to-sorted-list gnus-newsgroup-spam-marked
10408                                               article)))
10409               ((= mark gnus-dormant-mark)
10410                (setq gnus-newsgroup-dormant
10411                      (gnus-add-to-sorted-list gnus-newsgroup-dormant
10412                                               article)))
10413               (t
10414                (setq gnus-newsgroup-unreads
10415                      (gnus-add-to-sorted-list gnus-newsgroup-unreads
10416                                               article))))
10417         (gnus-pull article gnus-newsgroup-reads)
10418
10419         ;; See whether the article is to be put in the cache.
10420         (and gnus-use-cache
10421              (vectorp (gnus-summary-article-header article))
10422              (save-excursion
10423                (gnus-cache-possibly-enter-article
10424                 gnus-newsgroup-name article
10425                 (= mark gnus-ticked-mark)
10426                 (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
10427
10428         ;; Fix the mark.
10429         (gnus-summary-update-mark mark 'unread)
10430         t))))
10431
10432 (defun gnus-summary-mark-article (&optional article mark no-expire)
10433   "Mark ARTICLE with MARK.  MARK can be any character.
10434 Four MARK strings are reserved: `? ' (unread), `?!' (ticked),
10435 `??' (dormant) and `?E' (expirable).
10436 If MARK is nil, then the default character `?r' is used.
10437 If ARTICLE is nil, then the article on the current line will be
10438 marked.
10439 If NO-EXPIRE, auto-expiry will be inhibited."
10440   ;; The mark might be a string.
10441   (when (stringp mark)
10442     (setq mark (aref mark 0)))
10443   ;; If no mark is given, then we check auto-expiring.
10444   (when (null mark)
10445     (setq mark gnus-del-mark))
10446   (when (and (not no-expire)
10447              gnus-newsgroup-auto-expire
10448              (memq mark gnus-auto-expirable-marks))
10449     (setq mark gnus-expirable-mark))
10450   (let ((article (or article (gnus-summary-article-number)))
10451         (old-mark (gnus-summary-article-mark article)))
10452     ;; Allow the backend to change the mark.
10453     (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
10454     (if (eq mark old-mark)
10455         t
10456       (unless article
10457         (error "No article on current line"))
10458       (if (not (if (or (= mark gnus-unread-mark)
10459                        (= mark gnus-ticked-mark)
10460                        (= mark gnus-spam-mark)
10461                        (= mark gnus-dormant-mark))
10462                    (gnus-mark-article-as-unread article mark)
10463                  (gnus-mark-article-as-read article mark)))
10464           t
10465         ;; See whether the article is to be put in the cache.
10466         (and gnus-use-cache
10467              (not (= mark gnus-canceled-mark))
10468              (vectorp (gnus-summary-article-header article))
10469              (save-excursion
10470                (gnus-cache-possibly-enter-article
10471                 gnus-newsgroup-name article
10472                 (= mark gnus-ticked-mark)
10473                 (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
10474
10475         (when (gnus-summary-goto-subject article nil t)
10476           (let ((buffer-read-only nil))
10477             (gnus-summary-show-thread)
10478             ;; Fix the mark.
10479             (gnus-summary-update-mark mark 'unread)
10480             t))))))
10481
10482 (defun gnus-summary-update-secondary-mark (article)
10483   "Update the secondary (read, process, cache) mark."
10484   (gnus-summary-update-mark
10485    (cond ((memq article gnus-newsgroup-processable)
10486           gnus-process-mark)
10487          ((memq article gnus-newsgroup-cached)
10488           gnus-cached-mark)
10489          ((memq article gnus-newsgroup-replied)
10490           gnus-replied-mark)
10491          ((memq article gnus-newsgroup-forwarded)
10492           gnus-forwarded-mark)
10493          ((memq article gnus-newsgroup-saved)
10494           gnus-saved-mark)
10495          ((memq article gnus-newsgroup-recent)
10496           gnus-recent-mark)
10497          ((memq article gnus-newsgroup-unseen)
10498           gnus-unseen-mark)
10499          (t gnus-no-mark))
10500    'replied)
10501   (when (gnus-visual-p 'summary-highlight 'highlight)
10502     (gnus-run-hooks 'gnus-summary-update-hook))
10503   t)
10504
10505 (defun gnus-summary-update-download-mark (article)
10506   "Update the download mark."
10507   (gnus-summary-update-mark
10508    (cond ((memq article gnus-newsgroup-undownloaded)
10509           gnus-undownloaded-mark)
10510          (gnus-newsgroup-agentized
10511           gnus-downloaded-mark)
10512          (t
10513           gnus-no-mark))
10514    'download)
10515   (gnus-summary-update-line t)
10516   t)
10517
10518 (defun gnus-summary-update-mark (mark type)
10519   (let ((forward (cdr (assq type gnus-summary-mark-positions)))
10520         (buffer-read-only nil))
10521     (re-search-backward "[\n\r]" (point-at-bol) 'move-to-limit)
10522     (when forward
10523       (when (looking-at "\r")
10524         (incf forward))
10525       (when (<= (+ forward (point)) (point-max))
10526         ;; Go to the right position on the line.
10527         (goto-char (+ forward (point)))
10528         ;; Replace the old mark with the new mark.
10529         (subst-char-in-region (point) (1+ (point)) (char-after) mark)
10530         ;; Optionally update the marks by some user rule.
10531         (when (eq type 'unread)
10532           (gnus-data-set-mark
10533            (gnus-data-find (gnus-summary-article-number)) mark)
10534           (gnus-summary-update-line (eq mark gnus-unread-mark)))))))
10535
10536 (defun gnus-mark-article-as-read (article &optional mark)
10537   "Enter ARTICLE in the pertinent lists and remove it from others."
10538   ;; Make the article expirable.
10539   (let ((mark (or mark gnus-del-mark)))
10540     (setq gnus-newsgroup-expirable
10541           (if (= mark gnus-expirable-mark)
10542               (gnus-add-to-sorted-list gnus-newsgroup-expirable article)
10543             (delq article gnus-newsgroup-expirable)))
10544     ;; Remove from unread and marked lists.
10545     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
10546     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
10547     (setq gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked))
10548     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
10549     (push (cons article mark) gnus-newsgroup-reads)
10550     ;; Possibly remove from cache, if that is used.
10551     (when gnus-use-cache
10552       (gnus-cache-enter-remove-article article))
10553     t))
10554
10555 (defun gnus-mark-article-as-unread (article &optional mark)
10556   "Enter ARTICLE in the pertinent lists and remove it from others."
10557   (let ((mark (or mark gnus-ticked-mark)))
10558     (if (<= article 0)
10559         (progn
10560           (gnus-error 1 "Can't mark negative article numbers")
10561           nil)
10562       (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)
10563             gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked)
10564             gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)
10565             gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)
10566             gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
10567
10568       ;; Unsuppress duplicates?
10569       (when gnus-suppress-duplicates
10570         (gnus-dup-unsuppress-article article))
10571
10572       (cond ((= mark gnus-ticked-mark)
10573              (setq gnus-newsgroup-marked
10574                    (gnus-add-to-sorted-list gnus-newsgroup-marked article)))
10575             ((= mark gnus-spam-mark)
10576              (setq gnus-newsgroup-spam-marked
10577                    (gnus-add-to-sorted-list gnus-newsgroup-spam-marked
10578                                             article)))
10579             ((= mark gnus-dormant-mark)
10580              (setq gnus-newsgroup-dormant
10581                    (gnus-add-to-sorted-list gnus-newsgroup-dormant article)))
10582             (t
10583              (setq gnus-newsgroup-unreads
10584                    (gnus-add-to-sorted-list gnus-newsgroup-unreads article))))
10585       (gnus-pull article gnus-newsgroup-reads)
10586       t)))
10587
10588 (defalias 'gnus-summary-mark-as-unread-forward
10589   'gnus-summary-tick-article-forward)
10590 (make-obsolete 'gnus-summary-mark-as-unread-forward
10591                'gnus-summary-tick-article-forward)
10592 (defun gnus-summary-tick-article-forward (n)
10593   "Tick N articles forwards.
10594 If N is negative, tick backwards instead.
10595 The difference between N and the number of articles ticked is returned."
10596   (interactive "p")
10597   (gnus-summary-mark-forward n gnus-ticked-mark))
10598
10599 (defalias 'gnus-summary-mark-as-unread-backward
10600   'gnus-summary-tick-article-backward)
10601 (make-obsolete 'gnus-summary-mark-as-unread-backward
10602                'gnus-summary-tick-article-backward)
10603 (defun gnus-summary-tick-article-backward (n)
10604   "Tick N articles backwards.
10605 The difference between N and the number of articles ticked is returned."
10606   (interactive "p")
10607   (gnus-summary-mark-forward (- n) gnus-ticked-mark))
10608
10609 (defalias 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
10610 (make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
10611 (defun gnus-summary-tick-article (&optional article clear-mark)
10612   "Mark current article as unread.
10613 Optional 1st argument ARTICLE specifies article number to be marked as unread.
10614 Optional 2nd argument CLEAR-MARK remove any kinds of mark."
10615   (interactive)
10616   (gnus-summary-mark-article article (if clear-mark gnus-unread-mark
10617                                        gnus-ticked-mark)))
10618
10619 (defun gnus-summary-mark-as-read-forward (n)
10620   "Mark N articles as read forwards.
10621 If N is negative, mark backwards instead.
10622 The difference between N and the actual number of articles marked is
10623 returned."
10624   (interactive "p")
10625   (gnus-summary-mark-forward n gnus-del-mark gnus-inhibit-user-auto-expire))
10626
10627 (defun gnus-summary-mark-as-read-backward (n)
10628   "Mark the N articles as read backwards.
10629 The difference between N and the actual number of articles marked is
10630 returned."
10631   (interactive "p")
10632   (gnus-summary-mark-forward
10633    (- n) gnus-del-mark gnus-inhibit-user-auto-expire))
10634
10635 (defun gnus-summary-mark-as-read (&optional article mark)
10636   "Mark current article as read.
10637 ARTICLE specifies the article to be marked as read.
10638 MARK specifies a string to be inserted at the beginning of the line."
10639   (gnus-summary-mark-article article mark))
10640
10641 (defun gnus-summary-clear-mark-forward (n)
10642   "Clear marks from N articles forward.
10643 If N is negative, clear backward instead.
10644 The difference between N and the number of marks cleared is returned."
10645   (interactive "p")
10646   (gnus-summary-mark-forward n gnus-unread-mark))
10647
10648 (defun gnus-summary-clear-mark-backward (n)
10649   "Clear marks from N articles backward.
10650 The difference between N and the number of marks cleared is returned."
10651   (interactive "p")
10652   (gnus-summary-mark-forward (- n) gnus-unread-mark))
10653
10654 (defun gnus-summary-mark-unread-as-read ()
10655   "Intended to be used by `gnus-summary-mark-article-hook'."
10656   (when (memq gnus-current-article gnus-newsgroup-unreads)
10657     (gnus-summary-mark-article gnus-current-article gnus-read-mark)))
10658
10659 (defun gnus-summary-mark-read-and-unread-as-read (&optional new-mark)
10660   "Intended to be used by `gnus-summary-mark-article-hook'."
10661   (let ((mark (gnus-summary-article-mark)))
10662     (when (or (gnus-unread-mark-p mark)
10663               (gnus-read-mark-p mark))
10664       (gnus-summary-mark-article gnus-current-article
10665                                  (or new-mark gnus-read-mark)))))
10666
10667 (defun gnus-summary-mark-current-read-and-unread-as-read (&optional new-mark)
10668   "Intended to be used by `gnus-summary-mark-article-hook'."
10669   (let ((mark (gnus-summary-article-mark)))
10670     (when (or (gnus-unread-mark-p mark)
10671               (gnus-read-mark-p mark))
10672       (gnus-summary-mark-article (gnus-summary-article-number)
10673                                  (or new-mark gnus-read-mark)))))
10674
10675 (defun gnus-summary-mark-unread-as-ticked ()
10676   "Intended to be used by `gnus-summary-mark-article-hook'."
10677   (when (memq gnus-current-article gnus-newsgroup-unreads)
10678     (gnus-summary-mark-article gnus-current-article gnus-ticked-mark)))
10679
10680 (defun gnus-summary-mark-region-as-read (point mark all)
10681   "Mark all unread articles between point and mark as read.
10682 If given a prefix, mark all articles between point and mark as read,
10683 even ticked and dormant ones."
10684   (interactive "r\nP")
10685   (save-excursion
10686     (let (article)
10687       (goto-char point)
10688       (beginning-of-line)
10689       (while (and
10690               (< (point) mark)
10691               (progn
10692                 (when (or all
10693                           (memq (setq article (gnus-summary-article-number))
10694                                 gnus-newsgroup-unreads))
10695                   (gnus-summary-mark-article article gnus-del-mark))
10696                 t)
10697               (gnus-summary-find-next))))))
10698
10699 (defun gnus-summary-mark-below (score mark)
10700   "Mark articles with score less than SCORE with MARK."
10701   (interactive "P\ncMark: ")
10702   (setq score (if score
10703                   (prefix-numeric-value score)
10704                 (or gnus-summary-default-score 0)))
10705   (save-excursion
10706     (set-buffer gnus-summary-buffer)
10707     (goto-char (point-min))
10708     (while
10709         (progn
10710           (and (< (gnus-summary-article-score) score)
10711                (gnus-summary-mark-article nil mark))
10712           (gnus-summary-find-next)))))
10713
10714 (defun gnus-summary-kill-below (&optional score)
10715   "Mark articles with score below SCORE as read."
10716   (interactive "P")
10717   (gnus-summary-mark-below score gnus-killed-mark))
10718
10719 (defun gnus-summary-clear-above (&optional score)
10720   "Clear all marks from articles with score above SCORE."
10721   (interactive "P")
10722   (gnus-summary-mark-above score gnus-unread-mark))
10723
10724 (defun gnus-summary-tick-above (&optional score)
10725   "Tick all articles with score above SCORE."
10726   (interactive "P")
10727   (gnus-summary-mark-above score gnus-ticked-mark))
10728
10729 (defun gnus-summary-mark-above (score mark)
10730   "Mark articles with score over SCORE with MARK."
10731   (interactive "P\ncMark: ")
10732   (setq score (if score
10733                   (prefix-numeric-value score)
10734                 (or gnus-summary-default-score 0)))
10735   (save-excursion
10736     (set-buffer gnus-summary-buffer)
10737     (goto-char (point-min))
10738     (while (and (progn
10739                   (when (> (gnus-summary-article-score) score)
10740                     (gnus-summary-mark-article nil mark))
10741                   t)
10742                 (gnus-summary-find-next)))))
10743
10744 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
10745 (defalias 'gnus-summary-show-all-expunged 'gnus-summary-limit-include-expunged)
10746 (defun gnus-summary-limit-include-expunged (&optional no-error)
10747   "Display all the hidden articles that were expunged for low scores."
10748   (interactive)
10749   (let ((buffer-read-only nil))
10750     (let ((scored gnus-newsgroup-scored)
10751           headers h)
10752       (while scored
10753         (unless (gnus-summary-article-header (caar scored))
10754           (and (setq h (gnus-number-to-header (caar scored)))
10755                (< (cdar scored) gnus-summary-expunge-below)
10756                (push h headers)))
10757         (setq scored (cdr scored)))
10758       (if (not headers)
10759           (when (not no-error)
10760             (error "No expunged articles hidden"))
10761         (goto-char (point-min))
10762         (push gnus-newsgroup-limit gnus-newsgroup-limits)
10763         (setq gnus-newsgroup-limit (copy-sequence gnus-newsgroup-limit))
10764         (mapcar (lambda (x) (push (mail-header-number x)
10765                                   gnus-newsgroup-limit))
10766                 headers)
10767         (gnus-summary-prepare-unthreaded (nreverse headers))
10768         (goto-char (point-min))
10769         (gnus-summary-position-point)
10770         t))))
10771
10772 (defun gnus-summary-catchup (&optional all quietly to-here not-mark reverse)
10773   "Mark all unread articles in this newsgroup as read.
10774 If prefix argument ALL is non-nil, ticked and dormant articles will
10775 also be marked as read.
10776 If QUIETLY is non-nil, no questions will be asked.
10777
10778 If TO-HERE is non-nil, it should be a point in the buffer.  All
10779 articles before (after, if REVERSE is set) this point will be marked
10780 as read.
10781
10782 Note that this function will only catch up the unread article
10783 in the current summary buffer limitation.
10784
10785 The number of articles marked as read is returned."
10786   (interactive "P")
10787   (prog1
10788       (save-excursion
10789         (when (or quietly
10790                   (not gnus-interactive-catchup) ;Without confirmation?
10791                   gnus-expert-user
10792                   (gnus-y-or-n-p
10793                    (if all
10794                        "Mark absolutely all articles as read? "
10795                      "Mark all unread articles as read? ")))
10796           (if (and not-mark
10797                    (not gnus-newsgroup-adaptive)
10798                    (not gnus-newsgroup-auto-expire)
10799                    (not gnus-suppress-duplicates)
10800                    (or (not gnus-use-cache)
10801                        (eq gnus-use-cache 'passive)))
10802               (progn
10803                 (when all
10804                   (setq gnus-newsgroup-marked nil
10805                         gnus-newsgroup-spam-marked nil
10806                         gnus-newsgroup-dormant nil))
10807                 (setq gnus-newsgroup-unreads
10808                       (gnus-sorted-nunion
10809                        (gnus-sorted-intersection gnus-newsgroup-unreads
10810                                                  gnus-newsgroup-downloadable)
10811                        gnus-newsgroup-unfetched)))
10812             ;; We actually mark all articles as canceled, which we
10813             ;; have to do when using auto-expiry or adaptive scoring.
10814             (gnus-summary-show-all-threads)
10815             (if (and to-here reverse)
10816                 (progn
10817                   (goto-char to-here)
10818                   (gnus-summary-mark-current-read-and-unread-as-read
10819                    gnus-catchup-mark)
10820                   (while (gnus-summary-find-next (not all))
10821                     (gnus-summary-mark-article-as-read gnus-catchup-mark)))
10822               (when (gnus-summary-first-subject (not all))
10823                 (while (and
10824                         (if to-here (< (point) to-here) t)
10825                         (gnus-summary-mark-article-as-read gnus-catchup-mark)
10826                         (gnus-summary-find-next (not all))))))
10827             (gnus-set-mode-line 'summary))
10828           t))
10829     (gnus-summary-position-point)))
10830
10831 (defun gnus-summary-catchup-to-here (&optional all)
10832   "Mark all unticked articles before the current one as read.
10833 If ALL is non-nil, also mark ticked and dormant articles as read."
10834   (interactive "P")
10835   (save-excursion
10836     (gnus-save-hidden-threads
10837       (let ((beg (point)))
10838         ;; We check that there are unread articles.
10839         (when (or all (gnus-summary-find-prev))
10840           (gnus-summary-catchup all t beg)))))
10841   (gnus-summary-position-point))
10842
10843 (defun gnus-summary-catchup-from-here (&optional all)
10844   "Mark all unticked articles after (and including) the current one as read.
10845 If ALL is non-nil, also mark ticked and dormant articles as read."
10846   (interactive "P")
10847   (save-excursion
10848     (gnus-save-hidden-threads
10849       (let ((beg (point)))
10850         ;; We check that there are unread articles.
10851         (when (or all (gnus-summary-find-next))
10852           (gnus-summary-catchup all t beg nil t)))))
10853   (gnus-summary-position-point))
10854
10855 (defun gnus-summary-catchup-all (&optional quietly)
10856   "Mark all articles in this newsgroup as read.
10857 This command is dangerous.  Normally, you want \\[gnus-summary-catchup]
10858 instead, which marks only unread articles as read."
10859   (interactive "P")
10860   (gnus-summary-catchup t quietly))
10861
10862 (defun gnus-summary-catchup-and-exit (&optional all quietly)
10863   "Mark all unread articles in this group as read, then exit.
10864 If prefix argument ALL is non-nil, all articles are marked as read.
10865 If QUIETLY is non-nil, no questions will be asked."
10866   (interactive "P")
10867   (when (gnus-summary-catchup all quietly nil 'fast)
10868     ;; Select next newsgroup or exit.
10869     (if (and (not (gnus-group-quit-config gnus-newsgroup-name))
10870              (eq gnus-auto-select-next 'quietly))
10871         (gnus-summary-next-group nil)
10872       (gnus-summary-exit))))
10873
10874 (defun gnus-summary-catchup-all-and-exit (&optional quietly)
10875   "Mark all articles in this newsgroup as read, and then exit.
10876 This command is dangerous.  Normally, you want \\[gnus-summary-catchup-and-exit]
10877 instead, which marks only unread articles as read."
10878   (interactive "P")
10879   (gnus-summary-catchup-and-exit t quietly))
10880
10881 (defun gnus-summary-catchup-and-goto-next-group (&optional all)
10882   "Mark all articles in this group as read and select the next group.
10883 If given a prefix, mark all articles, unread as well as ticked, as
10884 read."
10885   (interactive "P")
10886   (save-excursion
10887     (gnus-summary-catchup all))
10888   (gnus-summary-next-group))
10889
10890 (defun gnus-summary-catchup-and-goto-prev-group (&optional all)
10891   "Mark all articles in this group as read and select the previous group.
10892 If given a prefix, mark all articles, unread as well as ticked, as
10893 read."
10894   (interactive "P")
10895   (save-excursion
10896     (gnus-summary-catchup all))
10897   (gnus-summary-next-group nil nil t))
10898
10899 ;;;
10900 ;;; with article
10901 ;;;
10902
10903 (defmacro gnus-with-article (article &rest forms)
10904   "Select ARTICLE and perform FORMS in the original article buffer.
10905 Then replace the article with the result."
10906   `(progn
10907      ;; We don't want the article to be marked as read.
10908      (let (gnus-mark-article-hook)
10909        (gnus-summary-select-article t t nil ,article))
10910      (set-buffer gnus-original-article-buffer)
10911      ,@forms
10912      (if (not (gnus-check-backend-function
10913                'request-replace-article (car gnus-article-current)))
10914          (gnus-message 5 "Read-only group; not replacing")
10915        (unless (gnus-request-replace-article
10916                 ,article (car gnus-article-current)
10917                 (current-buffer) t)
10918          (error "Couldn't replace article")))
10919      ;; The cache and backlog have to be flushed somewhat.
10920      (when gnus-keep-backlog
10921        (gnus-backlog-remove-article
10922         (car gnus-article-current) (cdr gnus-article-current)))
10923      (when gnus-use-cache
10924        (gnus-cache-update-article
10925         (car gnus-article-current) (cdr gnus-article-current)))))
10926
10927 (put 'gnus-with-article 'lisp-indent-function 1)
10928 (put 'gnus-with-article 'edebug-form-spec '(form body))
10929
10930 ;; Thread-based commands.
10931
10932 (defun gnus-summary-articles-in-thread (&optional article)
10933   "Return a list of all articles in the current thread.
10934 If ARTICLE is non-nil, return all articles in the thread that starts
10935 with that article."
10936   (let* ((article (or article (gnus-summary-article-number)))
10937          (data (gnus-data-find-list article))
10938          (top-level (gnus-data-level (car data)))
10939          (top-subject
10940           (cond ((null gnus-thread-operation-ignore-subject)
10941                  (gnus-simplify-subject-re
10942                   (mail-header-subject (gnus-data-header (car data)))))
10943                 ((eq gnus-thread-operation-ignore-subject 'fuzzy)
10944                  (gnus-simplify-subject-fuzzy
10945                   (mail-header-subject (gnus-data-header (car data)))))
10946                 (t nil)))
10947          (end-point (save-excursion
10948                       (if (gnus-summary-go-to-next-thread)
10949                           (point) (point-max))))
10950          articles)
10951     (while (and data
10952                 (< (gnus-data-pos (car data)) end-point))
10953       (when (or (not top-subject)
10954                 (string= top-subject
10955                          (if (eq gnus-thread-operation-ignore-subject 'fuzzy)
10956                              (gnus-simplify-subject-fuzzy
10957                               (mail-header-subject
10958                                (gnus-data-header (car data))))
10959                            (gnus-simplify-subject-re
10960                             (mail-header-subject
10961                              (gnus-data-header (car data)))))))
10962         (push (gnus-data-number (car data)) articles))
10963       (unless (and (setq data (cdr data))
10964                    (> (gnus-data-level (car data)) top-level))
10965         (setq data nil)))
10966     ;; Return the list of articles.
10967     (nreverse articles)))
10968
10969 (defun gnus-summary-rethread-current ()
10970   "Rethread the thread the current article is part of."
10971   (interactive)
10972   (let* ((gnus-show-threads t)
10973          (article (gnus-summary-article-number))
10974          (id (mail-header-id (gnus-summary-article-header)))
10975          (gnus-newsgroup-threads (list (gnus-id-to-thread (gnus-root-id id)))))
10976     (unless id
10977       (error "No article on the current line"))
10978     (gnus-rebuild-thread id)
10979     (gnus-summary-goto-subject article)))
10980
10981 (defun gnus-summary-reparent-thread ()
10982   "Make the current article child of the marked (or previous) article.
10983
10984 Note that the re-threading will only work if `gnus-thread-ignore-subject'
10985 is non-nil or the Subject: of both articles are the same."
10986   (interactive)
10987   (unless (not (gnus-group-read-only-p))
10988     (error "The current newsgroup does not support article editing"))
10989   (unless (<= (length gnus-newsgroup-processable) 1)
10990     (error "No more than one article may be marked"))
10991   (let ((child (gnus-summary-article-number))
10992         ;; First grab the marked article, otherwise one line up.
10993         (parent (if (not (null gnus-newsgroup-processable))
10994                     (car gnus-newsgroup-processable)
10995                   (save-excursion
10996                     (if (eq (forward-line -1) 0)
10997                         (gnus-summary-article-number)
10998                       (error "Beginning of summary buffer"))))))
10999     (gnus-summary-reparent-children parent (list child))))
11000
11001 (defun gnus-summary-reparent-children (parent children)
11002   "Make PARENT the parent of CHILDREN.
11003 When called interactively, PARENT is the current article and CHILDREN
11004 are the process-marked articles."
11005   (interactive
11006    (list (gnus-summary-article-number)
11007          (gnus-summary-work-articles nil)))
11008   (dolist (child children)
11009     (save-window-excursion
11010       (let ((gnus-article-buffer " *reparent*"))
11011         (unless (not (eq parent child))
11012           (error "An article may not be self-referential"))
11013         (let ((message-id (mail-header-id
11014                            (gnus-summary-article-header parent))))
11015           (unless (and message-id (not (equal message-id "")))
11016             (error "No message-id in desired parent"))
11017           (gnus-with-article child
11018             (save-restriction
11019               (goto-char (point-min))
11020               (message-narrow-to-head)
11021               (if (re-search-forward "^References: " nil t)
11022                   (progn
11023                     (re-search-forward "^[^ \t]" nil t)
11024                     (forward-line -1)
11025                     (end-of-line)
11026                     (insert " " message-id))
11027                 (insert "References: " message-id "\n"))))
11028           (set-buffer gnus-summary-buffer)
11029           (gnus-summary-unmark-all-processable)
11030           (gnus-summary-update-article child)
11031           (when (gnus-summary-goto-subject (cdr gnus-article-current) nil t)
11032             (gnus-summary-update-secondary-mark (cdr gnus-article-current)))
11033           (gnus-summary-rethread-current)
11034           (gnus-message 3 "Article %d is now the child of article %d"
11035                         child parent))))))
11036
11037 (defun gnus-summary-toggle-threads (&optional arg)
11038   "Toggle showing conversation threads.
11039 If ARG is positive number, turn showing conversation threads on."
11040   (interactive "P")
11041   (let ((current (or (gnus-summary-article-number) gnus-newsgroup-end)))
11042     (setq gnus-show-threads
11043           (if (null arg) (not gnus-show-threads)
11044             (> (prefix-numeric-value arg) 0)))
11045     (gnus-summary-prepare)
11046     (gnus-summary-goto-subject current)
11047     (gnus-message 6 "Threading is now %s" (if gnus-show-threads "on" "off"))
11048     (gnus-summary-position-point)))
11049
11050 (defun gnus-summary-show-all-threads ()
11051   "Show all threads."
11052   (interactive)
11053   (save-excursion
11054     (let ((buffer-read-only nil))
11055       (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)))
11056   (gnus-summary-position-point))
11057
11058 (defun gnus-summary-show-thread ()
11059   "Show thread subtrees.
11060 Returns nil if no thread was there to be shown."
11061   (interactive)
11062   (let ((buffer-read-only nil)
11063         (orig (point))
11064         (end (point-at-eol))
11065         ;; Leave point at bol
11066         (beg (progn (beginning-of-line) (point))))
11067     (prog1
11068         ;; Any hidden lines here?
11069         (search-forward "\r" end t)
11070       (subst-char-in-region beg end ?\^M ?\n t)
11071       (goto-char orig)
11072       (gnus-summary-position-point))))
11073
11074 (defun gnus-summary-maybe-hide-threads ()
11075   "If requested, hide the threads that should be hidden."
11076   (when (and gnus-show-threads
11077              gnus-thread-hide-subtree)
11078     (gnus-summary-hide-all-threads
11079      (if (or (consp gnus-thread-hide-subtree)
11080              (functionp gnus-thread-hide-subtree))
11081          (gnus-make-predicate gnus-thread-hide-subtree)
11082        nil))))
11083
11084 ;;; Hiding predicates.
11085
11086 (defun gnus-article-unread-p (header)
11087   (memq (mail-header-number header) gnus-newsgroup-unreads))
11088
11089 (defun gnus-article-unseen-p (header)
11090   (memq (mail-header-number header) gnus-newsgroup-unseen))
11091
11092 (defun gnus-map-articles (predicate articles)
11093   "Map PREDICATE over ARTICLES and return non-nil if any predicate is non-nil."
11094   (apply 'gnus-or (mapcar predicate
11095                           (mapcar (lambda (number)
11096                                     (gnus-summary-article-header number))
11097                                   articles))))
11098
11099 (defun gnus-summary-hide-all-threads (&optional predicate)
11100   "Hide all thread subtrees.
11101 If PREDICATE is supplied, threads that satisfy this predicate
11102 will not be hidden."
11103   (interactive)
11104   (save-excursion
11105     (goto-char (point-min))
11106     (let ((end nil))
11107       (while (not end)
11108         (when (or (not predicate)
11109                   (gnus-map-articles
11110                    predicate (gnus-summary-article-children)))
11111             (gnus-summary-hide-thread))
11112         (setq end (not (zerop (gnus-summary-next-thread 1 t)))))))
11113   (gnus-summary-position-point))
11114
11115 (defun gnus-summary-hide-thread ()
11116   "Hide thread subtrees.
11117 If PREDICATE is supplied, threads that satisfy this predicate
11118 will not be hidden.
11119 Returns nil if no threads were there to be hidden."
11120   (interactive)
11121   (let ((buffer-read-only nil)
11122         (start (point))
11123         (article (gnus-summary-article-number)))
11124     (goto-char start)
11125     ;; Go forward until either the buffer ends or the subthread
11126     ;; ends.
11127     (when (and (not (eobp))
11128                (or (zerop (gnus-summary-next-thread 1 t))
11129                    (goto-char (point-max))))
11130       (prog1
11131           (if (and (> (point) start)
11132                    (search-backward "\n" start t))
11133               (progn
11134                 (subst-char-in-region start (point) ?\n ?\^M)
11135                 (gnus-summary-goto-subject article))
11136             (goto-char start)
11137             nil)))))
11138
11139 (defun gnus-summary-go-to-next-thread (&optional previous)
11140   "Go to the same level (or less) next thread.
11141 If PREVIOUS is non-nil, go to previous thread instead.
11142 Return the article number moved to, or nil if moving was impossible."
11143   (let ((level (gnus-summary-thread-level))
11144         (way (if previous -1 1))
11145         (beg (point)))
11146     (forward-line way)
11147     (while (and (not (eobp))
11148                 (< level (gnus-summary-thread-level)))
11149       (forward-line way))
11150     (if (eobp)
11151         (progn
11152           (goto-char beg)
11153           nil)
11154       (setq beg (point))
11155       (prog1
11156           (gnus-summary-article-number)
11157         (goto-char beg)))))
11158
11159 (defun gnus-summary-next-thread (n &optional silent)
11160   "Go to the same level next N'th thread.
11161 If N is negative, search backward instead.
11162 Returns the difference between N and the number of skips actually
11163 done.
11164
11165 If SILENT, don't output messages."
11166   (interactive "p")
11167   (let ((backward (< n 0))
11168         (n (abs n)))
11169     (while (and (> n 0)
11170                 (gnus-summary-go-to-next-thread backward))
11171       (decf n))
11172     (unless silent
11173       (gnus-summary-position-point))
11174     (when (and (not silent) (/= 0 n))
11175       (gnus-message 7 "No more threads"))
11176     n))
11177
11178 (defun gnus-summary-prev-thread (n)
11179   "Go to the same level previous N'th thread.
11180 Returns the difference between N and the number of skips actually
11181 done."
11182   (interactive "p")
11183   (gnus-summary-next-thread (- n)))
11184
11185 (defun gnus-summary-go-down-thread ()
11186   "Go down one level in the current thread."
11187   (let ((children (gnus-summary-article-children)))
11188     (when children
11189       (gnus-summary-goto-subject (car children)))))
11190
11191 (defun gnus-summary-go-up-thread ()
11192   "Go up one level in the current thread."
11193   (let ((parent (gnus-summary-article-parent)))
11194     (when parent
11195       (gnus-summary-goto-subject parent))))
11196
11197 (defun gnus-summary-down-thread (n)
11198   "Go down thread N steps.
11199 If N is negative, go up instead.
11200 Returns the difference between N and how many steps down that were
11201 taken."
11202   (interactive "p")
11203   (let ((up (< n 0))
11204         (n (abs n)))
11205     (while (and (> n 0)
11206                 (if up (gnus-summary-go-up-thread)
11207                   (gnus-summary-go-down-thread)))
11208       (setq n (1- n)))
11209     (gnus-summary-position-point)
11210     (when (/= 0 n)
11211       (gnus-message 7 "Can't go further"))
11212     n))
11213
11214 (defun gnus-summary-up-thread (n)
11215   "Go up thread N steps.
11216 If N is negative, go down instead.
11217 Returns the difference between N and how many steps down that were
11218 taken."
11219   (interactive "p")
11220   (gnus-summary-down-thread (- n)))
11221
11222 (defun gnus-summary-top-thread ()
11223   "Go to the top of the thread."
11224   (interactive)
11225   (while (gnus-summary-go-up-thread))
11226   (gnus-summary-article-number))
11227
11228 (defun gnus-summary-kill-thread (&optional unmark)
11229   "Mark articles under current thread as read.
11230 If the prefix argument is positive, remove any kinds of marks.
11231 If the prefix argument is negative, tick articles instead."
11232   (interactive "P")
11233   (when unmark
11234     (setq unmark (prefix-numeric-value unmark)))
11235   (let ((articles (gnus-summary-articles-in-thread)))
11236     (save-excursion
11237       ;; Expand the thread.
11238       (gnus-summary-show-thread)
11239       ;; Mark all the articles.
11240       (while articles
11241         (gnus-summary-goto-subject (car articles))
11242         (cond ((null unmark)
11243                (gnus-summary-mark-article-as-read gnus-killed-mark))
11244               ((> unmark 0)
11245                (gnus-summary-mark-article-as-unread gnus-unread-mark))
11246               (t
11247                (gnus-summary-mark-article-as-unread gnus-ticked-mark)))
11248         (setq articles (cdr articles))))
11249     ;; Hide killed subtrees.
11250     (and (null unmark)
11251          gnus-thread-hide-killed
11252          (gnus-summary-hide-thread))
11253     ;; If marked as read, go to next unread subject.
11254     (when (null unmark)
11255       ;; Go to next unread subject.
11256       (gnus-summary-next-subject 1 t)))
11257   (gnus-set-mode-line 'summary))
11258
11259 ;; Summary sorting commands
11260
11261 (defun gnus-summary-sort-by-number (&optional reverse)
11262   "Sort the summary buffer by article number.
11263 Argument REVERSE means reverse order."
11264   (interactive "P")
11265   (gnus-summary-sort 'number reverse))
11266
11267 (defun gnus-summary-sort-by-random (&optional reverse)
11268   "Randomize the order in the summary buffer.
11269 Argument REVERSE means to randomize in reverse order."
11270   (interactive "P")
11271   (gnus-summary-sort 'random reverse))
11272
11273 (defun gnus-summary-sort-by-author (&optional reverse)
11274   "Sort the summary buffer by author name alphabetically.
11275 If `case-fold-search' is non-nil, case of letters is ignored.
11276 Argument REVERSE means reverse order."
11277   (interactive "P")
11278   (gnus-summary-sort 'author reverse))
11279
11280 (defun gnus-summary-sort-by-recipient (&optional reverse)
11281   "Sort the summary buffer by recipient name alphabetically.
11282 If `case-fold-search' is non-nil, case of letters is ignored.
11283 Argument REVERSE means reverse order."
11284   (interactive "P")
11285   (gnus-summary-sort 'recipient reverse))
11286
11287 (defun gnus-summary-sort-by-subject (&optional reverse)
11288   "Sort the summary buffer by subject alphabetically.  `Re:'s are ignored.
11289 If `case-fold-search' is non-nil, case of letters is ignored.
11290 Argument REVERSE means reverse order."
11291   (interactive "P")
11292   (gnus-summary-sort 'subject reverse))
11293
11294 (defun gnus-summary-sort-by-date (&optional reverse)
11295   "Sort the summary buffer by date.
11296 Argument REVERSE means reverse order."
11297   (interactive "P")
11298   (gnus-summary-sort 'date reverse))
11299
11300 (defun gnus-summary-sort-by-score (&optional reverse)
11301   "Sort the summary buffer by score.
11302 Argument REVERSE means reverse order."
11303   (interactive "P")
11304   (gnus-summary-sort 'score reverse))
11305
11306 (defun gnus-summary-sort-by-lines (&optional reverse)
11307   "Sort the summary buffer by the number of lines.
11308 Argument REVERSE means reverse order."
11309   (interactive "P")
11310   (gnus-summary-sort 'lines reverse))
11311
11312 (defun gnus-summary-sort-by-chars (&optional reverse)
11313   "Sort the summary buffer by article length.
11314 Argument REVERSE means reverse order."
11315   (interactive "P")
11316   (gnus-summary-sort 'chars reverse))
11317
11318 (defun gnus-summary-sort-by-original (&optional reverse)
11319   "Sort the summary buffer using the default sorting method.
11320 Argument REVERSE means reverse order."
11321   (interactive "P")
11322   (let* ((buffer-read-only)
11323          (gnus-summary-prepare-hook nil))
11324     ;; We do the sorting by regenerating the threads.
11325     (gnus-summary-prepare)
11326     ;; Hide subthreads if needed.
11327     (gnus-summary-maybe-hide-threads)))
11328
11329 (defun gnus-summary-sort (predicate reverse)
11330   "Sort summary buffer by PREDICATE.  REVERSE means reverse order."
11331   (let* ((thread (intern (format "gnus-thread-sort-by-%s" predicate)))
11332          (article (intern (format "gnus-article-sort-by-%s" predicate)))
11333          (gnus-thread-sort-functions
11334           (if (not reverse)
11335               thread
11336             `(lambda (t1 t2)
11337                (,thread t2 t1))))
11338          (gnus-sort-gathered-threads-function
11339           gnus-thread-sort-functions)
11340          (gnus-article-sort-functions
11341           (if (not reverse)
11342               article
11343             `(lambda (t1 t2)
11344                (,article t2 t1))))
11345          (buffer-read-only)
11346          (gnus-summary-prepare-hook nil))
11347     ;; We do the sorting by regenerating the threads.
11348     (gnus-summary-prepare)
11349     ;; Hide subthreads if needed.
11350     (gnus-summary-maybe-hide-threads)))
11351
11352 ;; Summary saving commands.
11353
11354 (defun gnus-summary-save-article (&optional n not-saved)
11355   "Save the current article using the default saver function.
11356 If N is a positive number, save the N next articles.
11357 If N is a negative number, save the N previous articles.
11358 If N is nil and any articles have been marked with the process mark,
11359 save those articles instead.
11360 The variable `gnus-default-article-saver' specifies the saver function.
11361
11362 If the optional second argument NOT-SAVED is non-nil, articles saved
11363 will not be marked as saved."
11364   (interactive "P")
11365   (require 'gnus-art)
11366   (let* ((articles (gnus-summary-work-articles n))
11367          (save-buffer (save-excursion
11368                         (nnheader-set-temp-buffer " *Gnus Save*")))
11369          (num (length articles))
11370          ;; Whether to save decoded articles or raw articles.
11371          (decode (when gnus-article-save-coding-system
11372                    (get gnus-default-article-saver :decode)))
11373          ;; When saving many articles in a single file, use the other
11374          ;; function to save articles other than the first one.
11375          (saver2 (get gnus-default-article-saver :function))
11376          (gnus-prompt-before-saving (if saver2
11377                                         t
11378                                       gnus-prompt-before-saving))
11379          (gnus-default-article-saver gnus-default-article-saver)
11380          header file)
11381     (dolist (article articles)
11382       (setq header (gnus-summary-article-header article))
11383       (if (not (vectorp header))
11384           ;; This is a pseudo-article.
11385           (if (assq 'name header)
11386               (gnus-copy-file (cdr (assq 'name header)))
11387             (gnus-message 1 "Article %d is unsaveable" article))
11388         ;; This is a real article.
11389         (save-window-excursion
11390           (let ((gnus-display-mime-function (when decode
11391                                               gnus-display-mime-function))
11392                 (gnus-article-prepare-hook (when decode
11393                                              gnus-article-prepare-hook)))
11394             (gnus-summary-select-article t nil nil article)
11395             (gnus-summary-goto-subject article)))
11396         (save-excursion
11397           (set-buffer save-buffer)
11398           (erase-buffer)
11399           (insert-buffer-substring (if decode
11400                                        gnus-article-buffer
11401                                      gnus-original-article-buffer)))
11402         (setq file (gnus-article-save save-buffer file num))
11403         (gnus-summary-remove-process-mark article)
11404         (unless not-saved
11405           (gnus-summary-set-saved-mark article)))
11406       (when saver2
11407         (setq gnus-default-article-saver saver2
11408               saver2 nil)))
11409     (gnus-kill-buffer save-buffer)
11410     (gnus-summary-position-point)
11411     (gnus-set-mode-line 'summary)
11412     n))
11413
11414 (defun gnus-summary-pipe-output (&optional arg headers)
11415   "Pipe the current article to a subprocess.
11416 If N is a positive number, pipe the N next articles.
11417 If N is a negative number, pipe the N previous articles.
11418 If N is nil and any articles have been marked with the process mark,
11419 pipe those articles instead.
11420 If HEADERS (the symbolic prefix), include the headers, too."
11421   (interactive (gnus-interactive "P\ny"))
11422   (require 'gnus-art)
11423   (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe)
11424         (gnus-save-all-headers (or headers gnus-save-all-headers)))
11425     (gnus-summary-save-article arg t))
11426   (let ((buffer (get-buffer "*Shell Command Output*")))
11427     (when (and buffer
11428                (not (zerop (buffer-size buffer))))
11429       (gnus-configure-windows 'pipe))))
11430
11431 (defun gnus-summary-save-article-mail (&optional arg)
11432   "Append the current article to a Unix mail box file.
11433 If N is a positive number, save the N next articles.
11434 If N is a negative number, save the N previous articles.
11435 If N is nil and any articles have been marked with the process mark,
11436 save those articles instead."
11437   (interactive "P")
11438   (require 'gnus-art)
11439   (let ((gnus-default-article-saver 'gnus-summary-save-in-mail))
11440     (gnus-summary-save-article arg)))
11441
11442 (defun gnus-summary-save-article-rmail (&optional arg)
11443   "Append the current article to an rmail file.
11444 If N is a positive number, save the N next articles.
11445 If N is a negative number, save the N previous articles.
11446 If N is nil and any articles have been marked with the process mark,
11447 save those articles instead."
11448   (interactive "P")
11449   (require 'gnus-art)
11450   (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail))
11451     (gnus-summary-save-article arg)))
11452
11453 (defun gnus-summary-save-article-file (&optional arg)
11454   "Append the current article to a file.
11455 If N is a positive number, save the N next articles.
11456 If N is a negative number, save the N previous articles.
11457 If N is nil and any articles have been marked with the process mark,
11458 save those articles instead."
11459   (interactive "P")
11460   (require 'gnus-art)
11461   (let ((gnus-default-article-saver 'gnus-summary-save-in-file))
11462     (gnus-summary-save-article arg)))
11463
11464 (defun gnus-summary-write-article-file (&optional arg)
11465   "Write the current article to a file, deleting the previous file.
11466 If N is a positive number, save the N next articles.
11467 If N is a negative number, save the N previous articles.
11468 If N is nil and any articles have been marked with the process mark,
11469 save those articles instead."
11470   (interactive "P")
11471   (require 'gnus-art)
11472   (let ((gnus-default-article-saver 'gnus-summary-write-to-file))
11473     (gnus-summary-save-article arg)))
11474
11475 (defun gnus-summary-save-article-body-file (&optional arg)
11476   "Append the current article body to a file.
11477 If N is a positive number, save the N next articles.
11478 If N is a negative number, save the N previous articles.
11479 If N is nil and any articles have been marked with the process mark,
11480 save those articles instead."
11481   (interactive "P")
11482   (require 'gnus-art)
11483   (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file))
11484     (gnus-summary-save-article arg)))
11485
11486 (defun gnus-summary-write-article-body-file (&optional arg)
11487   "Write the current article body to a file, deleting the previous file.
11488 If N is a positive number, save the N next articles.
11489 If N is a negative number, save the N previous articles.
11490 If N is nil and any articles have been marked with the process mark,
11491 save those articles instead."
11492   (interactive "P")
11493   (require 'gnus-art)
11494   (let ((gnus-default-article-saver 'gnus-summary-write-body-to-file))
11495     (gnus-summary-save-article arg)))
11496
11497 (defun gnus-summary-muttprint (&optional arg)
11498   "Print the current article using Muttprint.
11499 If N is a positive number, save the N next articles.
11500 If N is a negative number, save the N previous articles.
11501 If N is nil and any articles have been marked with the process mark,
11502 save those articles instead."
11503   (interactive "P")
11504   (require 'gnus-art)
11505   (let ((gnus-default-article-saver 'gnus-summary-pipe-to-muttprint))
11506     (gnus-summary-save-article arg t)))
11507
11508 (defun gnus-summary-pipe-message (program)
11509   "Pipe the current article through PROGRAM."
11510   (interactive "sProgram: ")
11511   (gnus-summary-select-article)
11512   (let ((mail-header-separator ""))
11513     (gnus-eval-in-buffer-window gnus-article-buffer
11514       (save-restriction
11515         (widen)
11516         (let ((start (window-start))
11517               buffer-read-only)
11518           (message-pipe-buffer-body program)
11519           (set-window-start (get-buffer-window (current-buffer)) start))))))
11520
11521 (defun gnus-get-split-value (methods)
11522   "Return a value based on the split METHODS."
11523   (let (split-name method result match)
11524     (when methods
11525       (save-excursion
11526         (set-buffer gnus-original-article-buffer)
11527         (save-restriction
11528           (nnheader-narrow-to-headers)
11529           (while (and methods (not split-name))
11530             (goto-char (point-min))
11531             (setq method (pop methods))
11532             (setq match (car method))
11533             (when (cond
11534                    ((stringp match)
11535                     ;; Regular expression.
11536                     (ignore-errors
11537                       (re-search-forward match nil t)))
11538                    ((functionp match)
11539                     ;; Function.
11540                     (save-restriction
11541                       (widen)
11542                       (setq result (funcall match gnus-newsgroup-name))))
11543                    ((consp match)
11544                     ;; Form.
11545                     (save-restriction
11546                       (widen)
11547                       (setq result (eval match)))))
11548               (setq split-name (cdr method))
11549               (cond ((stringp result)
11550                      (push (expand-file-name
11551                             result gnus-article-save-directory)
11552                            split-name))
11553                     ((consp result)
11554                      (setq split-name (append result split-name)))))))))
11555     (nreverse split-name)))
11556
11557 (defun gnus-valid-move-group-p (group)
11558   (and (boundp group)
11559        (symbol-name group)
11560        (symbol-value group)
11561        (gnus-get-function (gnus-find-method-for-group
11562                            (symbol-name group)) 'request-accept-article t)))
11563
11564 (defun gnus-read-move-group-name (prompt default articles prefix)
11565   "Read a group name."
11566   (let* ((split-name (gnus-get-split-value gnus-move-split-methods))
11567          (minibuffer-confirm-incomplete nil) ; XEmacs
11568          (prom
11569           (format "%s %s to"
11570                   prompt
11571                   (if (> (length articles) 1)
11572                       (format "these %d articles" (length articles))
11573                     "this article")))
11574          (to-newsgroup
11575           (cond
11576            ((null split-name)
11577             (gnus-completing-read-with-default
11578              default prom
11579              gnus-active-hashtb
11580              'gnus-valid-move-group-p
11581              nil prefix
11582              'gnus-group-history))
11583            ((= 1 (length split-name))
11584             (gnus-completing-read-with-default
11585              (car split-name) prom
11586              gnus-active-hashtb
11587              'gnus-valid-move-group-p
11588              nil nil
11589              'gnus-group-history))
11590            (t
11591             (gnus-completing-read-with-default
11592              nil prom
11593              (mapcar 'list (nreverse split-name))
11594              nil nil nil
11595              'gnus-group-history))))
11596          (to-method (gnus-server-to-method (gnus-group-method to-newsgroup))))
11597     (when to-newsgroup
11598       (if (or (string= to-newsgroup "")
11599               (string= to-newsgroup prefix))
11600           (setq to-newsgroup default))
11601       (unless to-newsgroup
11602         (error "No group name entered"))
11603       (or (gnus-active to-newsgroup)
11604           (gnus-activate-group to-newsgroup nil nil to-method)
11605           (if (gnus-y-or-n-p (format "No such group: %s.  Create it? "
11606                                      to-newsgroup))
11607               (or (and (gnus-request-create-group to-newsgroup to-method)
11608                        (gnus-activate-group
11609                         to-newsgroup nil nil to-method)
11610                        (gnus-subscribe-group to-newsgroup))
11611                   (error "Couldn't create group %s" to-newsgroup)))
11612           (error "No such group: %s" to-newsgroup)))
11613     to-newsgroup))
11614
11615 (defvar gnus-summary-save-parts-counter)
11616
11617 (defun gnus-summary-save-parts (type dir n &optional reverse)
11618   "Save parts matching TYPE to DIR.
11619 If REVERSE, save parts that do not match TYPE."
11620   (interactive
11621    (list (read-string "Save parts of type: "
11622                       (or (car gnus-summary-save-parts-type-history)
11623                           gnus-summary-save-parts-default-mime)
11624                       'gnus-summary-save-parts-type-history)
11625          (setq gnus-summary-save-parts-last-directory
11626                (read-file-name "Save to directory: "
11627                                gnus-summary-save-parts-last-directory
11628                                nil t))
11629          current-prefix-arg))
11630   (gnus-summary-iterate n
11631     (let ((gnus-display-mime-function nil)
11632           (gnus-inhibit-treatment t))
11633       (gnus-summary-select-article))
11634     (save-excursion
11635       (set-buffer gnus-article-buffer)
11636       (let ((handles (or gnus-article-mime-handles
11637                          (mm-dissect-buffer nil gnus-article-loose-mime)
11638                          (and gnus-article-emulate-mime
11639                               (mm-uu-dissect))))
11640             (gnus-summary-save-parts-counter 1))
11641         (when handles
11642           (gnus-summary-save-parts-1 type dir handles reverse)
11643           (unless gnus-article-mime-handles ;; Don't destroy this case.
11644             (mm-destroy-parts handles)))))))
11645
11646 (defun gnus-summary-save-parts-1 (type dir handle reverse)
11647   (if (stringp (car handle))
11648       (mapcar (lambda (h) (gnus-summary-save-parts-1 type dir h reverse))
11649               (cdr handle))
11650     (when (if reverse
11651               (not (string-match type (mm-handle-media-type handle)))
11652             (string-match type (mm-handle-media-type handle)))
11653       (let ((file (expand-file-name
11654                    (gnus-map-function
11655                     mm-file-name-rewrite-functions
11656                     (file-name-nondirectory
11657                      (or
11658                       (mail-content-type-get
11659                        (mm-handle-disposition handle) 'filename)
11660                       (mail-content-type-get
11661                        (mm-handle-type handle) 'name)
11662                       (format "%s.%d.%d" gnus-newsgroup-name
11663                               (cdr gnus-article-current)
11664                               gnus-summary-save-parts-counter))))
11665                    dir)))
11666         (incf gnus-summary-save-parts-counter)
11667         (unless (file-exists-p file)
11668           (mm-save-part-to-file handle file))))))
11669
11670 ;; Summary extract commands
11671
11672 (defun gnus-summary-insert-pseudos (pslist &optional not-view)
11673   (let ((buffer-read-only nil)
11674         (article (gnus-summary-article-number))
11675         after-article b e)
11676     (unless (gnus-summary-goto-subject article)
11677       (error "No such article: %d" article))
11678     (gnus-summary-position-point)
11679     ;; If all commands are to be bunched up on one line, we collect
11680     ;; them here.
11681     (unless gnus-view-pseudos-separately
11682       (let ((ps (setq pslist (sort pslist 'gnus-pseudos<)))
11683             files action)
11684         (while ps
11685           (setq action (cdr (assq 'action (car ps))))
11686           (setq files (list (cdr (assq 'name (car ps)))))
11687           (while (and ps (cdr ps)
11688                       (string= (or action "1")
11689                                (or (cdr (assq 'action (cadr ps))) "2")))
11690             (push (cdr (assq 'name (cadr ps))) files)
11691             (setcdr ps (cddr ps)))
11692           (when files
11693             (when (not (string-match "%s" action))
11694               (push " " files))
11695             (push " " files)
11696             (when (assq 'execute (car ps))
11697               (setcdr (assq 'execute (car ps))
11698                       (funcall (if (string-match "%s" action)
11699                                    'format 'concat)
11700                                action
11701                                (mapconcat
11702                                 (lambda (f)
11703                                   (if (equal f " ")
11704                                       f
11705                                     (shell-quote-argument f)))
11706                                 files " ")))))
11707           (setq ps (cdr ps)))))
11708     (if (and gnus-view-pseudos (not not-view))
11709         (while pslist
11710           (when (assq 'execute (car pslist))
11711             (gnus-execute-command (cdr (assq 'execute (car pslist)))
11712                                   (eq gnus-view-pseudos 'not-confirm)))
11713           (setq pslist (cdr pslist)))
11714       (save-excursion
11715         (while pslist
11716           (setq after-article (or (cdr (assq 'article (car pslist)))
11717                                   (gnus-summary-article-number)))
11718           (gnus-summary-goto-subject after-article)
11719           (forward-line 1)
11720           (setq b (point))
11721           (insert "    " (file-name-nondirectory
11722                           (cdr (assq 'name (car pslist))))
11723                   ": " (or (cdr (assq 'execute (car pslist))) "") "\n")
11724           (setq e (point))
11725           (forward-line -1)             ; back to `b'
11726           (gnus-add-text-properties
11727            b (1- e) (list 'gnus-number gnus-reffed-article-number
11728                           gnus-mouse-face-prop gnus-mouse-face))
11729           (gnus-data-enter
11730            after-article gnus-reffed-article-number
11731            gnus-unread-mark b (car pslist) 0 (- e b))
11732           (setq gnus-newsgroup-unreads
11733                 (gnus-add-to-sorted-list gnus-newsgroup-unreads
11734                                          gnus-reffed-article-number))
11735           (setq gnus-reffed-article-number (1- gnus-reffed-article-number))
11736           (setq pslist (cdr pslist)))))))
11737
11738 (defun gnus-pseudos< (p1 p2)
11739   (let ((c1 (cdr (assq 'action p1)))
11740         (c2 (cdr (assq 'action p2))))
11741     (and c1 c2 (string< c1 c2))))
11742
11743 (defun gnus-request-pseudo-article (props)
11744   (cond ((assq 'execute props)
11745          (gnus-execute-command (cdr (assq 'execute props)))))
11746   (let ((gnus-current-article (gnus-summary-article-number)))
11747     (gnus-run-hooks 'gnus-mark-article-hook)))
11748
11749 (defun gnus-execute-command (command &optional automatic)
11750   (save-excursion
11751     (gnus-article-setup-buffer)
11752     (set-buffer gnus-article-buffer)
11753     (setq buffer-read-only nil)
11754     (let ((command (if automatic command
11755                      (read-string "Command: " (cons command 0)))))
11756       (erase-buffer)
11757       (insert "$ " command "\n\n")
11758       (if gnus-view-pseudo-asynchronously
11759           (start-process "gnus-execute" (current-buffer) shell-file-name
11760                          shell-command-switch command)
11761         (call-process shell-file-name nil t nil
11762                       shell-command-switch command)))))
11763
11764 ;; Summary kill commands.
11765
11766 (defun gnus-summary-edit-global-kill (article)
11767   "Edit the \"global\" kill file."
11768   (interactive (list (gnus-summary-article-number)))
11769   (gnus-group-edit-global-kill article))
11770
11771 (defun gnus-summary-edit-local-kill ()
11772   "Edit a local kill file applied to the current newsgroup."
11773   (interactive)
11774   (setq gnus-current-headers (gnus-summary-article-header))
11775   (gnus-group-edit-local-kill
11776    (gnus-summary-article-number) gnus-newsgroup-name))
11777
11778 ;;; Header reading.
11779
11780 (defun gnus-read-header (id &optional header)
11781   "Read the headers of article ID and enter them into the Gnus system."
11782   (let ((group gnus-newsgroup-name)
11783         (gnus-override-method
11784          (or
11785           gnus-override-method
11786           (and (gnus-news-group-p gnus-newsgroup-name)
11787                (car (gnus-refer-article-methods)))))
11788         where)
11789     ;; First we check to see whether the header in question is already
11790     ;; fetched.
11791     (if (stringp id)
11792         ;; This is a Message-ID.
11793         (setq header (or header (gnus-id-to-header id)))
11794       ;; This is an article number.
11795       (setq header (or header (gnus-summary-article-header id))))
11796     (if (and header
11797              (not (gnus-summary-article-sparse-p (mail-header-number header))))
11798         ;; We have found the header.
11799         header
11800       ;; We have to really fetch the header to this article.
11801       (save-excursion
11802         (set-buffer nntp-server-buffer)
11803         (when (setq where (gnus-request-head id group))
11804           (nnheader-fold-continuation-lines)
11805           (goto-char (point-max))
11806           (insert ".\n")
11807           (goto-char (point-min))
11808           (insert "211 ")
11809           (princ (cond
11810                   ((numberp id) id)
11811                   ((cdr where) (cdr where))
11812                   (header (mail-header-number header))
11813                   (t gnus-reffed-article-number))
11814                  (current-buffer))
11815           (insert " Article retrieved.\n"))
11816         (if (or (not where)
11817                 (not (setq header (car (gnus-get-newsgroup-headers nil t)))))
11818             ()                          ; Malformed head.
11819           (unless (gnus-summary-article-sparse-p (mail-header-number header))
11820             (when (and (stringp id)
11821                        (or
11822                         (not (string= (gnus-group-real-name group)
11823                                       (car where)))
11824                         (not (gnus-server-equal gnus-override-method
11825                                                 (gnus-group-method group)))))
11826               ;; If we fetched by Message-ID and the article came from
11827               ;; a different group (or server), we fudge some bogus
11828               ;; article numbers for this article.
11829               (mail-header-set-number header gnus-reffed-article-number))
11830             (save-excursion
11831               (set-buffer gnus-summary-buffer)
11832               (decf gnus-reffed-article-number)
11833               (gnus-remove-header (mail-header-number header))
11834               (push header gnus-newsgroup-headers)
11835               (setq gnus-current-headers header)
11836               (push (mail-header-number header) gnus-newsgroup-limit)))
11837           header)))))
11838
11839 (defun gnus-remove-header (number)
11840   "Remove header NUMBER from `gnus-newsgroup-headers'."
11841   (if (and gnus-newsgroup-headers
11842            (= number (mail-header-number (car gnus-newsgroup-headers))))
11843       (pop gnus-newsgroup-headers)
11844     (let ((headers gnus-newsgroup-headers))
11845       (while (and (cdr headers)
11846                   (not (= number (mail-header-number (cadr headers)))))
11847         (pop headers))
11848       (when (cdr headers)
11849         (setcdr headers (cddr headers))))))
11850
11851 ;;;
11852 ;;; summary highlights
11853 ;;;
11854
11855 (defun gnus-highlight-selected-summary ()
11856   "Highlight selected article in summary buffer."
11857   ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
11858   (when gnus-summary-selected-face
11859     (save-excursion
11860       (let* ((beg (point-at-bol))
11861              (end (point-at-eol))
11862              ;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>.
11863              (from (if (get-text-property beg gnus-mouse-face-prop)
11864                        beg
11865                      (or (next-single-property-change
11866                           beg gnus-mouse-face-prop nil end)
11867                          beg)))
11868              (to
11869               (if (= from end)
11870                   (- from 2)
11871                 (or (next-single-property-change
11872                      from gnus-mouse-face-prop nil end)
11873                     end))))
11874         ;; If no mouse-face prop on line we will have to = from = end,
11875         ;; so we highlight the entire line instead.
11876         (when (= (+ to 2) from)
11877           (setq from beg)
11878           (setq to end))
11879         (if gnus-newsgroup-selected-overlay
11880             ;; Move old overlay.
11881             (gnus-move-overlay
11882              gnus-newsgroup-selected-overlay from to (current-buffer))
11883           ;; Create new overlay.
11884           (gnus-overlay-put
11885            (setq gnus-newsgroup-selected-overlay (gnus-make-overlay from to))
11886            'face gnus-summary-selected-face))))))
11887
11888 (defvar gnus-summary-highlight-line-cached nil)
11889 (defvar gnus-summary-highlight-line-trigger nil)
11890
11891 (defun gnus-summary-highlight-line-0 ()
11892   (if (and (eq gnus-summary-highlight-line-trigger
11893                gnus-summary-highlight)
11894            gnus-summary-highlight-line-cached)
11895       gnus-summary-highlight-line-cached
11896     (setq gnus-summary-highlight-line-trigger gnus-summary-highlight
11897           gnus-summary-highlight-line-cached
11898           (let* ((cond (list 'cond))
11899                  (c cond)
11900                  (list gnus-summary-highlight))
11901             (while list
11902               (setcdr c (cons (list (caar list) (list 'quote (cdar list)))
11903                               nil))
11904               (setq c (cdr c)
11905                     list (cdr list)))
11906             (gnus-byte-compile (list 'lambda nil cond))))))
11907
11908 (defun gnus-summary-highlight-line ()
11909   "Highlight current line according to `gnus-summary-highlight'."
11910   (let* ((beg (point-at-bol))
11911          (article (or (gnus-summary-article-number) gnus-current-article))
11912          (score (or (cdr (assq article
11913                                gnus-newsgroup-scored))
11914                     gnus-summary-default-score 0))
11915          (mark (or (gnus-summary-article-mark) gnus-unread-mark))
11916          (inhibit-read-only t)
11917          (default gnus-summary-default-score)
11918          (default-high gnus-summary-default-high-score)
11919          (default-low gnus-summary-default-low-score)
11920          (uncached (and gnus-summary-use-undownloaded-faces
11921                         (memq article gnus-newsgroup-undownloaded)
11922                         (not (memq article gnus-newsgroup-cached)))))
11923     (let ((face (funcall (gnus-summary-highlight-line-0))))
11924       (unless (eq face (get-text-property beg 'face))
11925         (gnus-put-text-property-excluding-characters-with-faces
11926          beg (point-at-eol) 'face
11927          (setq face (if (boundp face) (symbol-value face) face)))
11928         (when gnus-summary-highlight-line-function
11929           (funcall gnus-summary-highlight-line-function article face))))))
11930
11931 (defun gnus-update-read-articles (group unread &optional compute)
11932   "Update the list of read articles in GROUP.
11933 UNREAD is a sorted list."
11934   (let ((active (or gnus-newsgroup-active (gnus-active group)))
11935         (info (gnus-get-info group))
11936         (prev 1)
11937         read)
11938     (if (or (not info) (not active))
11939         ;; There is no info on this group if it was, in fact,
11940         ;; killed.  Gnus stores no information on killed groups, so
11941         ;; there's nothing to be done.
11942         ;; One could store the information somewhere temporarily,
11943         ;; perhaps...  Hmmm...
11944         ()
11945       ;; Remove any negative articles numbers.
11946       (while (and unread (< (car unread) 0))
11947         (setq unread (cdr unread)))
11948       ;; Remove any expired article numbers
11949       (while (and unread (< (car unread) (car active)))
11950         (setq unread (cdr unread)))
11951       ;; Compute the ranges of read articles by looking at the list of
11952       ;; unread articles.
11953       (while unread
11954         (when (/= (car unread) prev)
11955           (push (if (= prev (1- (car unread))) prev
11956                   (cons prev (1- (car unread))))
11957                 read))
11958         (setq prev (1+ (car unread)))
11959         (setq unread (cdr unread)))
11960       (when (<= prev (cdr active))
11961         (push (cons prev (cdr active)) read))
11962       (setq read (if (> (length read) 1) (nreverse read) read))
11963       (if compute
11964           read
11965         (save-excursion
11966           (let (setmarkundo)
11967             ;; Propagate the read marks to the backend.
11968             (when (gnus-check-backend-function 'request-set-mark group)
11969               (let ((del (gnus-remove-from-range (gnus-info-read info) read))
11970                     (add (gnus-remove-from-range read (gnus-info-read info))))
11971                 (when (or add del)
11972                   (unless (gnus-check-group group)
11973                     (error "Can't open server for %s" group))
11974                   (gnus-request-set-mark
11975                    group (delq nil (list (if add (list add 'add '(read)))
11976                                          (if del (list del 'del '(read))))))
11977                   (setq setmarkundo
11978                         `(gnus-request-set-mark
11979                           ,group
11980                           ',(delq nil (list
11981                                        (if del (list del 'add '(read)))
11982                                        (if add (list add 'del '(read))))))))))
11983             (set-buffer gnus-group-buffer)
11984             (gnus-undo-register
11985               `(progn
11986                  (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
11987                  (gnus-info-set-read ',info ',(gnus-info-read info))
11988                  (gnus-get-unread-articles-in-group ',info
11989                                                     (gnus-active ,group))
11990                  (gnus-group-update-group ,group t)
11991                  ,setmarkundo))))
11992         ;; Enter this list into the group info.
11993         (gnus-info-set-read info read)
11994         ;; Set the number of unread articles in gnus-newsrc-hashtb.
11995         (gnus-get-unread-articles-in-group info (gnus-active group))
11996         t))))
11997
11998 (defun gnus-offer-save-summaries ()
11999   "Offer to save all active summary buffers."
12000   (let (buffers)
12001     ;; Go through all buffers and find all summaries.
12002     (dolist (buffer (buffer-list))
12003       (when (and (setq buffer (buffer-name buffer))
12004                  (string-match "Summary" buffer)
12005                  (with-current-buffer buffer
12006                    ;; We check that this is, indeed, a summary buffer.
12007                    (and (eq major-mode 'gnus-summary-mode)
12008                         ;; Also make sure this isn't bogus.
12009                         gnus-newsgroup-prepared
12010                         ;; Also make sure that this isn't a
12011                         ;; dead summary buffer.
12012                         (not gnus-dead-summary-mode))))
12013         (push buffer buffers)))
12014     ;; Go through all these summary buffers and offer to save them.
12015     (when buffers
12016       (save-excursion
12017         (map-y-or-n-p
12018          "Update summary buffer %s? "
12019          (lambda (buf)
12020            (switch-to-buffer buf)
12021            (gnus-summary-exit))
12022          buffers)))))
12023
12024 (defun gnus-summary-setup-default-charset ()
12025   "Setup newsgroup default charset."
12026   (if (member gnus-newsgroup-name '("nndraft:delayed" "nndraft:drafts"))
12027       (setq gnus-newsgroup-charset nil)
12028     (let* ((ignored-charsets
12029             (or gnus-newsgroup-ephemeral-ignored-charsets
12030                 (append
12031                  (and gnus-newsgroup-name
12032                       (gnus-parameter-ignored-charsets gnus-newsgroup-name))
12033                  gnus-newsgroup-ignored-charsets))))
12034       (setq gnus-newsgroup-charset
12035             (or gnus-newsgroup-ephemeral-charset
12036                 (and gnus-newsgroup-name
12037                      (gnus-parameter-charset gnus-newsgroup-name))
12038                 gnus-default-charset))
12039       (set (make-local-variable 'gnus-newsgroup-ignored-charsets)
12040            ignored-charsets))))
12041
12042 ;;;
12043 ;;; Mime Commands
12044 ;;;
12045
12046 (defun gnus-summary-display-buttonized (&optional show-all-parts)
12047   "Display the current article buffer fully MIME-buttonized.
12048 If SHOW-ALL-PARTS (the prefix) is non-nil, all multipart/* parts are
12049 treated as multipart/mixed."
12050   (interactive "P")
12051   (require 'gnus-art)
12052   (let ((gnus-unbuttonized-mime-types nil)
12053         (gnus-mime-display-multipart-as-mixed show-all-parts))
12054     (gnus-summary-show-article)))
12055
12056 (defun gnus-summary-repair-multipart (article)
12057   "Add a Content-Type header to a multipart article without one."
12058   (interactive (list (gnus-summary-article-number)))
12059   (gnus-with-article article
12060     (message-narrow-to-head)
12061     (message-remove-header "Mime-Version")
12062     (goto-char (point-max))
12063     (insert "Mime-Version: 1.0\n")
12064     (widen)
12065     (when (search-forward "\n--" nil t)
12066       (let ((separator (buffer-substring (point) (point-at-eol))))
12067         (message-narrow-to-head)
12068         (message-remove-header "Content-Type")
12069         (goto-char (point-max))
12070         (insert (format "Content-Type: multipart/mixed; boundary=\"%s\"\n"
12071                         separator))
12072         (widen))))
12073   (let (gnus-mark-article-hook)
12074     (gnus-summary-select-article t t nil article)))
12075
12076 (defun gnus-summary-toggle-display-buttonized ()
12077   "Toggle the buttonizing of the article buffer."
12078   (interactive)
12079   (require 'gnus-art)
12080   (if (setq gnus-inhibit-mime-unbuttonizing
12081             (not gnus-inhibit-mime-unbuttonizing))
12082       (let ((gnus-unbuttonized-mime-types nil))
12083         (gnus-summary-show-article))
12084     (gnus-summary-show-article)))
12085
12086 ;;;
12087 ;;; Generic summary marking commands
12088 ;;;
12089
12090 (defvar gnus-summary-marking-alist
12091   '((read gnus-del-mark "d")
12092     (unread gnus-unread-mark "u")
12093     (ticked gnus-ticked-mark "!")
12094     (dormant gnus-dormant-mark "?")
12095     (expirable gnus-expirable-mark "e"))
12096   "An alist of names/marks/keystrokes.")
12097
12098 (defvar gnus-summary-generic-mark-map (make-sparse-keymap))
12099 (defvar gnus-summary-mark-map)
12100
12101 (defun gnus-summary-make-all-marking-commands ()
12102   (define-key gnus-summary-mark-map "M" gnus-summary-generic-mark-map)
12103   (dolist (elem gnus-summary-marking-alist)
12104     (apply 'gnus-summary-make-marking-command elem)))
12105
12106 (defun gnus-summary-make-marking-command (name mark keystroke)
12107   (let ((map (make-sparse-keymap)))
12108     (define-key gnus-summary-generic-mark-map keystroke map)
12109     (dolist (lway `((next "next" next nil "n")
12110                     (next-unread "next unread" next t "N")
12111                     (prev "previous" prev nil "p")
12112                     (prev-unread "previous unread" prev t "P")
12113                     (nomove "" nil nil ,keystroke)))
12114       (let ((func (gnus-summary-make-marking-command-1
12115                    mark (car lway) lway name)))
12116         (setq func (eval func))
12117         (define-key map (nth 4 lway) func)))))
12118
12119 (defun gnus-summary-make-marking-command-1 (mark way lway name)
12120   `(defun ,(intern
12121             (format "gnus-summary-put-mark-as-%s%s"
12122                     name (if (eq way 'nomove)
12123                              ""
12124                            (concat "-" (symbol-name way)))))
12125      (n)
12126      ,(format
12127        "Mark the current article as %s%s.
12128 If N, the prefix, then repeat N times.
12129 If N is negative, move in reverse order.
12130 The difference between N and the actual number of articles marked is
12131 returned."
12132        name (cadr lway))
12133      (interactive "p")
12134      (gnus-summary-generic-mark n ,mark ',(nth 2 lway) ,(nth 3 lway))))
12135
12136 (defun gnus-summary-generic-mark (n mark move unread)
12137   "Mark N articles with MARK."
12138   (unless (eq major-mode 'gnus-summary-mode)
12139     (error "This command can only be used in the summary buffer"))
12140   (gnus-summary-show-thread)
12141   (let ((nummove
12142          (cond
12143           ((eq move 'next) 1)
12144           ((eq move 'prev) -1)
12145           (t 0))))
12146     (if (zerop nummove)
12147         (setq n 1)
12148       (when (< n 0)
12149         (setq n (abs n)
12150               nummove (* -1 nummove))))
12151     (while (and (> n 0)
12152                 (gnus-summary-mark-article nil mark)
12153                 (zerop (gnus-summary-next-subject nummove unread t)))
12154       (setq n (1- n)))
12155     (when (/= 0 n)
12156       (gnus-message 7 "No more %sarticles" (if mark "" "unread ")))
12157     (gnus-summary-recenter)
12158     (gnus-summary-position-point)
12159     (gnus-set-mode-line 'summary)
12160     n))
12161
12162 (defun gnus-summary-insert-articles (articles)
12163   (when (setq articles
12164               (gnus-sorted-difference articles
12165                                       (mapcar (lambda (h)
12166                                                 (mail-header-number h))
12167                                               gnus-newsgroup-headers)))
12168     (setq gnus-newsgroup-headers
12169           (gnus-merge 'list
12170                       gnus-newsgroup-headers
12171                       (gnus-fetch-headers articles)
12172                       'gnus-article-sort-by-number))
12173     ;; Suppress duplicates?
12174     (when gnus-suppress-duplicates
12175       (gnus-dup-suppress-articles))
12176
12177     ;; We might want to build some more threads first.
12178     (when (and gnus-fetch-old-headers
12179                (eq gnus-headers-retrieved-by 'nov))
12180       (if (eq gnus-fetch-old-headers 'invisible)
12181           (gnus-build-all-threads)
12182         (gnus-build-old-threads)))
12183     ;; Let the Gnus agent mark articles as read.
12184     (when gnus-agent
12185       (gnus-agent-get-undownloaded-list))
12186     ;; Remove list identifiers from subject
12187     (when gnus-list-identifiers
12188       (gnus-summary-remove-list-identifiers))
12189     ;; First and last article in this newsgroup.
12190     (when gnus-newsgroup-headers
12191       (setq gnus-newsgroup-begin
12192             (mail-header-number (car gnus-newsgroup-headers))
12193             gnus-newsgroup-end
12194             (mail-header-number
12195              (gnus-last-element gnus-newsgroup-headers))))
12196     (when gnus-use-scoring
12197       (gnus-possibly-score-headers))))
12198
12199 (defun gnus-summary-insert-old-articles (&optional all)
12200   "Insert all old articles in this group.
12201 If ALL is non-nil, already read articles become readable.
12202 If ALL is a number, fetch this number of articles."
12203   (interactive "P")
12204   (prog1
12205       (let ((old (sort (mapcar 'car gnus-newsgroup-data) '<))
12206             older len)
12207         (setq older
12208               ;; Some nntp servers lie about their active range.  When
12209               ;; this happens, the active range can be in the millions.
12210               ;; Use a compressed range to avoid creating a huge list.
12211               (gnus-range-difference (list gnus-newsgroup-active) old))
12212         (setq len (gnus-range-length older))
12213         (cond
12214          ((null older) nil)
12215          ((numberp all)
12216           (if (< all len)
12217               (let ((older-range (nreverse older)))
12218                 (setq older nil)
12219
12220                 (while (> all 0)
12221                   (let* ((r (pop older-range))
12222                          (min (if (numberp r) r (car r)))
12223                          (max (if (numberp r) r (cdr r))))
12224                     (while (and (<= min max)
12225                                 (> all 0))
12226                       (push max older)
12227                       (setq all (1- all)
12228                             max (1- max))))))
12229             (setq older (gnus-uncompress-range older))))
12230          (all
12231           (setq older (gnus-uncompress-range older)))
12232          (t
12233           (when (and (numberp gnus-large-newsgroup)
12234                    (> len gnus-large-newsgroup))
12235               (let* ((cursor-in-echo-area nil)
12236                      (initial (gnus-parameter-large-newsgroup-initial
12237                                gnus-newsgroup-name))
12238                      (input
12239                       (read-string
12240                        (format
12241                         "How many articles from %s (%s %d): "
12242                         (gnus-limit-string
12243                          (gnus-group-decoded-name gnus-newsgroup-name) 35)
12244                         (if initial "max" "default")
12245                         len)
12246                        (if initial
12247                            (cons (number-to-string initial)
12248                                  0)))))
12249                 (unless (string-match "^[ \t]*$" input)
12250                   (setq all (string-to-number input))
12251                   (if (< all len)
12252                       (let ((older-range (nreverse older)))
12253                         (setq older nil)
12254
12255                         (while (> all 0)
12256                           (let* ((r (pop older-range))
12257                                  (min (if (numberp r) r (car r)))
12258                                  (max (if (numberp r) r (cdr r))))
12259                             (while (and (<= min max)
12260                                         (> all 0))
12261                               (push max older)
12262                               (setq all (1- all)
12263                                     max (1- max))))))))))
12264           (setq older (gnus-uncompress-range older))))
12265         (if (not older)
12266             (message "No old news.")
12267           (gnus-summary-insert-articles older)
12268           (gnus-summary-limit (gnus-sorted-nunion old older))))
12269     (gnus-summary-position-point)))
12270
12271 (defun gnus-summary-insert-new-articles ()
12272   "Insert all new articles in this group."
12273   (interactive)
12274   (prog1
12275       (let ((old (sort (mapcar 'car gnus-newsgroup-data) '<))
12276             (old-active gnus-newsgroup-active)
12277             (nnmail-fetched-sources (list t))
12278             i new)
12279         (setq gnus-newsgroup-active
12280               (gnus-activate-group gnus-newsgroup-name 'scan))
12281         (setq i (cdr gnus-newsgroup-active))
12282         (while (> i (cdr old-active))
12283           (push i new)
12284           (decf i))
12285         (if (not new)
12286             (message "No gnus is bad news")
12287           (gnus-summary-insert-articles new)
12288           (setq gnus-newsgroup-unreads
12289                 (gnus-sorted-nunion gnus-newsgroup-unreads new))
12290           (gnus-summary-limit (gnus-sorted-nunion old new))))
12291     (gnus-summary-position-point)))
12292
12293 (gnus-summary-make-all-marking-commands)
12294
12295 (gnus-ems-redefine)
12296
12297 (provide 'gnus-sum)
12298
12299 (run-hooks 'gnus-sum-load-hook)
12300
12301 ;; Local Variables:
12302 ;; coding: iso-8859-1
12303 ;; End:
12304
12305 ;; arch-tag: 17c6748f-6d00-4d36-bf01-835c42f31235
12306 ;;; gnus-sum.el ends here