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

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