code.delx.au - gnu-emacs/blob - lisp/gnus.el

   1 ;;; gnus.el --- NNTP-based News Reader for GNU Emacs
   2 ;; Copyright (C) 1987,88,89,90,93,94 Free Software Foundation, Inc.
   3
   4 ;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
   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
  21 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  22
  23 ;;; Commentary:
  24
  25 ;; How to Install GNUS:
  26 ;; (0) First of all, remove GNUS related OLD *.elc files (at least
  27 ;;     nntp.elc).
  28 ;; (1) Unshar gnus.el, gnuspost.el, gnusmail.el, gnusmisc.el, and
  29 ;;     nntp.el.
  30 ;; (2) byte-compile-file nntp.el, gnus.el, gnuspost.el, gnusmail.el,
  31 ;;     and gnusmisc.el.  If you have a local news spool,
  32 ;;     byte-compile-file nnspool.el, too.
  33 ;; (3) Define three environment variables in .login file as follows:
  34 ;;
  35 ;;     setenv   NNTPSERVER      flab
  36 ;;     setenv   DOMAINNAME      "stars.flab.Fujitsu.CO.JP"
  37 ;;     setenv   ORGANIZATION    "Fujitsu Laboratories Ltd., Kawasaki, Japan."
  38 ;;
  39 ;;     Or instead, define lisp variables in your .emacs, site-init.el,
  40 ;;     or default.el as follows:
  41 ;;
  42 ;;     (setq gnus-nntp-server "flab")
  43 ;;     (setq gnus-local-domain "stars.flab.Fujitsu.CO.JP")
  44 ;;     (setq gnus-local-organization "Fujitsu Laboratories Ltd., ...")
  45 ;;
  46 ;;     If the function (system-name) returns the full internet name,
  47 ;;     you don't have to define the domain.
  48 ;;
  49 ;; (4) You may have to define NNTP service name as number 119.
  50 ;;
  51 ;;     (setq gnus-nntp-service 119)
  52 ;;
  53 ;;     Or, if you'd like to use a local news spool directly in stead
  54 ;;     of NNTP, install nnspool.el and set the variable to nil as
  55 ;;     follows:
  56 ;;
  57 ;;     (setq gnus-nntp-service nil)
  58 ;;
  59 ;; (5) If you'd like to use the GENERICFROM feature like the Bnews,
  60 ;;     define the variable as follows:
  61 ;;
  62 ;;     (setq gnus-use-generic-from t)
  63 ;;
  64 ;; (6) Define autoload entries in .emacs file as follows:
  65 ;;
  66 ;;     (autoload 'gnus "gnus" "Read network news." t)
  67 ;;     (autoload 'gnus-post-news "gnuspost" "Post a news." t)
  68 ;;
  69 ;; (7) Read nntp.el if you have problems with NNTP or kanji handling.
  70 ;;
  71 ;; (8) Install mhspool.el, tcp.el, and tcp.c if it is necessary.
  72 ;;
  73 ;;     mhspool.el is a package for reading articles or mail in your
  74 ;;     private directory using GNUS.
  75 ;;
  76 ;;     tcp.el and tcp.c are necessary if and only if your Emacs does
  77 ;;     not have the function `open-network-stream' which is used for
  78 ;;     communicating with NNTP server inside Emacs.
  79 ;;
  80 ;; (9) Install an Info file generated from the texinfo manual gnus.texinfo.
  81 ;;
  82 ;;     If you are not allowed to create the Info file to the standard
  83 ;;     Info-directory, create it in your private directory and set the
  84 ;;     variable gnus-info-directory to that directory.
  85 ;;
  86 ;; For getting more information about GNUS, consult USENET newsgorup
  87 ;; gnu.emacs.gnus.
  88
  89 ;; TO DO:
  90 ;; (1) Incremental update of active info.
  91 ;; (2) Asynchronous transmission of large messages.
  92
  93 ;;; Code:
  94
  95 (require 'nntp)
  96 (require 'mail-utils)
  97 (require 'timezone)
  98
  99 (defvar gnus-default-nntp-server nil
 100   "*Specify default NNTP server.
 101 This variable should be defined in paths.el.")
 102
 103 (defvar gnus-nntp-server (or (getenv "NNTPSERVER") gnus-default-nntp-server)
 104   "*The name of the host running NNTP server.
 105 If it is a string such as `:DIRECTORY', the user's private DIRECTORY
 106 is used as a news spool.
 107 Initialized from the NNTPSERVER environment variable.")
 108
 109 (defvar gnus-nntp-service "nntp"
 110   "*NNTP service name (\"nntp\" or 119).
 111 Go to a local news spool if its value is nil.")
 112
 113 (defvar gnus-startup-file "~/.newsrc"
 114   "*Your `.newsrc' file.  Use `.newsrc-SERVER' instead if exists.")
 115
 116 (defvar gnus-signature-file "~/.signature"
 117   "*Your `.signature' file.  Use `.signature-DISTRIBUTION' instead if exists.")
 118
 119 (defvar gnus-use-cross-reference t
 120   "*Specifies what to do with cross references (Xref: field).
 121 If nil, ignore cross references.  If t, mark articles as read in
 122 subscribed newsgroups.  Otherwise, if not nil nor t, mark articles as
 123 read in all newsgroups.")
 124
 125 (defvar gnus-use-followup-to t
 126   "*Specifies what to do with Followup-To: field.
 127 If nil, ignore followup-to: field.  If t, use its value except for
 128 `poster'.  Otherwise, if not nil nor t, always use its value.")
 129
 130 (defvar gnus-large-newsgroup 50
 131   "*The number of articles which indicates a large newsgroup.
 132 If the number of articles in a newsgroup is greater than the value,
 133 confirmation is required for selecting the newsgroup.")
 134
 135 (defvar gnus-author-copy (getenv "AUTHORCOPY")
 136   "*File name saving a copy of an article posted using FCC: field.
 137 Initialized from the AUTHORCOPY environment variable.
 138
 139 Articles are saved using a function specified by the the variable
 140 `gnus-author-copy-saver' (`rmail-output' is default) if a file name is
 141 given.  Instead, if the first character of the name is `|', the
 142 contents of the article is piped out to the named program. It is
 143 possible to save an article in an MH folder as follows:
 144
 145 \(setq gnus-author-copy \"|/usr/local/lib/mh/rcvstore +Article\")")
 146
 147 (defvar gnus-author-copy-saver (function rmail-output)
 148   "*A function called with a file name to save an author copy to.
 149 The default function is `rmail-output' which saves in Unix mailbox format.")
 150
 151 (defvar gnus-use-long-file-name
 152   (not (memq system-type '(usg-unix-v xenix)))
 153   "*Non-nil means that a newsgroup name is used as a default file name
 154 to save articles to. If it's nil, the directory form of a newsgroup is
 155 used instead.")
 156
 157 (defvar gnus-article-save-directory (getenv "SAVEDIR")
 158   "*A directory name to save articles to (default to ~/News).
 159 Initialized from the SAVEDIR environment variable.")
 160
 161 (defvar gnus-kill-files-directory (getenv "SAVEDIR")
 162   "*A directory name to save kill files to (default to ~/News).
 163 Initialized from the SAVEDIR environment variable.")
 164
 165 (defvar gnus-default-article-saver (function gnus-summary-save-in-rmail)
 166   "*A function to save articles in your favorite format.
 167 The function must be interactively callable (in other words, it must
 168 be an Emacs command).
 169
 170 GNUS provides the following functions:
 171         gnus-summary-save-in-rmail (in Rmail format)
 172         gnus-summary-save-in-mail (in Unix mail format)
 173         gnus-summary-save-in-folder (in an MH folder)
 174         gnus-summary-save-in-file (in article format).")
 175
 176 (defvar gnus-rmail-save-name (function gnus-plain-save-name)
 177   "*A function generating a file name to save articles in Rmail format.
 178 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
 179
 180 (defvar gnus-mail-save-name (function gnus-plain-save-name)
 181   "*A function generating a file name to save articles in Unix mail format.
 182 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
 183
 184 (defvar gnus-folder-save-name (function gnus-folder-save-name)
 185   "*A function generating a file name to save articles in MH folder.
 186 The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER.")
 187
 188 (defvar gnus-file-save-name (function gnus-numeric-save-name)
 189   "*A function generating a file name to save articles in article format.
 190 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
 191
 192 (defvar gnus-kill-file-name "KILL"
 193   "*File name of a KILL file.")
 194
 195 (defvar gnus-novice-user t
 196   "*Non-nil means that you are a novice to USENET.
 197 If non-nil, verbose messages may be displayed
 198 or your confirmations may be required.")
 199
 200 (defvar gnus-interactive-catchup t
 201   "*Require your confirmation when catching up a newsgroup if non-nil.")
 202
 203 (defvar gnus-interactive-post t
 204   "*Newsgroup, subject, and distribution will be asked for if non-nil.")
 205
 206 (defvar gnus-interactive-exit t
 207   "*Require your confirmation when exiting GNUS if non-nil.")
 208
 209 (defvar gnus-user-login-name nil
 210   "*The login name of the user.
 211 Got from the function `user-login-name' if undefined.")
 212
 213 (defvar gnus-user-full-name nil
 214   "*The full name of the user.
 215 Got from the NAME environment variable if undefined.")
 216
 217 (defvar gnus-show-mime nil
 218   "*Show MIME message if non-nil.")
 219
 220 (defvar gnus-show-threads t
 221   "*Show conversation threads in Summary Mode if non-nil.")
 222
 223 (defvar gnus-thread-hide-subject t
 224   "*Non-nil means hide subjects for thread subtrees.")
 225
 226 (defvar gnus-thread-hide-subtree nil
 227   "*Non-nil means hide thread subtrees initially.
 228 If non-nil, you have to run the command `gnus-summary-show-thread' by
 229 hand or by using `gnus-select-article-hook' to show hidden threads.")
 230
 231 (defvar gnus-thread-hide-killed t
 232   "*Non-nil means hide killed thread subtrees automatically.")
 233
 234 (defvar gnus-thread-ignore-subject nil
 235   "*Don't take care of subject differences, but only references if non-nil.
 236 If it is non-nil, some commands work with subjects do not work properly.")
 237
 238 (defvar gnus-thread-indent-level 4
 239   "*Indentation of thread subtrees.")
 240
 241 (defvar gnus-ignored-newsgroups "^to\\..*$"
 242   "*A regexp to match uninteresting newsgroups in the active file.
 243 Any lines in the active file matching this regular expression are
 244 removed from the newsgroup list before anything else is done to it,
 245 thus making them effectively invisible.")
 246
 247 (defvar gnus-ignored-headers
 248   "^Path:\\|^Posting-Version:\\|^Article-I.D.:\\|^Expires:\\|^Date-Received:\\|^References:\\|^Control:\\|^Xref:\\|^Lines:\\|^Posted:\\|^Relay-Version:\\|^Message-ID:\\|^Nf-ID:\\|^Nf-From:\\|^Approved:\\|^Sender:"
 249   "*All random fields within the header of a message.")
 250
 251 (defvar gnus-required-headers
 252   '(From Date Newsgroups Subject Message-ID Path Organization Distribution)
 253   "*All required fields for articles you post.
 254 RFC977 and RFC1036 require From, Date, Newsgroups, Subject, Message-ID
 255 and Path fields.  Organization, Distribution and Lines are optional.
 256 If you want GNUS not to insert some field, remove it from the
 257 variable.")
 258
 259 (defvar gnus-show-all-headers nil
 260   "*Show all headers of an article if non-nil.")
 261
 262 (defvar gnus-save-all-headers t
 263   "*Save all headers of an article if non-nil.")
 264
 265 (defvar gnus-optional-headers (function gnus-optional-lines-and-from)
 266   "*A function generating a optional string displayed in GNUS Summary
 267 mode buffer.  The function is called with an article HEADER. The
 268 result must be a string excluding `[' and `]'.")
 269
 270 (defvar gnus-auto-extend-newsgroup t
 271   "*Extend visible articles to forward and backward if non-nil.")
 272
 273 (defvar gnus-auto-select-first t
 274   "*Select the first unread article automagically if non-nil.
 275 If you want to prevent automatic selection of the first unread article
 276 in some newsgroups, set the variable to nil in `gnus-select-group-hook'
 277 or `gnus-apply-kill-hook'.")
 278
 279 (defvar gnus-auto-select-next t
 280   "*Select the next newsgroup automagically if non-nil.
 281 If the value is t and the next newsgroup is empty, GNUS will exit
 282 Summary mode and go back to Group mode.  If the value is neither nil
 283 nor t, GNUS will select the following unread newsgroup.  Especially, if
 284 the value is the symbol `quietly', the next unread newsgroup will be
 285 selected without any confirmations.")
 286
 287 (defvar gnus-auto-select-same nil
 288   "*Select the next article with the same subject automagically if non-nil.")
 289
 290 (defvar gnus-auto-center-summary t
 291   "*Always center the current summary in GNUS Summary window if non-nil.")
 292
 293 (defvar gnus-auto-mail-to-author nil
 294   "*Insert `To: author' of the article when following up if non-nil.
 295 Mail is sent using the function specified by the variable
 296 `gnus-mail-send-method'.")
 297
 298 (defvar gnus-break-pages t
 299   "*Break an article into pages if non-nil.
 300 Page delimiter is specified by the variable `gnus-page-delimiter'.")
 301
 302 (defvar gnus-page-delimiter "^\^L"
 303   "*Regexp describing line-beginnings that separate pages of news article.")
 304
 305 (defvar gnus-digest-show-summary t
 306   "*Show a summary of undigestified messages if non-nil.")
 307
 308 (defvar gnus-digest-separator "^Subject:[ \t]"
 309   "*Regexp that separates messages in a digest article.")
 310
 311 (defvar gnus-use-full-window t
 312   "*Non-nil means to take up the entire screen of Emacs.")
 313
 314 (defvar gnus-window-configuration
 315   '((summary (0 1 0))
 316     (newsgroups   (1 0 0))
 317     (article   (0 3 10)))
 318   "*Specify window configurations for each action.
 319 The format of the variable is a list of (ACTION (G S A)), where G, S,
 320 and A are the relative height of Group, Summary, and Article windows,
 321 respectively.  ACTION is `summary', `newsgroups', or `article'.")
 322
 323 (defvar gnus-show-mime-method (function metamail-buffer)
 324   "*Function to process a MIME message.
 325 The function is expected to process current buffer as a MIME message.")
 326
 327 (defvar gnus-mail-reply-method
 328   (function gnus-mail-reply-using-mail)
 329   "*Function to compose reply mail.
 330 The function `gnus-mail-reply-using-mail' uses usual sendmail mail
 331 program.  The function `gnus-mail-reply-using-mhe' uses the MH-E mail
 332 program.  You can use yet another program by customizing this variable.")
 333
 334 (defvar gnus-mail-forward-method
 335   (function gnus-mail-forward-using-mail)
 336   "*Function to forward current message to another user.
 337 The function `gnus-mail-reply-using-mail' uses usual sendmail mail
 338 program.  You can use yet another program by customizing this variable.")
 339
 340 (defvar gnus-mail-other-window-method
 341   (function gnus-mail-other-window-using-mail)
 342   "*Function to compose mail in other window.
 343 The function `gnus-mail-other-window-using-mail' uses the usual sendmail
 344 mail program.  The function `gnus-mail-other-window-using-mhe' uses the MH-E
 345 mail program.  You can use yet another program by customizing this variable.")
 346
 347 (defvar gnus-mail-send-method send-mail-function
 348   "*Function to mail a message too which is being posted as an article.
 349 The message must have To: or Cc: field.  The default is copied from
 350 the variable `send-mail-function'.")
 351
 352 (defvar gnus-subscribe-newsgroup-method
 353   (function gnus-subscribe-alphabetically)
 354   "*Function called with a newsgroup name when new newsgroup is found.
 355 The function `gnus-subscribe-randomly' inserts a new newsgroup a the
 356 beginning of newsgroups.  The function `gnus-subscribe-alphabetically'
 357 inserts it in strict alphabetic order.  The function
 358 `gnus-subscribe-hierarchically' inserts it in hierarchical newsgroup
 359 order.  The function `gnus-subscribe-interactively' asks for your decision.")
 360
 361 (defvar gnus-group-mode-hook nil
 362   "*A hook for GNUS Group Mode.")
 363
 364 (defvar gnus-summary-mode-hook nil
 365   "*A hook for GNUS Summary Mode.")
 366
 367 (defvar gnus-article-mode-hook nil
 368   "*A hook for GNUS Article Mode.")
 369
 370 (defvar gnus-kill-file-mode-hook nil
 371   "*A hook for GNUS KILL File Mode.")
 372
 373 (defvar gnus-open-server-hook nil
 374   "*A hook called just before opening connection to news server.")
 375
 376 (defvar gnus-startup-hook nil
 377   "*A hook called at start up time.
 378 This hook is called after GNUS is connected to the NNTP server. So, it
 379 is possible to change the behavior of GNUS according to the selected
 380 NNTP server.")
 381
 382 (defvar gnus-group-prepare-hook nil
 383   "*A hook called after newsgroup list is created in the Newsgroup buffer.
 384 If you want to modify the Newsgroup buffer, you can use this hook.")
 385
 386 (defvar gnus-summary-prepare-hook nil
 387   "*A hook called after summary list is created in the Summary buffer.
 388 If you want to modify the Summary buffer, you can use this hook.")
 389
 390 (defvar gnus-article-prepare-hook nil
 391   "*A hook called after an article is prepared in the Article buffer.
 392 If you want to run a special decoding program like nkf, use this hook.")
 393
 394 (defvar gnus-select-group-hook nil
 395   "*A hook called when a newsgroup is selected.
 396 If you want to sort Summary buffer by date and then by subject, you
 397 can use the following hook:
 398
 399 \(setq gnus-select-group-hook
 400       (list
 401        (function
 402         (lambda ()
 403           ;; First of all, sort by date.
 404           (gnus-keysort-headers
 405            (function string-lessp)
 406            (function
 407             (lambda (a)
 408               (gnus-sortable-date (gnus-header-date a)))))
 409           ;; Then sort by subject string ignoring `Re:'.
 410           ;; If case-fold-search is non-nil, case of letters is ignored.
 411           (gnus-keysort-headers
 412            (function string-lessp)
 413            (function
 414             (lambda (a)
 415               (if case-fold-search
 416                   (downcase (gnus-simplify-subject (gnus-header-subject a) t))
 417                 (gnus-simplify-subject (gnus-header-subject a) t)))))
 418           ))))
 419
 420 If you'd like to simplify subjects like the
 421 `gnus-summary-next-same-subject' command does, you can use the
 422 following hook:
 423
 424 \(setq gnus-select-group-hook
 425       (list
 426        (function
 427         (lambda ()
 428           (mapcar (function
 429                    (lambda (header)
 430                      (nntp-set-header-subject
 431                       header
 432                       (gnus-simplify-subject
 433                        (gnus-header-subject header) 're-only))))
 434                   gnus-newsgroup-headers)))))
 435
 436 In some newsgroups author name is meaningless. It is possible to
 437 prevent listing author names in GNUS Summary buffer as follows:
 438
 439 \(setq gnus-select-group-hook
 440       (list
 441        (function
 442         (lambda ()
 443           (cond ((string-equal \"comp.sources.unix\" gnus-newsgroup-name)
 444                  (setq gnus-optional-headers
 445                        (function gnus-optional-lines)))
 446                 (t
 447                  (setq gnus-optional-headers
 448                        (function gnus-optional-lines-and-from))))))))")
 449
 450 (defvar gnus-select-article-hook
 451   '(gnus-summary-show-thread)
 452   "*A hook called when an article is selected.
 453 The default hook shows conversation thread subtrees of the selected
 454 article automatically using `gnus-summary-show-thread'.
 455
 456 If you'd like to run RMAIL on a digest article automagically, you can
 457 use the following hook:
 458
 459 \(setq gnus-select-article-hook
 460       (list
 461        (function
 462         (lambda ()
 463           (gnus-summary-show-thread)
 464           (cond ((string-equal \"comp.sys.sun\" gnus-newsgroup-name)
 465                  (gnus-summary-rmail-digest))
 466                 ((and (string-equal \"comp.text\" gnus-newsgroup-name)
 467                       (string-match \"^TeXhax Digest\"
 468                                     (gnus-header-subject gnus-current-headers)))
 469                  (gnus-summary-rmail-digest)
 470                  ))))))")
 471
 472 (defvar gnus-select-digest-hook
 473   (list
 474    (function
 475     (lambda ()
 476       ;; Reply-To: is required by `undigestify-rmail-message'.
 477       (or (mail-position-on-field "Reply-to" t)
 478           (progn
 479             (mail-position-on-field "Reply-to")
 480             (insert (gnus-fetch-field "From")))))))
 481   "*A hook called when reading digest messages using Rmail.
 482 This hook can be used to modify incomplete digest articles as follows
 483 \(this is the default):
 484
 485 \(setq gnus-select-digest-hook
 486       (list
 487        (function
 488         (lambda ()
 489           ;; Reply-To: is required by `undigestify-rmail-message'.
 490           (or (mail-position-on-field \"Reply-to\" t)
 491               (progn
 492                 (mail-position-on-field \"Reply-to\")
 493                 (insert (gnus-fetch-field \"From\"))))))))")
 494
 495 (defvar gnus-rmail-digest-hook nil
 496   "*A hook called when reading digest messages using Rmail.
 497 This hook is intended to customize Rmail mode for reading digest articles.")
 498
 499 (defvar gnus-apply-kill-hook '(gnus-apply-kill-file)
 500   "*A hook called when a newsgroup is selected and summary list is prepared.
 501 This hook is intended to apply a KILL file to the selected newsgroup.
 502 The function `gnus-apply-kill-file' is called by default.
 503
 504 Since a general KILL file is too heavy to use only for a few
 505 newsgroups, I recommend you to use a lighter hook function. For
 506 example, if you'd like to apply a KILL file to articles which contains
 507 a string `rmgroup' in subject in newsgroup `control', you can use the
 508 following hook:
 509
 510 \(setq gnus-apply-kill-hook
 511       (list
 512        (function
 513         (lambda ()
 514           (cond ((string-match \"control\" gnus-newsgroup-name)
 515                  (gnus-kill \"Subject\" \"rmgroup\")
 516                  (gnus-expunge \"X\")))))))")
 517
 518 (defvar gnus-mark-article-hook
 519   (list
 520    (function
 521     (lambda ()
 522       (or (memq gnus-current-article gnus-newsgroup-marked)
 523           (gnus-summary-mark-as-read gnus-current-article))
 524       (gnus-summary-set-current-mark "+"))))
 525   "*A hook called when an article is selected at the first time.
 526 The hook is intended to mark an article as read (or unread)
 527 automatically when it is selected.
 528
 529 If you'd like to mark as unread (-) instead, use the following hook:
 530
 531 \(setq gnus-mark-article-hook
 532       (list
 533        (function
 534         (lambda ()
 535           (gnus-summary-mark-as-unread gnus-current-article)
 536           (gnus-summary-set-current-mark \"+\")))))")
 537
 538 (defvar gnus-prepare-article-hook (list (function gnus-inews-insert-signature))
 539   "*A hook called after preparing body, but before preparing header fields.
 540 The default hook (`gnus-inews-insert-signature') inserts a signature
 541 file specified by the variable `gnus-signature-file'.")
 542
 543 (defvar gnus-inews-article-hook (list (function gnus-inews-do-fcc))
 544   "*A hook called before finally posting an article.
 545 The default hook (`gnus-inews-do-fcc') does FCC processing (save article
 546 to a file).")
 547
 548 (defvar gnus-exit-group-hook nil
 549   "*A hook called when exiting (not quitting) Summary mode.
 550 If your machine is so slow that exiting from Summary mode takes very
 551 long time, set the variable `gnus-use-cross-reference' to nil. This
 552 inhibits marking articles as read using cross-reference information.")
 553
 554 (defvar gnus-suspend-gnus-hook nil
 555   "*A hook called when suspending (not exiting) GNUS.")
 556
 557 (defvar gnus-exit-gnus-hook nil
 558   "*A hook called when exiting (not suspending) GNUS.")
 559
 560 (defvar gnus-save-newsrc-hook nil
 561   "*A hook called when saving the newsrc file.
 562 This hook is called before saving the `.newsrc' file.")
 563
 564 \f
 565 ;; Site dependent variables. You have to define these variables in
 566 ;;  site-init.el, default.el or your .emacs.
 567
 568 (defvar gnus-local-timezone nil
 569   "*Local time zone.
 570 This value is used only if `current-time-zone' does not work in your Emacs.
 571 It specifies the GMT offset, i.e. a decimal integer
 572 of the form +-HHMM giving the hours and minutes ahead of (i.e. east of) GMT.
 573 For example, +0900 should be used in Japan, since it is 9 hours ahead of GMT.
 574
 575 For backwards compatibility, it may also be a string like \"JST\",
 576 but strings are obsolescent: you should use numeric offsets instead.")
 577
 578 (defvar gnus-local-domain nil
 579   "*Local domain name without a host name like: \"stars.flab.Fujitsu.CO.JP\"
 580 The `DOMAINNAME' environment variable is used instead if defined.  If
 581 the function (system-name) returns the full internet name, there is no
 582 need to define the name.")
 583
 584 (defvar gnus-local-organization nil
 585   "*Local organization like: \"Fujitsu Laboratories Ltd., Kawasaki, Japan.\"
 586 The `ORGANIZATION' environment variable is used instead if defined.")
 587
 588 (defvar gnus-local-distributions '("local" "world")
 589   "*List of distributions.
 590 The first element in the list is used as default.  If distributions
 591 file is available, its content is also used.")
 592
 593 (defvar gnus-use-generic-from nil
 594   "*If nil, prepend local host name to the defined domain in the From:
 595 field; if stringp, use this; if non-nil, strip of the local host name.")
 596
 597 (defvar gnus-use-generic-path nil
 598   "*If nil, use the NNTP server name in the Path: field; if stringp,
 599 use this; if non-nil, use no host name (user name only)")
 600 \f
 601 ;; Internal variables.
 602
 603 (defconst gnus-version "GNUS 4.1"
 604   "Version numbers of this version of GNUS.")
 605
 606 (defconst gnus-emacs-version
 607   (progn
 608     (string-match "[0-9]*" emacs-version)
 609     (string-to-int (substring emacs-version
 610                               (match-beginning 0) (match-end 0))))
 611   "Major version number of this emacs.")
 612
 613 (defvar gnus-info-nodes
 614   '((gnus-group-mode            "(gnus)Newsgroup Commands")
 615     (gnus-summary-mode          "(gnus)Summary Commands")
 616     (gnus-article-mode          "(gnus)Article Commands")
 617     (gnus-kill-file-mode        "(gnus)Kill File")
 618     (gnus-browse-killed-mode    "(gnus)Maintaining Subscriptions"))
 619   "Assoc list of major modes and related Info nodes.")
 620
 621 ;; Alist syntax is different from that of 3.14.3.
 622 (defvar gnus-access-methods
 623   '((nntp
 624      (gnus-retrieve-headers             nntp-retrieve-headers)
 625      (gnus-open-server                  nntp-open-server)
 626      (gnus-close-server                 nntp-close-server)
 627      (gnus-server-opened                nntp-server-opened)
 628      (gnus-status-message               nntp-status-message)
 629      (gnus-request-article              nntp-request-article)
 630      (gnus-request-group                nntp-request-group)
 631      (gnus-request-list                 nntp-request-list)
 632      (gnus-request-list-newsgroups      nntp-request-list-newsgroups)
 633      (gnus-request-list-distributions   nntp-request-list-distributions)
 634      (gnus-request-post                 nntp-request-post))
 635     (nnspool
 636      (gnus-retrieve-headers             nnspool-retrieve-headers)
 637      (gnus-open-server                  nnspool-open-server)
 638      (gnus-close-server                 nnspool-close-server)
 639      (gnus-server-opened                nnspool-server-opened)
 640      (gnus-status-message               nnspool-status-message)
 641      (gnus-request-article              nnspool-request-article)
 642      (gnus-request-group                nnspool-request-group)
 643      (gnus-request-list                 nnspool-request-list)
 644      (gnus-request-list-newsgroups      nnspool-request-list-newsgroups)
 645      (gnus-request-list-distributions   nnspool-request-list-distributions)
 646      (gnus-request-post                 nnspool-request-post))
 647     (mhspool
 648      (gnus-retrieve-headers             mhspool-retrieve-headers)
 649      (gnus-open-server                  mhspool-open-server)
 650      (gnus-close-server                 mhspool-close-server)
 651      (gnus-server-opened                mhspool-server-opened)
 652      (gnus-status-message               mhspool-status-message)
 653      (gnus-request-article              mhspool-request-article)
 654      (gnus-request-group                mhspool-request-group)
 655      (gnus-request-list                 mhspool-request-list)
 656      (gnus-request-list-newsgroups      mhspool-request-list-newsgroups)
 657      (gnus-request-list-distributions   mhspool-request-list-distributions)
 658      (gnus-request-post                 mhspool-request-post)))
 659   "Access method for NNTP, nnspool, and mhspool.")
 660
 661 (defvar gnus-group-buffer "*Newsgroup*")
 662 (defvar gnus-summary-buffer "*Summary*")
 663 (defvar gnus-article-buffer "*Article*")
 664 (defvar gnus-digest-buffer "GNUS Digest")
 665 (defvar gnus-digest-summary-buffer "GNUS Digest-summary")
 666
 667 (defvar gnus-buffer-list
 668   (list gnus-group-buffer gnus-summary-buffer gnus-article-buffer
 669         gnus-digest-buffer gnus-digest-summary-buffer)
 670   "GNUS buffer names which should be killed when exiting.")
 671
 672 (defvar gnus-variable-list
 673   '(gnus-newsrc-options
 674     gnus-newsrc-options-n-yes gnus-newsrc-options-n-no
 675     gnus-newsrc-assoc gnus-killed-assoc gnus-marked-assoc)
 676   "GNUS variables saved in the quick startup file.")
 677
 678 (defvar gnus-overload-functions
 679   '((news-inews gnus-inews-news "rnewspost")
 680     (caesar-region gnus-caesar-region "rnews"))
 681   "Functions overloaded by gnus.
 682 It is a list of `(original overload &optional file)'.")
 683
 684 (defvar gnus-distribution-list nil)
 685
 686 (defvar gnus-newsrc-options nil
 687   "Options line in the .newsrc file.")
 688
 689 (defvar gnus-newsrc-options-n-yes nil
 690   "Regexp representing subscribed newsgroups.")
 691
 692 (defvar gnus-newsrc-options-n-no nil
 693   "Regexp representing unsubscribed newsgroups.")
 694
 695 (defvar gnus-newsrc-assoc nil
 696   "Assoc list of read articles.
 697 gnus-newsrc-hashtb should be kept so that both hold the same information.")
 698
 699 (defvar gnus-newsrc-hashtb nil
 700   "Hashtable of gnus-newsrc-assoc.")
 701
 702 (defvar gnus-killed-assoc nil
 703   "Assoc list of newsgroups removed from gnus-newsrc-assoc.
 704 gnus-killed-hashtb should be kept so that both hold the same information.")
 705
 706 (defvar gnus-killed-hashtb nil
 707   "Hashtable of gnus-killed-assoc.")
 708
 709 (defvar gnus-marked-assoc nil
 710   "Assoc list of articles marked as unread.
 711 gnus-marked-hashtb should be kept so that both hold the same information.")
 712
 713 (defvar gnus-marked-hashtb nil
 714   "Hashtable of gnus-marked-assoc.")
 715
 716 (defvar gnus-unread-hashtb nil
 717   "Hashtable of unread articles.")
 718
 719 (defvar gnus-active-hashtb nil
 720   "Hashtable of active articles.")
 721
 722 (defvar gnus-octive-hashtb nil
 723   "Hashtable of OLD active articles.")
 724
 725 (defvar gnus-current-startup-file nil
 726   "Startup file for the current host.")
 727
 728 (defvar gnus-last-search-regexp nil
 729   "Default regexp for article search command.")
 730
 731 (defvar gnus-last-shell-command nil
 732   "Default shell command on article.")
 733
 734 (defvar gnus-have-all-newsgroups nil)
 735
 736 (defvar gnus-newsgroup-name nil)
 737 (defvar gnus-newsgroup-begin nil)
 738 (defvar gnus-newsgroup-end nil)
 739 (defvar gnus-newsgroup-last-rmail nil)
 740 (defvar gnus-newsgroup-last-mail nil)
 741 (defvar gnus-newsgroup-last-folder nil)
 742 (defvar gnus-newsgroup-last-file nil)
 743
 744 (defvar gnus-newsgroup-unreads nil
 745   "List of unread articles in the current newsgroup.")
 746
 747 (defvar gnus-newsgroup-unselected nil
 748   "List of unselected unread articles in the current newsgroup.")
 749
 750 (defvar gnus-newsgroup-marked nil
 751   "List of marked articles in the current newsgroup (a subset of unread art).")
 752
 753 (defvar gnus-newsgroup-headers nil
 754   "List of article headers in the current newsgroup.
 755 If the variable is modified (added or deleted), the function
 756 gnus-clear-hashtables-for-newsgroup-headers must be called to clear
 757 the hash tables.")
 758 (defvar gnus-newsgroup-headers-hashtb-by-id nil)
 759 (defvar gnus-newsgroup-headers-hashtb-by-number nil)
 760
 761 (defvar gnus-current-article nil)
 762 (defvar gnus-current-headers nil)
 763 (defvar gnus-current-history nil)
 764 (defvar gnus-have-all-headers nil "Must be either T or NIL.")
 765 (defvar gnus-last-article nil)
 766 (defvar gnus-current-kill-article nil)
 767
 768 ;; Save window configuration.
 769 (defvar gnus-winconf-kill-file nil)
 770
 771 (defvar gnus-group-mode-map nil)
 772 (defvar gnus-summary-mode-map nil)
 773 (defvar gnus-article-mode-map nil)
 774 (defvar gnus-kill-file-mode-map nil)
 775
 776 (defvar rmail-default-file (expand-file-name "~/XMBOX"))
 777 (defvar rmail-default-rmail-file (expand-file-name "~/XNEWS"))
 778
 779 ;; Define GNUS Subsystems.
 780 (autoload 'gnus-group-post-news "gnuspost"
 781           "Post an article." t)
 782 (autoload 'gnus-summary-post-news "gnuspost"
 783           "Post an article." t)
 784 (autoload 'gnus-summary-followup "gnuspost"
 785           "Post a reply article." t)
 786 (autoload 'gnus-summary-followup-with-original "gnuspost"
 787           "Post a reply article with original article." t)
 788 (autoload 'gnus-summary-cancel-article "gnuspost"
 789           "Cancel an article you posted." t)
 790
 791 (autoload 'gnus-summary-reply "gnusmail"
 792           "Reply mail to news author." t)
 793 (autoload 'gnus-summary-reply-with-original "gnusmail"
 794           "Reply mail to news author with original article." t)
 795 (autoload 'gnus-summary-mail-forward "gnusmail"
 796           "Forward the current message to another user." t)
 797 (autoload 'gnus-summary-mail-other-window "gnusmail"
 798           "Compose mail in other window." t)
 799
 800 (autoload 'gnus-group-kill-group "gnusmisc"
 801           "Kill newsgroup on current line." t)
 802 (autoload 'gnus-group-yank-group "gnusmisc"
 803           "Yank the last killed newsgroup on current line." t)
 804 (autoload 'gnus-group-kill-region "gnusmisc"
 805           "Kill newsgroups in current region." t)
 806 (autoload 'gnus-group-transpose-groups "gnusmisc"
 807           "Exchange current newsgroup and previous newsgroup." t)
 808 (autoload 'gnus-list-killed-groups "gnusmisc"
 809           "List the killed newsgroups." t)
 810 (autoload 'gnus-gmt-to-local "gnusmisc"
 811           "Rewrite Date field in GMT to local in current buffer.")
 812
 813 (autoload 'metamail-buffer "metamail"
 814           "Process current buffer through 'metamail'." t)
 815
 816 (autoload 'rmail-output "rmailout"
 817           "Append this message to Unix mail file named FILE-NAME." t)
 818 (autoload 'mail-position-on-field "sendmail")
 819 (autoload 'mh-find-path "mh-e")
 820 (autoload 'mh-prompt-for-folder "mh-e")
 821
 822 (put 'gnus-group-mode 'mode-class 'special)
 823 (put 'gnus-summary-mode 'mode-class 'special)
 824 (put 'gnus-article-mode 'mode-class 'special)
 825
 826 (autoload 'gnus-uu-ctl-map "gnus-uu" nil nil 'keymap)
 827 (autoload 'gnus-uu-mark-article "gnus-uu" nil t)
 828 \f
 829 ;;(put 'gnus-eval-in-buffer-window 'lisp-indent-hook 1)
 830
 831 (defmacro gnus-eval-in-buffer-window (buffer &rest forms)
 832   "Pop to BUFFER, evaluate FORMS, and then returns to original window."
 833   (` (let ((GNUSStartBufferWindow (selected-window)))
 834        (unwind-protect
 835            (progn
 836              (pop-to-buffer (, buffer))
 837              (,@ forms))
 838          (select-window GNUSStartBufferWindow)))))
 839
 840 (defmacro gnus-make-hashtable (&optional hashsize)
 841   "Make a hash table (default and minimum size is 200).
 842 Optional argument HASHSIZE specifies the table size."
 843   (` (make-vector (, (if hashsize (` (max (, hashsize) 200)) 200)) 0)))
 844
 845 (defmacro gnus-gethash (string hashtable)
 846   "Get hash value of STRING in HASHTABLE."
 847   ;;(` (symbol-value (abbrev-symbol (, string) (, hashtable))))
 848   ;;(` (abbrev-expansion (, string) (, hashtable)))
 849   (` (symbol-value (intern-soft (, string) (, hashtable)))))
 850
 851 (defmacro gnus-sethash (string value hashtable)
 852   "Set hash value. Arguments are STRING, VALUE, and HASHTABLE."
 853   ;; We cannot use define-abbrev since it only accepts string as value.
 854   (` (set (intern (, string) (, hashtable)) (, value))))
 855
 856 ;; Note: Macros defined here are also defined in nntp.el. I don't like
 857 ;; to put them here, but many users got troubled with the old
 858 ;; definitions in nntp.elc. These codes are NNTP 3.10 version.
 859
 860 (defmacro nntp-header-number (header)
 861   "Return article number in HEADER."
 862   (` (aref (, header) 0)))
 863
 864 (defmacro nntp-set-header-number (header number)
 865   "Set article number of HEADER to NUMBER."
 866   (` (aset (, header) 0 (, number))))
 867
 868 (defmacro nntp-header-subject (header)
 869   "Return subject string in HEADER."
 870   (` (aref (, header) 1)))
 871
 872 (defmacro nntp-set-header-subject (header subject)
 873   "Set article subject of HEADER to SUBJECT."
 874   (` (aset (, header) 1 (, subject))))
 875
 876 (defmacro nntp-header-from (header)
 877   "Return author string in HEADER."
 878   (` (aref (, header) 2)))
 879
 880 (defmacro nntp-set-header-from (header from)
 881   "Set article author of HEADER to FROM."
 882   (` (aset (, header) 2 (, from))))
 883
 884 (defmacro nntp-header-xref (header)
 885   "Return xref string in HEADER."
 886   (` (aref (, header) 3)))
 887
 888 (defmacro nntp-set-header-xref (header xref)
 889   "Set article xref of HEADER to xref."
 890   (` (aset (, header) 3 (, xref))))
 891
 892 (defmacro nntp-header-lines (header)
 893   "Return lines in HEADER."
 894   (` (aref (, header) 4)))
 895
 896 (defmacro nntp-set-header-lines (header lines)
 897   "Set article lines of HEADER to LINES."
 898   (` (aset (, header) 4 (, lines))))
 899
 900 (defmacro nntp-header-date (header)
 901   "Return date in HEADER."
 902   (` (aref (, header) 5)))
 903
 904 (defmacro nntp-set-header-date (header date)
 905   "Set article date of HEADER to DATE."
 906   (` (aset (, header) 5 (, date))))
 907
 908 (defmacro nntp-header-id (header)
 909   "Return Id in HEADER."
 910   (` (aref (, header) 6)))
 911
 912 (defmacro nntp-set-header-id (header id)
 913   "Set article Id of HEADER to ID."
 914   (` (aset (, header) 6 (, id))))
 915
 916 (defmacro nntp-header-references (header)
 917   "Return references in HEADER."
 918   (` (aref (, header) 7)))
 919
 920 (defmacro nntp-set-header-references (header ref)
 921   "Set article references of HEADER to REF."
 922   (` (aset (, header) 7 (, ref))))
 923
 924 \f
 925 ;;;
 926 ;;; GNUS Group Mode
 927 ;;;
 928
 929 (if gnus-group-mode-map
 930     nil
 931   (setq gnus-group-mode-map (make-keymap))
 932   (suppress-keymap gnus-group-mode-map)
 933   (define-key gnus-group-mode-map " " 'gnus-group-read-group)
 934   (define-key gnus-group-mode-map "=" 'gnus-group-select-group)
 935   (define-key gnus-group-mode-map "j" 'gnus-group-jump-to-group)
 936   (define-key gnus-group-mode-map "n" 'gnus-group-next-unread-group)
 937   (define-key gnus-group-mode-map "p" 'gnus-group-prev-unread-group)
 938   (define-key gnus-group-mode-map "\177" 'gnus-group-prev-unread-group)
 939   (define-key gnus-group-mode-map "N" 'gnus-group-next-group)
 940   (define-key gnus-group-mode-map "P" 'gnus-group-prev-group)
 941   (define-key gnus-group-mode-map "\C-n" 'gnus-group-next-group)
 942   (define-key gnus-group-mode-map "\C-p" 'gnus-group-prev-group)
 943   (define-key gnus-group-mode-map [down] 'gnus-group-next-group)
 944   (define-key gnus-group-mode-map [up] 'gnus-group-prev-group)
 945   (define-key gnus-group-mode-map "\r" 'next-line)
 946   ;;(define-key gnus-group-mode-map "/" 'isearch-forward)
 947   (define-key gnus-group-mode-map "<" 'beginning-of-buffer)
 948   (define-key gnus-group-mode-map ">" 'end-of-buffer)
 949   (define-key gnus-group-mode-map "u" 'gnus-group-unsubscribe-current-group)
 950   (define-key gnus-group-mode-map "U" 'gnus-group-unsubscribe-group)
 951   (define-key gnus-group-mode-map "c" 'gnus-group-catchup)
 952   (define-key gnus-group-mode-map "C" 'gnus-group-catchup-all)
 953   (define-key gnus-group-mode-map "l" 'gnus-group-list-groups)
 954   (define-key gnus-group-mode-map "L" 'gnus-group-list-all-groups)
 955   (define-key gnus-group-mode-map "g" 'gnus-group-get-new-news)
 956   (define-key gnus-group-mode-map "R" 'gnus-group-restart)
 957   (define-key gnus-group-mode-map "b" 'gnus-group-check-bogus-groups)
 958   (define-key gnus-group-mode-map "r" 'gnus-group-restrict-groups)
 959   (define-key gnus-group-mode-map "a" 'gnus-group-post-news)
 960   (define-key gnus-group-mode-map "\ek" 'gnus-group-edit-local-kill)
 961   (define-key gnus-group-mode-map "\eK" 'gnus-group-edit-global-kill)
 962   (define-key gnus-group-mode-map "\C-k" 'gnus-group-kill-group)
 963   (define-key gnus-group-mode-map "\C-y" 'gnus-group-yank-group)
 964   (define-key gnus-group-mode-map "\C-w" 'gnus-group-kill-region)
 965   (define-key gnus-group-mode-map "\C-x\C-t" 'gnus-group-transpose-groups)
 966   (define-key gnus-group-mode-map "\C-c\C-l" 'gnus-list-killed-groups)
 967   (define-key gnus-group-mode-map "V" 'gnus-version)
 968   ;;(define-key gnus-group-mode-map "x" 'gnus-group-force-update)
 969   (define-key gnus-group-mode-map "s" 'gnus-group-force-update)
 970   (define-key gnus-group-mode-map "z" 'gnus-group-suspend)
 971   (define-key gnus-group-mode-map "q" 'gnus-group-exit)
 972   (define-key gnus-group-mode-map "Q" 'gnus-group-quit)
 973   (define-key gnus-group-mode-map "?" 'gnus-group-describe-briefly)
 974   (define-key gnus-group-mode-map "\C-c\C-i" 'gnus-info-find-node)
 975   (define-key gnus-group-mode-map   [mouse-2] 'gnus-mouse-pick-group)
 976
 977   ;; Make a menu bar item.
 978   (define-key gnus-group-mode-map [menu-bar GNUS]
 979         (cons "GNUS" (make-sparse-keymap "GNUS")))
 980
 981   (define-key gnus-group-mode-map [menu-bar GNUS force-update]
 982         '("Force Update" . gnus-group-force-update))
 983   (define-key gnus-group-mode-map [menu-bar GNUS quit]
 984         '("Quit" . gnus-group-quit))
 985   (define-key gnus-group-mode-map [menu-bar GNUS exit]
 986         '("Exit" . gnus-group-exit))
 987   (define-key gnus-group-mode-map [menu-bar GNUS restart]
 988         '("Restart" . gnus-group-restart))
 989   (define-key gnus-group-mode-map [menu-bar GNUS suspend]
 990         '("Suspend" . gnus-group-suspend))
 991   (define-key gnus-group-mode-map [menu-bar GNUS get-new-news]
 992         '("Get New News" . gnus-group-get-new-news))
 993
 994   ;; Make a menu bar item.
 995   (define-key gnus-group-mode-map [menu-bar groups]
 996         (cons "Groups" (make-sparse-keymap "Groups")))
 997
 998   (define-key gnus-group-mode-map [menu-bar groups catchup]
 999         '("Catchup" . gnus-group-catchup))
1000   (define-key gnus-group-mode-map [menu-bar groups edit-global-kill]
1001         '("Edit Kill File" . gnus-group-edit-global-kill))
1002
1003   (define-key gnus-group-mode-map [menu-bar groups separator-2]
1004         '("--"))
1005
1006   (define-key gnus-group-mode-map [menu-bar groups yank-group]
1007         '("Yank Group" . gnus-group-yank-group))
1008   (define-key gnus-group-mode-map [menu-bar groups kill-group]
1009         '("Kill Group" . gnus-group-kill-group))
1010
1011   (define-key gnus-group-mode-map [menu-bar groups separator-1]
1012         '("--"))
1013
1014   (define-key gnus-group-mode-map [menu-bar groups jump-to-group]
1015         '("Jump to Group..." . gnus-group-jump-to-group))
1016   (define-key gnus-group-mode-map [menu-bar groups list-all-groups]
1017         '("List All Groups" . gnus-group-list-all-groups))
1018   (define-key gnus-group-mode-map [menu-bar groups list-groups]
1019         '("List Groups" . gnus-group-list-groups))
1020   (define-key gnus-group-mode-map [menu-bar groups unsub-current-group]
1021         '("Unsubscribe Group" . gnus-group-unsubscribe-current-group))
1022   )
1023
1024 (defun gnus-group-mode ()
1025   "Major mode for reading network news.
1026 All normal editing commands are turned off.
1027 Instead, these commands are available:
1028
1029 SPC     Read articles in this newsgroup.
1030 =       Select this newsgroup.
1031 j       Move to the specified newsgroup.
1032 n       Move to the next unread newsgroup.
1033 p       Move to the previous unread newsgroup.
1034 C-n     Move to the next newsgroup.
1035 C-p     Move to the previous newsgroup.
1036 <       Move point to the beginning of this buffer.
1037 >       Move point to the end of this buffer.
1038 u       Unsubscribe from (subscribe to) this newsgroup.
1039 U       Unsubscribe from (subscribe to) the specified newsgroup.
1040 c       Mark all articles as read, preserving marked articles.
1041 C       Mark all articles in this newsgroup as read.
1042 l       Revert this buffer.
1043 L       List all newsgroups.
1044 g       Get new news.
1045 R       Force to read the raw .newsrc file and get new news.
1046 b       Check bogus newsgroups.
1047 r       Restrict visible newsgroups to the current region.
1048 a       Post a new article.
1049 ESC k   Edit a local KILL file applied to this newsgroup.
1050 ESC K   Edit a global KILL file applied to all newsgroups.
1051 C-k     Kill this newsgroup.
1052 C-y     Yank killed newsgroup here.
1053 C-w     Kill newsgroups in current region (excluding current point).
1054 C-x C-t Exchange this newsgroup and previous newsgroup.
1055 C-c C-l list killed newsgroups.
1056 s       Save .newsrc file.
1057 z       Suspend reading news.
1058 q       Quit reading news.
1059 Q       Quit reading news without saving .newsrc file.
1060 V       Show the version number of this GNUS.
1061 ?       Describe Group Mode commands briefly.
1062 C-h m   Describe Group Mode.
1063 C-c C-i Read Info about Group Mode.
1064
1065   The name of the host running NNTP server is asked for if no default
1066 host is specified. It is also possible to choose another NNTP server
1067 even when the default server is defined by giving a prefix argument to
1068 the command `\\[gnus]'.
1069
1070   If an NNTP server is preceded by a colon such as `:Mail', the user's
1071 private directory `~/Mail' is used as a news spool. This makes it
1072 possible to read mail stored in MH folders or articles saved by GNUS.
1073 File names of mail or articles must consist of only numeric
1074 characters. Otherwise, they are ignored.
1075
1076   If there is a file named `~/.newsrc-SERVER', it is used as the
1077 startup file instead of standard one when talking to SERVER.  It is
1078 possible to talk to many hosts by using different startup files for
1079 each.
1080
1081   Option `-n' of the options line in the startup file is recognized
1082 properly the same as the Bnews system. For example, if the options
1083 line is `options -n !talk talk.rumors', newsgroups under the `talk'
1084 hierarchy except for `talk.rumors' are ignored while checking new
1085 newsgroups.
1086
1087   If there is a file named `~/.signature-DISTRIBUTION', it is used as
1088 signature file instead of standard one when posting a news in
1089 DISTRIBUTION.
1090
1091   If an Info file generated from `gnus.texinfo' is installed, you can
1092 read an appropriate Info node of the Info file according to the
1093 current major mode of GNUS by \\[gnus-info-find-node].
1094
1095   The variable `gnus-version', `nntp-version', `nnspool-version', and
1096 `mhspool-version' have the version numbers of this version of gnus.el,
1097 nntp.el, nnspool.el, and mhspoo.el, respectively.
1098
1099 User customizable variables:
1100  gnus-nntp-server
1101     Specifies the name of the host running the NNTP server. If its
1102     value is a string such as `:DIRECTORY', the user's private
1103     DIRECTORY is used as a news spool.  The variable is initialized
1104     from the NNTPSERVER environment variable.
1105
1106  gnus-nntp-service
1107     Specifies a NNTP service name.  It is usually \"nntp\" or 119.
1108     Nil forces GNUS to use a local news spool if the variable
1109     `gnus-nntp-server' is set to the local host name.
1110
1111  gnus-startup-file
1112     Specifies a startup file (.newsrc).  If there is a file named
1113     `.newsrc-SERVER', it's used instead when talking to SERVER.  I
1114     recommend you to use the server specific file, if you'd like to
1115     talk to many servers.  Especially if you'd like to read your
1116     private directory, the name of the file must be
1117     `.newsrc-:DIRECTORY'.
1118
1119  gnus-signature-file
1120     Specifies a signature file (.signature).  If there is a file named
1121     `.signature-DISTRIBUTION', it's used instead when posting an
1122     article in DISTRIBUTION.  Set the variable to nil to prevent
1123     appending the file automatically.  If you use an NNTP inews which
1124     comes with the NNTP package, you may have to set the variable to
1125     nil.
1126
1127  gnus-use-cross-reference
1128     Specifies what to do with cross references (Xref: field).  If it
1129     is nil, cross references are ignored.  If it is t, articles in
1130     subscribed newsgroups are only marked as read.  Otherwise, if it
1131     is not nil nor t, articles in all newsgroups are marked as read.
1132
1133  gnus-use-followup-to
1134     Specifies what to do with followup-to: field.  If it is nil, its
1135     value is ignored.  If it is non-nil, its value is used as followup
1136     newsgroups.  Especially, if it is t and field value is `poster',
1137     your confirmation is required.
1138
1139  gnus-author-copy
1140     Specifies a file name to save a copy of article you posted using
1141     FCC: field.  If the first character of the value is `|', the
1142     contents of the article is piped out to a program specified by the
1143     rest of the value.  The variable is initialized from the
1144     AUTHORCOPY environment variable.
1145
1146  gnus-author-copy-saver
1147     Specifies a function to save an author copy.  The function is
1148     called with a file name.  The default function `rmail-output'
1149     saves in Unix mail format.
1150
1151  gnus-kill-file-name
1152     Use specified file name as a KILL file (default to `KILL').
1153
1154  gnus-novice-user
1155     Non-nil means that you are a novice to USENET.  If non-nil,
1156     verbose messages may be displayed or your confirmations may be
1157     required.
1158
1159  gnus-interactive-post
1160     Non-nil means that newsgroup, subject and distribution are asked
1161     for interactively when posting a new article.
1162
1163  gnus-use-full-window
1164     Non-nil means to take up the entire screen of Emacs.
1165
1166  gnus-window-configuration
1167     Specifies the configuration of Group, Summary, and Article
1168     windows.  It is a list of (ACTION (G S A)), where G, S, and A are
1169     the relative height of Group, Summary, and Article windows,
1170     respectively.  ACTION is `summary', `newsgroups', or `article'.
1171
1172  gnus-subscribe-newsgroup-method
1173     Specifies a function called with a newsgroup name when new
1174     newsgroup is found.  The default definition adds new newsgroup at
1175     the beginning of other newsgroups.
1176
1177   And more and more.  Please refer to texinfo documentation.
1178
1179 Various hooks for customization:
1180  gnus-group-mode-hook
1181     Entry to this mode calls the value with no arguments, if that
1182     value is non-nil. This hook is called before GNUS is connected to
1183     the NNTP server. So, you can change or define the NNTP server in
1184     this hook.
1185
1186  gnus-startup-hook
1187     Called with no arguments after the NNTP server is selected. It is
1188     possible to change the behavior of GNUS or initialize the
1189     variables according to the selected NNTP server.
1190
1191  gnus-group-prepare-hook
1192     Called with no arguments after a newsgroup list is created in the
1193     Newsgroup buffer, if that value is non-nil.
1194
1195  gnus-save-newsrc-hook
1196     Called with no arguments when saving newsrc file if that value is
1197     non-nil.
1198
1199  gnus-prepare-article-hook
1200     Called with no arguments after preparing message body, but before
1201     preparing header fields which is automatically generated if that
1202     value is non-nil.  The default hook (gnus-inews-insert-signature)
1203     inserts a signature file.
1204
1205  gnus-inews-article-hook
1206     Called with no arguments when posting an article if that value is
1207     non-nil.  This hook is called just before posting an article.  The
1208     default hook does FCC (save an article to the specified file).
1209
1210  gnus-suspend-gnus-hook
1211     Called with no arguments when suspending (not exiting) GNUS, if
1212     that value is non-nil.
1213
1214  gnus-exit-gnus-hook
1215     Called with no arguments when exiting (not suspending) GNUS, if
1216     that value is non-nil."
1217   (interactive)
1218   (kill-all-local-variables)
1219   ;; Gee.  Why don't you upgrade?
1220   (cond ((boundp 'mode-line-modified)
1221          (setq mode-line-modified "--- "))
1222         ((listp (default-value 'mode-line-format))
1223          (setq mode-line-format
1224                (cons "--- " (cdr (default-value 'mode-line-format)))))
1225         (t
1226          (setq mode-line-format
1227                "--- GNUS: List of Newsgroups  %[(%m)%]----%3p-%-")))
1228   (setq major-mode 'gnus-group-mode)
1229   (setq mode-name "Newsgroup")
1230   (setq mode-line-buffer-identification "GNUS: List of Newsgroups")
1231   (setq mode-line-process nil)
1232   (use-local-map gnus-group-mode-map)
1233   (buffer-flush-undo (current-buffer))
1234   (setq buffer-read-only t)             ;Disable modification
1235   (run-hooks 'gnus-group-mode-hook))
1236
1237 (defun gnus-mouse-pick-group (e)
1238   (interactive "e")
1239   (mouse-set-point e)
1240   (gnus-group-read-group nil))
1241
1242 ;;;###autoload
1243 (defun gnus (&optional confirm)
1244   "Read network news.
1245 If optional argument CONFIRM is non-nil, ask NNTP server."
1246   (interactive "P")
1247   (unwind-protect
1248       (progn
1249         (switch-to-buffer (get-buffer-create gnus-group-buffer))
1250         (gnus-group-mode)
1251         (gnus-start-news-server confirm))
1252     (if (not (gnus-server-opened))
1253         (gnus-group-quit)
1254       ;; NNTP server is successfully open.
1255       (setq mode-line-process (format " {%s}" gnus-nntp-server))
1256       (let ((buffer-read-only nil))
1257         (erase-buffer)
1258         (gnus-group-startup-message)
1259         (sit-for 0))
1260       (run-hooks 'gnus-startup-hook)
1261       (gnus-setup-news)
1262       (if gnus-novice-user
1263           (gnus-group-describe-briefly)) ;Show brief help message.
1264       (gnus-group-list-groups nil)
1265       )))
1266
1267 (defun gnus-group-startup-message ()
1268   "Insert startup message in current buffer."
1269   ;; Insert the message.
1270   (insert
1271    (format "
1272                    %s
1273
1274          NNTP-based News Reader for GNU Emacs
1275
1276
1277 If you have any trouble with this software, please let me
1278 know. I will fix your problems in the next release.
1279
1280 Comments, suggestions, and bug fixes are welcome.
1281
1282 Masanobu UMEDA
1283 umerin@mse.kyutech.ac.jp" gnus-version))
1284   ;; And then hack it.
1285   ;; 57 is the longest line.
1286   (indent-rigidly (point-min) (point-max) (/ (max (- (window-width) 57) 0) 2))
1287   (goto-char (point-min))
1288   ;; +4 is fuzzy factor.
1289   (insert-char ?\n (/ (max (- (window-height) 18) 0) 2)))
1290
1291 (defun gnus-group-list-groups (show-all)
1292   "List newsgroups in the Newsgroup buffer.
1293 If argument SHOW-ALL is non-nil, unsubscribed groups are also listed."
1294   (interactive "P")
1295   (let ((case-fold-search nil)
1296         (last-group                     ;Current newsgroup.
1297          (gnus-group-group-name))
1298         (next-group                     ;Next possible newsgroup.
1299          (progn
1300            (gnus-group-search-forward nil nil)
1301            (gnus-group-group-name)))
1302         (prev-group                     ;Previous possible newsgroup.
1303          (progn
1304            (gnus-group-search-forward t nil)
1305            (gnus-group-group-name))))
1306     (set-buffer gnus-group-buffer)      ;May call from out of Group buffer
1307     (gnus-group-prepare show-all)
1308     (if (zerop (buffer-size))
1309         (message "No news is good news")
1310       ;; Go to last newsgroup if possible.  If cannot, try next and
1311       ;; previous.  If all fail, go to first unread newsgroup.
1312       (goto-char (point-min))
1313       (or (and last-group
1314                (re-search-forward (gnus-group-make-regexp last-group) nil t))
1315           (and next-group
1316                (re-search-forward (gnus-group-make-regexp next-group) nil t))
1317           (and prev-group
1318                (re-search-forward (gnus-group-make-regexp prev-group) nil t))
1319           (gnus-group-search-forward nil nil t))
1320       ;; Adjust cursor point.
1321       (beginning-of-line)
1322       (search-forward ":" nil t)
1323       )))
1324
1325 (defun gnus-group-prepare (&optional all)
1326   "Prepare list of newsgroups in current buffer.
1327 If optional argument ALL is non-nil, unsubscribed groups are also listed."
1328   (let ((buffer-read-only nil)
1329         (newsrc gnus-newsrc-assoc)
1330         (group-info nil)
1331         (group-name nil)
1332         (unread-count 0)
1333         ;; This specifies the format of Group buffer.
1334         (cntl "%s%s%5d: %s\n"))
1335     (erase-buffer)
1336     ;; List newsgroups.
1337     (while newsrc
1338       (setq group-info (car newsrc))
1339       (setq group-name (car group-info))
1340       (setq unread-count (nth 1 (gnus-gethash group-name gnus-unread-hashtb)))
1341       (if (or all
1342               (and (nth 1 group-info)   ;Subscribed.
1343                    (> unread-count 0))) ;There are unread articles.
1344           ;; Yes, I can use gnus-group-prepare-line, but this is faster.
1345           (insert
1346            (format cntl
1347                    ;; Subscribed or not.
1348                    (if (nth 1 group-info) " " "U")
1349                    ;; Has new news?
1350                    (if (and (> unread-count 0)
1351                             (>= 0
1352                                 (- unread-count
1353                                    (length
1354                                     (cdr (gnus-gethash group-name
1355                                                        gnus-marked-hashtb))))))
1356                        "*" " ")
1357                    ;; Number of unread articles.
1358                    unread-count
1359                    ;; Newsgroup name.
1360                    group-name))
1361         )
1362       (setq newsrc (cdr newsrc))
1363       )
1364     (setq gnus-have-all-newsgroups all)
1365     (goto-char (point-min))
1366     (run-hooks 'gnus-group-prepare-hook)
1367     ))
1368
1369 (defun gnus-group-prepare-line (info)
1370   "Return a string for the Newsgroup buffer from INFO.
1371 INFO is an element of gnus-newsrc-assoc or gnus-killed-assoc."
1372   (let* ((group-name (car info))
1373          (unread-count
1374           (or (nth 1 (gnus-gethash group-name gnus-unread-hashtb))
1375               ;; Not in hash table, so compute it now.
1376               (gnus-number-of-articles
1377                (gnus-difference-of-range
1378                 (nth 2 (gnus-gethash group-name gnus-active-hashtb))
1379                 (nthcdr 2 info)))))
1380          ;; This specifies the format of Group buffer.
1381          (cntl "%s%s%5d: %s\n"))
1382     (format cntl
1383             ;; Subscribed or not.
1384             (if (nth 1 info) " " "U")
1385             ;; Has new news?
1386             (if (and (> unread-count 0)
1387                      (>= 0
1388                          (- unread-count
1389                             (length
1390                              (cdr (gnus-gethash group-name
1391                                                 gnus-marked-hashtb))))))
1392                 "*" " ")
1393             ;; Number of unread articles.
1394             unread-count
1395             ;; Newsgroup name.
1396             group-name
1397             )))
1398
1399 (defun gnus-group-update-group (group &optional visible-only)
1400   "Update newsgroup info of GROUP.
1401 If optional argument VISIBLE-ONLY is non-nil, non displayed group is ignored."
1402   (let ((buffer-read-only nil)
1403         (case-fold-search nil)          ;appleIIgs vs. appleiigs
1404         (regexp (gnus-group-make-regexp group))
1405         (visible nil))
1406     ;; Buffer may be narrowed.
1407     (save-restriction
1408       (widen)
1409       ;; Search a line to modify.  If the buffer is large, the search
1410       ;; takes long time.  In most cases, current point is on the line
1411       ;; we are looking for.  So, first of all, check current line.
1412       ;; And then if current point is in the first half, search from
1413       ;; the beginning.  Otherwise, search from the end.
1414       (if (cond ((progn
1415                    (beginning-of-line)
1416                    (looking-at regexp)))
1417                 ((and (> (/ (buffer-size) 2) (point)) ;In the first half.
1418                       (progn
1419                         (goto-char (point-min))
1420                         (re-search-forward regexp nil t))))
1421                 ((progn
1422                    (goto-char (point-max))
1423                    (re-search-backward regexp nil t))))
1424           ;; GROUP is listed in current buffer. So, delete old line.
1425           (progn
1426             (setq visible t)
1427             (beginning-of-line)
1428             (delete-region (point) (progn (forward-line 1) (point)))
1429             )
1430         ;; No such line in the buffer, so insert it at the top.
1431         (goto-char (point-min)))
1432       (if (or visible (not visible-only))
1433           (progn
1434             (insert (gnus-group-prepare-line
1435                      (gnus-gethash group gnus-newsrc-hashtb)))
1436             (forward-line -1)           ;Move point on that line.
1437             ))
1438       )))
1439
1440 (defun gnus-group-group-name ()
1441   "Get newsgroup name around point."
1442   (save-excursion
1443     (beginning-of-line)
1444     (if (looking-at "^.+:[ \t]+\\([^ \t\n]+\\)\\([ \t].*\\|$\\)")
1445         (let ((group-name (buffer-substring (match-beginning 1) (match-end 1))))
1446           (set-text-properties 0 (length group-name) nil group-name)
1447           group-name))))
1448
1449 (defun gnus-group-make-regexp (newsgroup)
1450   "Return regexp that matches for a line of NEWSGROUP."
1451   (concat "^.+: " (regexp-quote newsgroup) "\\([ \t].*\\|$\\)"))
1452
1453 (defun gnus-group-search-forward (backward norest &optional heretoo)
1454   "Search for the next (or previous) newsgroup.
1455 If 1st argument BACKWARD is non-nil, search backward instead.
1456 If 2nd argument NOREST is non-nil, don't care about newsgroup property.
1457 If optional argument HERETOO is non-nil, current line is searched for, too."
1458   (let ((case-fold-search nil)
1459         (func
1460          (if backward
1461              (function re-search-backward) (function re-search-forward)))
1462         (regexp
1463          (format "^%s[ \t]*\\(%s\\):"
1464                  (if norest ".." " [ \t]")
1465                  (if norest "[0-9]+" "[1-9][0-9]*")))
1466         (found nil))
1467     (if backward
1468         (if heretoo
1469             (end-of-line)
1470           (beginning-of-line))
1471       (if heretoo
1472           (beginning-of-line)
1473         (end-of-line)))
1474     (setq found (funcall func regexp nil t))
1475     ;; Adjust cursor point.
1476     (beginning-of-line)
1477     (search-forward ":" nil t)
1478     ;; Return T if found.
1479     found
1480     ))
1481
1482 ;; GNUS Group mode command
1483
1484 (defun gnus-group-read-group (all &optional no-article)
1485   "Read news in this newsgroup.
1486 If argument ALL is non-nil, already read articles become readable.
1487 If optional argument NO-ARTICLE is non-nil, no article body is displayed."
1488   (interactive "P")
1489   (let ((group (gnus-group-group-name))) ;Newsgroup name to read.
1490     (if group
1491         (gnus-summary-read-group
1492          group
1493          (or all
1494              ;;(not (nth 1 (gnus-gethash group gnus-newsrc-hashtb))) ;Unsubscribed
1495              (zerop
1496               (nth 1 (gnus-gethash group gnus-unread-hashtb)))) ;No unread
1497          no-article
1498          ))
1499     ))
1500
1501 (defun gnus-group-select-group (all)
1502   "Select this newsgroup.
1503 No article is selected automatically.
1504 If argument ALL is non-nil, already read articles become readable."
1505   (interactive "P")
1506   (gnus-group-read-group all t))
1507
1508 (defun gnus-group-jump-to-group (group)
1509   "Jump to newsgroup GROUP."
1510   (interactive
1511    (list (completing-read "Newsgroup: " gnus-newsrc-assoc nil 'require-match)))
1512   (let ((case-fold-search nil))
1513     (goto-char (point-min))
1514     (or (re-search-forward (gnus-group-make-regexp group) nil t)
1515         (if (gnus-gethash group gnus-newsrc-hashtb)
1516             ;; Add GROUP entry, then seach again.
1517             (gnus-group-update-group group)))
1518     ;; Adjust cursor point.
1519     (beginning-of-line)
1520     (search-forward ":" nil t)
1521     ))
1522
1523 (defun gnus-group-next-group (n)
1524   "Go to next N'th newsgroup."
1525   (interactive "p")
1526   (while (and (> n 1)
1527               (gnus-group-search-forward nil t))
1528     (setq n (1- n)))
1529   (or (gnus-group-search-forward nil t)
1530       (message "No more newsgroups")))
1531
1532 (defun gnus-group-next-unread-group (n)
1533   "Go to next N'th unread newsgroup."
1534   (interactive "p")
1535   (while (and (> n 1)
1536               (gnus-group-search-forward nil nil))
1537     (setq n (1- n)))
1538   (or (gnus-group-search-forward nil nil)
1539       (message "No more unread newsgroups")))
1540
1541 (defun gnus-group-prev-group (n)
1542   "Go to previous N'th newsgroup."
1543   (interactive "p")
1544   (while (and (> n 1)
1545               (gnus-group-search-forward t t))
1546     (setq n (1- n)))
1547   (or (gnus-group-search-forward t t)
1548       (message "No more newsgroups")))
1549
1550 (defun gnus-group-prev-unread-group (n)
1551   "Go to previous N'th unread newsgroup."
1552   (interactive "p")
1553   (while (and (> n 1)
1554               (gnus-group-search-forward t nil))
1555     (setq n (1- n)))
1556   (or (gnus-group-search-forward t nil)
1557       (message "No more unread newsgroups")))
1558
1559 (defun gnus-group-catchup (all)
1560   "Mark all articles not marked as unread in current newsgroup as read.
1561 If prefix argument ALL is non-nil, all articles are marked as read.
1562 Cross references (Xref: field) of articles are ignored."
1563   (interactive "P")
1564   (let* ((group (gnus-group-group-name))
1565          (marked (if (not all)
1566                      (cdr (gnus-gethash group gnus-marked-hashtb)))))
1567     (and group
1568          (or (not gnus-interactive-catchup) ;Without confirmation?
1569              (y-or-n-p
1570               (if all
1571                   "Do you really want to mark everything as read? "
1572                 "Delete all articles not marked as read? ")))
1573          (progn
1574            (message "")                 ;Clear "Yes or No" question.
1575            ;; Any marked articles will be preserved.
1576            (gnus-update-unread-articles group marked marked)
1577            (gnus-group-update-group group)
1578            (gnus-group-next-group 1)))
1579     ))
1580
1581 (defun gnus-group-catchup-all ()
1582   "Mark all articles in current newsgroup as read.
1583 Cross references (Xref: field) of articles are ignored."
1584   (interactive)
1585   (gnus-group-catchup t))
1586
1587 (defun gnus-group-unsubscribe-current-group ()
1588   "Toggle subscribe from/to unsubscribe current group."
1589   (interactive)
1590   (let ((group (gnus-group-group-name)))
1591     (if group
1592          (progn
1593            (gnus-group-unsubscribe-group group)
1594            (gnus-group-next-group 1))
1595       (message "No Newsgroup found to \(un\)subscribe"))))
1596
1597 (defun gnus-group-unsubscribe-group (group)
1598   "Toggle subscribe from/to unsubscribe GROUP.
1599 New newsgroup is added to .newsrc automatically."
1600   (interactive
1601    (list (completing-read "Newsgroup: "
1602                           gnus-active-hashtb nil 'require-match)))
1603   (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
1604     (cond ((not (null newsrc))
1605            ;; Toggle subscription flag.
1606            (setcar (nthcdr 1 newsrc) (not (nth 1 newsrc)))
1607            (gnus-update-newsrc-buffer group)
1608            (gnus-group-update-group group)
1609            ;; Adjust cursor point.
1610            (beginning-of-line)
1611            (search-forward ":" nil t))
1612           ((and (stringp group)
1613                 (gnus-gethash group gnus-active-hashtb))
1614            ;; Add new newsgroup.
1615            (gnus-add-newsgroup group)
1616            (gnus-group-update-group group)
1617            ;; Adjust cursor point.
1618            (beginning-of-line)
1619            (search-forward ":" nil t))
1620           (t (error "No such newsgroup: %s" group)))
1621     ))
1622
1623 (defun gnus-group-list-all-groups ()
1624   "List all of newsgroups in the Newsgroup buffer."
1625   (interactive)
1626   (message "Listing all groups...")
1627   (gnus-group-list-groups t)
1628   (message "Listing all groups...done"))
1629
1630 (defun gnus-group-get-new-news ()
1631   "Get newly arrived articles. In fact, read the active file again."
1632   (interactive)
1633   (gnus-setup-news)
1634   (gnus-group-list-groups gnus-have-all-newsgroups))
1635
1636 (defun gnus-group-restart ()
1637   "Force GNUS to read the raw startup file."
1638   (interactive)
1639   (gnus-save-newsrc-file)
1640   (gnus-setup-news t)                   ;Force to read the raw startup file.
1641   (gnus-group-list-groups gnus-have-all-newsgroups))
1642
1643 (defun gnus-group-check-bogus-groups ()
1644   "Check bogus newsgroups."
1645   (interactive)
1646   (gnus-check-bogus-newsgroups t)       ;Require confirmation.
1647   (gnus-group-list-groups gnus-have-all-newsgroups))
1648
1649 (defun gnus-group-restrict-groups (start end)
1650   "Restrict visible newsgroups to the current region (START and END).
1651 Type \\[widen] to remove restriction."
1652   (interactive "r")
1653   (save-excursion
1654     (narrow-to-region (progn
1655                         (goto-char start)
1656                         (beginning-of-line)
1657                         (point))
1658                       (progn
1659                         (goto-char end)
1660                         (forward-line 1)
1661                         (point))))
1662   (message (substitute-command-keys "Type \\[widen] to remove restriction")))
1663
1664 (defun gnus-group-edit-global-kill ()
1665   "Edit a global KILL file."
1666   (interactive)
1667   (setq gnus-current-kill-article nil)  ;No articles selected.
1668   (gnus-kill-file-edit-file nil)        ;Nil stands for global KILL file.
1669   (message
1670    (substitute-command-keys
1671     "Editing a global KILL file (Type \\[gnus-kill-file-exit] to exit)")))
1672
1673 (defun gnus-group-edit-local-kill ()
1674   "Edit a local KILL file."
1675   (interactive)
1676   (setq gnus-current-kill-article nil)  ;No articles selected.
1677   (gnus-kill-file-edit-file (gnus-group-group-name))
1678   (message
1679    (substitute-command-keys
1680     "Editing a local KILL file (Type \\[gnus-kill-file-exit] to exit)")))
1681
1682 (defun gnus-group-force-update ()
1683   "Update `.newsrc' file."
1684   (interactive)
1685   (gnus-save-newsrc-file))
1686
1687 (defun gnus-group-suspend ()
1688   "Suspend the current GNUS session.
1689 In fact, cleanup buffers except for Group Mode buffer.
1690 The hook gnus-suspend-gnus-hook is called before actually suspending."
1691   (interactive)
1692   (run-hooks 'gnus-suspend-gnus-hook)
1693   ;; Kill GNUS buffers except for Group Mode buffer.
1694   (let ((buffers gnus-buffer-list)
1695         (group-buf (get-buffer gnus-group-buffer)))
1696     (while buffers
1697       (and (not (eq (car buffers) gnus-group-buffer))
1698            (get-buffer (car buffers))
1699            (kill-buffer (car buffers)))
1700       (setq buffers (cdr buffers))
1701       )
1702     (bury-buffer group-buf)
1703     (delete-windows-on group-buf t)))
1704
1705 (defun gnus-group-exit ()
1706   "Quit reading news after updating .newsrc.
1707 The hook gnus-exit-gnus-hook is called before actually quitting."
1708   (interactive)
1709   (if (or noninteractive                ;For gnus-batch-kill
1710           (zerop (buffer-size))         ;No news is good news.
1711           (not (gnus-server-opened))    ;NNTP connection closed.
1712           (not gnus-interactive-exit)   ;Without confirmation
1713           (y-or-n-p "Are you sure you want to quit reading news? "))
1714       (progn
1715         (message "")                    ;Erase "Yes or No" question.
1716         (run-hooks 'gnus-exit-gnus-hook)
1717         (gnus-save-newsrc-file)
1718         (gnus-clear-system)
1719         (gnus-close-server))
1720     ))
1721
1722 (defun gnus-group-quit ()
1723   "Quit reading news without updating .newsrc.
1724 The hook gnus-exit-gnus-hook is called before actually quitting."
1725   (interactive)
1726   (if (or noninteractive                ;For gnus-batch-kill
1727           (zerop (buffer-size))
1728           (not (gnus-server-opened))
1729           (yes-or-no-p
1730            (format "Quit reading news without saving %s? "
1731                    (file-name-nondirectory gnus-current-startup-file))))
1732       (progn
1733         (message "")                    ;Erase "Yes or No" question.
1734         (run-hooks 'gnus-exit-gnus-hook)
1735         (gnus-clear-system)
1736         (gnus-close-server))
1737     ))
1738
1739 (defun gnus-group-describe-briefly ()
1740   "Describe Group mode commands briefly."
1741   (interactive)
1742   (message
1743    (concat
1744     (substitute-command-keys "\\[gnus-group-read-group]:Select  ")
1745     (substitute-command-keys "\\[gnus-group-next-unread-group]:Forward  ")
1746     (substitute-command-keys "\\[gnus-group-prev-unread-group]:Backward  ")
1747     (substitute-command-keys "\\[gnus-group-exit]:Exit  ")
1748     (substitute-command-keys "\\[gnus-info-find-node]:Run Info  ")
1749     (substitute-command-keys "\\[gnus-group-describe-briefly]:This help")
1750     )))
1751
1752 \f
1753 ;;;
1754 ;;; GNUS Summary Mode
1755 ;;;
1756
1757 (if gnus-summary-mode-map
1758     nil
1759   (setq gnus-summary-mode-map (make-keymap))
1760   (suppress-keymap gnus-summary-mode-map)
1761   (define-key gnus-summary-mode-map "\C-c\C-v" 'gnus-uu-ctl-map)
1762   (define-key gnus-summary-mode-map "#" 'gnus-uu-mark-article)
1763   (define-key gnus-summary-mode-map " " 'gnus-summary-next-page)
1764   (define-key gnus-summary-mode-map "\177" 'gnus-summary-prev-page)
1765   (define-key gnus-summary-mode-map "\r" 'gnus-summary-scroll-up)
1766   (define-key gnus-summary-mode-map "n" 'gnus-summary-next-unread-article)
1767   (define-key gnus-summary-mode-map "p" 'gnus-summary-prev-unread-article)
1768   (define-key gnus-summary-mode-map "N" 'gnus-summary-next-article)
1769   (define-key gnus-summary-mode-map "P" 'gnus-summary-prev-article)
1770   (define-key gnus-summary-mode-map "\e\C-n" 'gnus-summary-next-same-subject)
1771   (define-key gnus-summary-mode-map "\e\C-p" 'gnus-summary-prev-same-subject)
1772   ;;(define-key gnus-summary-mode-map "\e\C-n" 'gnus-summary-next-unread-same-subject)
1773   ;;(define-key gnus-summary-mode-map "\e\C-p" 'gnus-summary-prev-unread-same-subject)
1774   (define-key gnus-summary-mode-map "\C-c\C-n" 'gnus-summary-next-digest)
1775   (define-key gnus-summary-mode-map "\C-c\C-p" 'gnus-summary-prev-digest)
1776   (define-key gnus-summary-mode-map "\C-n" 'gnus-summary-next-subject)
1777   (define-key gnus-summary-mode-map "\C-p" 'gnus-summary-prev-subject)
1778   (define-key gnus-summary-mode-map [down] 'gnus-summary-next-subject)
1779   (define-key gnus-summary-mode-map [up] 'gnus-summary-prev-subject)
1780   (define-key gnus-summary-mode-map "\en" 'gnus-summary-next-unread-subject)
1781   (define-key gnus-summary-mode-map "\ep" 'gnus-summary-prev-unread-subject)
1782   ;;(define-key gnus-summary-mode-map "\C-cn" 'gnus-summary-next-group)
1783   ;;(define-key gnus-summary-mode-map "\C-cp" 'gnus-summary-prev-group)
1784   (define-key gnus-summary-mode-map "." 'gnus-summary-first-unread-article)
1785   ;;(define-key gnus-summary-mode-map "/" 'isearch-forward)
1786   (define-key gnus-summary-mode-map "s" 'gnus-summary-isearch-article)
1787   (define-key gnus-summary-mode-map "\es" 'gnus-summary-search-article-forward)
1788   ;;(define-key gnus-summary-mode-map "\eS" 'gnus-summary-search-article-backward)
1789   (define-key gnus-summary-mode-map "\er" 'gnus-summary-search-article-backward)
1790   (define-key gnus-summary-mode-map "<" 'gnus-summary-beginning-of-article)
1791   (define-key gnus-summary-mode-map ">" 'gnus-summary-end-of-article)
1792   (define-key gnus-summary-mode-map "j" 'gnus-summary-goto-subject)
1793   ;;(define-key gnus-summary-mode-map "J" 'gnus-summary-goto-article)
1794   (define-key gnus-summary-mode-map "l" 'gnus-summary-goto-last-article)
1795   (define-key gnus-summary-mode-map "^" 'gnus-summary-refer-parent-article)
1796   ;;(define-key gnus-summary-mode-map "\er" 'gnus-summary-refer-article)
1797   (define-key gnus-summary-mode-map "\e^" 'gnus-summary-refer-article)
1798   (define-key gnus-summary-mode-map "u" 'gnus-summary-mark-as-unread-forward)
1799   (define-key gnus-summary-mode-map "U" 'gnus-summary-mark-as-unread-backward)
1800   (define-key gnus-summary-mode-map "d" 'gnus-summary-mark-as-read-forward)
1801   (define-key gnus-summary-mode-map "D" 'gnus-summary-mark-as-read-backward)
1802   (define-key gnus-summary-mode-map "\eu" 'gnus-summary-clear-mark-forward)
1803   (define-key gnus-summary-mode-map "\eU" 'gnus-summary-clear-mark-backward)
1804   (define-key gnus-summary-mode-map "k" 'gnus-summary-kill-same-subject-and-select)
1805   (define-key gnus-summary-mode-map "\C-k" 'gnus-summary-kill-same-subject)
1806   (define-key gnus-summary-mode-map "\e\C-t" 'gnus-summary-toggle-threads)
1807   (define-key gnus-summary-mode-map "\e\C-s" 'gnus-summary-show-thread)
1808   (define-key gnus-summary-mode-map "\e\C-h" 'gnus-summary-hide-thread)
1809   (define-key gnus-summary-mode-map "\e\C-f" 'gnus-summary-next-thread)
1810   (define-key gnus-summary-mode-map "\e\C-b" 'gnus-summary-prev-thread)
1811   (define-key gnus-summary-mode-map "\e\C-u" 'gnus-summary-up-thread)
1812   (define-key gnus-summary-mode-map "\e\C-d" 'gnus-summary-down-thread)
1813   (define-key gnus-summary-mode-map "\e\C-k" 'gnus-summary-kill-thread)
1814   (define-key gnus-summary-mode-map "&" 'gnus-summary-execute-command)
1815   ;;(define-key gnus-summary-mode-map "c" 'gnus-summary-catchup)
1816   ;;(define-key gnus-summary-mode-map "c" 'gnus-summary-catchup-all)
1817   (define-key gnus-summary-mode-map "c" 'gnus-summary-catchup-and-exit)
1818   ;;(define-key gnus-summary-mode-map "c" 'gnus-summary-catchup-all-and-exit)
1819   (define-key gnus-summary-mode-map "\C-t" 'gnus-summary-toggle-truncation)
1820   (define-key gnus-summary-mode-map "x" 'gnus-summary-delete-marked-as-read)
1821   (define-key gnus-summary-mode-map "X" 'gnus-summary-delete-marked-with)
1822   (define-key gnus-summary-mode-map "\C-c\C-sn" 'gnus-summary-sort-by-number)
1823   (define-key gnus-summary-mode-map "\C-c\C-sa" 'gnus-summary-sort-by-author)
1824   (define-key gnus-summary-mode-map "\C-c\C-ss" 'gnus-summary-sort-by-subject)
1825   (define-key gnus-summary-mode-map "\C-c\C-sd" 'gnus-summary-sort-by-date)
1826   (define-key gnus-summary-mode-map "\C-c\C-s\C-n" 'gnus-summary-sort-by-number)
1827   (define-key gnus-summary-mode-map "\C-c\C-s\C-a" 'gnus-summary-sort-by-author)
1828   (define-key gnus-summary-mode-map "\C-c\C-s\C-s" 'gnus-summary-sort-by-subject)
1829   (define-key gnus-summary-mode-map "\C-c\C-s\C-d" 'gnus-summary-sort-by-date)
1830   (define-key gnus-summary-mode-map "=" 'gnus-summary-expand-window)
1831   ;;(define-key gnus-summary-mode-map "G" 'gnus-summary-reselect-current-group)
1832   (define-key gnus-summary-mode-map "\C-x\C-s" 'gnus-summary-reselect-current-group)
1833   (define-key gnus-summary-mode-map "w" 'gnus-summary-stop-page-breaking)
1834   (define-key gnus-summary-mode-map "\C-c\C-r" 'gnus-summary-caesar-message)
1835   (define-key gnus-summary-mode-map "g" 'gnus-summary-show-article)
1836   (define-key gnus-summary-mode-map "t" 'gnus-summary-toggle-header)
1837   ;;(define-key gnus-summary-mode-map "v" 'gnus-summary-show-all-headers)
1838   (define-key gnus-summary-mode-map "\et" 'gnus-summary-toggle-mime)
1839   (define-key gnus-summary-mode-map "\C-d" 'gnus-summary-rmail-digest)
1840   (define-key gnus-summary-mode-map "a" 'gnus-summary-post-news)
1841   (define-key gnus-summary-mode-map "f" 'gnus-summary-followup)
1842   (define-key gnus-summary-mode-map "F" 'gnus-summary-followup-with-original)
1843   (define-key gnus-summary-mode-map "C" 'gnus-summary-cancel-article)
1844   (define-key gnus-summary-mode-map "r" 'gnus-summary-reply)
1845   (define-key gnus-summary-mode-map "R" 'gnus-summary-reply-with-original)
1846   (define-key gnus-summary-mode-map "\C-c\C-f" 'gnus-summary-mail-forward)
1847   (define-key gnus-summary-mode-map "m" 'gnus-summary-mail-other-window)
1848   (define-key gnus-summary-mode-map "o" 'gnus-summary-save-article)
1849   (define-key gnus-summary-mode-map "\C-o" 'gnus-summary-save-in-mail)
1850   (define-key gnus-summary-mode-map "|" 'gnus-summary-pipe-output)
1851   (define-key gnus-summary-mode-map "\ek" 'gnus-summary-edit-local-kill)
1852   (define-key gnus-summary-mode-map "\eK" 'gnus-summary-edit-global-kill)
1853   (define-key gnus-summary-mode-map "V" 'gnus-version)
1854   (define-key gnus-summary-mode-map "q" 'gnus-summary-exit)
1855   (define-key gnus-summary-mode-map "Q" 'gnus-summary-quit)
1856   (define-key gnus-summary-mode-map "?" 'gnus-summary-describe-briefly)
1857   (define-key gnus-summary-mode-map "\C-c\C-i" 'gnus-info-find-node)
1858   (define-key gnus-summary-mode-map [mouse-2] 'gnus-mouse-pick-article)
1859
1860   (define-key gnus-summary-mode-map [menu-bar misc]
1861         (cons "Misc" (make-sparse-keymap "misc")))
1862
1863   (define-key gnus-summary-mode-map [menu-bar misc caesar-message]
1864         '("Caesar Message" . gnus-summary-caesar-message))
1865   (define-key gnus-summary-mode-map [menu-bar misc cancel-article]
1866         '("Cancel Article" . gnus-summary-cancel-article))
1867   (define-key gnus-summary-mode-map [menu-bar misc edit-local-kill]
1868         '("Edit Kill File" . gnus-summary-edit-local-kill))
1869
1870   (define-key gnus-summary-mode-map [menu-bar misc mark-as-unread]
1871         '("Mark as Unread" . gnus-summary-mark-as-unread-forward))
1872   (define-key gnus-summary-mode-map [menu-bar misc mark-as-read]
1873         '("Mark as Read" . gnus-summary-mark-as-read))
1874
1875   (define-key gnus-summary-mode-map [menu-bar misc quit]
1876         '("Quit Group" . gnus-summary-quit))
1877   (define-key gnus-summary-mode-map [menu-bar misc exit]
1878         '("Exit Group" . gnus-summary-exit))
1879
1880   (define-key gnus-summary-mode-map [menu-bar sort]
1881         (cons "Sort" (make-sparse-keymap "sort")))
1882
1883   (define-key gnus-summary-mode-map [menu-bar sort sort-by-author]
1884         '("Sort by Author" . gnus-summary-sort-by-author))
1885   (define-key gnus-summary-mode-map [menu-bar sort sort-by-date]
1886         '("Sort by Date" . gnus-summary-sort-by-date))
1887   (define-key gnus-summary-mode-map [menu-bar sort sort-by-number]
1888         '("Sort by Number" . gnus-summary-sort-by-number))
1889   (define-key gnus-summary-mode-map [menu-bar sort sort-by-subject]
1890         '("Sort by Subject" . gnus-summary-sort-by-subject))
1891
1892   (define-key gnus-summary-mode-map [menu-bar show/hide]
1893         (cons "Show/Hide" (make-sparse-keymap "show/hide")))
1894
1895   (define-key gnus-summary-mode-map [menu-bar show/hide hide-all-threads]
1896         '("Hide All Threads" . gnus-summary-hide-all-threads))
1897   (define-key gnus-summary-mode-map [menu-bar show/hide hide-thread]
1898         '("Hide Thread" . gnus-summary-hide-thread))
1899   (define-key gnus-summary-mode-map [menu-bar show/hide show-all-threads]
1900         '("Show All Threads" . gnus-summary-show-all-threads))
1901   (define-key gnus-summary-mode-map [menu-bar show/hide show-all-headers]
1902         '("Show All Headers" . gnus-summary-show-all-headers))
1903   (define-key gnus-summary-mode-map [menu-bar show/hide show-thread]
1904         '("Show Thread" . gnus-summary-show-thread))
1905   (define-key gnus-summary-mode-map [menu-bar show/hide show-article]
1906         '("Show Article" . gnus-summary-show-article))
1907   (define-key gnus-summary-mode-map [menu-bar show/hide toggle-truncation]
1908         '("Toggle Truncation" . gnus-summary-toggle-truncation))
1909   (define-key gnus-summary-mode-map [menu-bar show/hide toggle-mime]
1910         '("Toggle Mime" . gnus-summary-toggle-mime))
1911   (define-key gnus-summary-mode-map [menu-bar show/hide toggle-header]
1912         '("Toggle Header" . gnus-summary-toggle-header))
1913
1914   (define-key gnus-summary-mode-map [menu-bar action]
1915         (cons "Action" (make-sparse-keymap "action")))
1916
1917   (define-key gnus-summary-mode-map [menu-bar action kill-same-subject]
1918         '("Kill Same Subject" . gnus-summary-kill-same-subject))
1919   (define-key gnus-summary-mode-map [menu-bar action kill-thread]
1920         '("Kill Thread" . gnus-summary-kill-thread))
1921   (define-key gnus-summary-mode-map [menu-bar action delete-marked-with]
1922         '("Delete Marked With" . gnus-summary-delete-marked-with))
1923   (define-key gnus-summary-mode-map [menu-bar action delete-marked-as-read]
1924         '("Delete Marked As Read" . gnus-summary-delete-marked-as-read))
1925   (define-key gnus-summary-mode-map [menu-bar action catchup-and-exit]
1926         '("Catchup And Exit" . gnus-summary-catchup-and-exit))
1927   (define-key gnus-summary-mode-map [menu-bar action catchup-to-here]
1928         '("Catchup to Here" . gnus-summary-catchup-to-here))
1929
1930   (define-key gnus-summary-mode-map [menu-bar action ignore]
1931     '("---"))
1932
1933   (define-key gnus-summary-mode-map [menu-bar action save-in-file]
1934         '("Save in File" . gnus-summary-save-in-file))
1935   (define-key gnus-summary-mode-map [menu-bar action save-article]
1936         '("Save Article" . gnus-summary-save-article))
1937
1938   (define-key gnus-summary-mode-map [menu-bar action lambda]
1939     '("---"))
1940
1941   (define-key gnus-summary-mode-map [menu-bar action forward]
1942         '("Forward" . gnus-summary-mail-forward))
1943   (define-key gnus-summary-mode-map [menu-bar action followup-with-original]
1944         '("Followup with Original" . gnus-summary-followup-with-original))
1945   (define-key gnus-summary-mode-map [menu-bar action followup]
1946         '("Followup" . gnus-summary-followup))
1947   (define-key gnus-summary-mode-map [menu-bar action reply-with-original]
1948         '("Reply with Original" . gnus-summary-reply-with-original))
1949   (define-key gnus-summary-mode-map [menu-bar action reply]
1950         '("Reply" . gnus-summary-reply))
1951   (define-key gnus-summary-mode-map [menu-bar action post]
1952         '("Post News" . gnus-summary-post-news))
1953
1954   (define-key gnus-summary-mode-map [menu-bar move]
1955         (cons "Move" (make-sparse-keymap "move")))
1956
1957   (define-key gnus-summary-mode-map [menu-bar move isearch-article]
1958         '("Search in Article" . gnus-summary-isearch-article))
1959   (define-key gnus-summary-mode-map [menu-bar move search-through-articles]
1960         '("Search through Articles" . gnus-summary-search-article-forward))
1961   (define-key gnus-summary-mode-map [menu-bar move down-thread]
1962         '("Down Thread" . gnus-summary-down-thread))
1963   (define-key gnus-summary-mode-map [menu-bar move prev-same-subject]
1964         '("Prev Same Subject" . gnus-summary-prev-same-subject))
1965   (define-key gnus-summary-mode-map [menu-bar move prev-group]
1966         '("Prev Group" . gnus-summary-prev-group))
1967   (define-key gnus-summary-mode-map [menu-bar move next-unread-same-subject]
1968         '("Next Unread Same Subject" . gnus-summary-next-unread-same-subject))
1969   (define-key gnus-summary-mode-map [menu-bar move next-unread-article]
1970         '("Next Unread Article" . gnus-summary-next-unread-article))
1971   (define-key gnus-summary-mode-map [menu-bar move next-thread]
1972         '("Next Thread" . gnus-summary-next-thread))
1973   (define-key gnus-summary-mode-map [menu-bar move next-group]
1974         '("Next Group" . gnus-summary-next-group))
1975   (define-key gnus-summary-mode-map [menu-bar move first-unread-article]
1976         '("First Unread Article" . gnus-summary-first-unread-article))
1977   )
1978 \f
1979
1980 (defun gnus-summary-mode ()
1981   "Major mode for reading articles in this newsgroup.
1982 All normal editing commands are turned off.
1983 Instead, these commands are available:
1984
1985 SPC     Scroll to the next page of the current article.  The next unread
1986         article is selected automatically at the end of the message.
1987 DEL     Scroll to the previous page of the current article.
1988 RET     Scroll up (or down) one line the current article.
1989 n       Move to the next unread article.
1990 p       Move to the previous unread article.
1991 N       Move to the next article.
1992 P       Move to the previous article.
1993 ESC C-n Move to the next article which has the same subject as the
1994         current article.
1995 ESC C-p Move to the previous article which has the same subject as the
1996         current article.
1997 \\[gnus-summary-next-unread-same-subject]
1998         Move to the next unread article which has the same subject as the
1999         current article.
2000 \\[gnus-summary-prev-unread-same-subject]
2001         Move to the previous unread article which has the same subject as
2002         the current article.
2003 C-c C-n Scroll to the next digested message of the current article.
2004 C-c C-p Scroll to the previous digested message of the current article.
2005 C-n     Move to the next subject.
2006 C-p     Move to the previous subject.
2007 ESC n   Move to the next unread subject.
2008 ESC p   Move to the previous unread subject.
2009 \\[gnus-summary-next-group]
2010         Exit the current newsgroup and select the next unread newsgroup.
2011 \\[gnus-summary-prev-group]
2012         Exit the current newsgroup and select the previous unread newsgroup.
2013 .       Jump to the first unread article in the current newsgroup.
2014 s       Do an incremental search forward on the current article.
2015 ESC s   Search for an article containing a regexp forward.
2016 ESC r   Search for an article containing a regexp backward.
2017 <       Move point to the beginning of the current article.
2018 >       Move point to the end of the current article.
2019 j       Jump to the article specified by the numeric article ID.
2020 l       Jump to the article you read last.
2021 ^       Refer to parent of the current article.
2022 ESC ^   Refer to the article specified by the Message-ID.
2023 u       Mark the current article as unread, and go forward.
2024 U       Mark the current article as unread, and go backward.
2025 d       Mark the current article as read, and go forward.
2026 D       Mark the current article as read, and go backward.
2027 ESC u   Clear the current article's mark, and go forward.
2028 ESC U   Clear the current article's mark, and go backward.
2029 k       Mark articles which has the same subject as the current article as
2030         read, and then select the next unread article.
2031 C-k     Mark articles which has the same subject as the current article as
2032         read.
2033 ESC k   Edit a local KILL file applied to the current newsgroup.
2034 ESC K   Edit a global KILL file applied to all newsgroups.
2035 ESC C-t Toggle showing conversation threads.
2036 ESC C-s Show thread subtrees.
2037 ESC C-h Hide thread subtrees.
2038 \\[gnus-summary-show-all-threads]       Show all thread subtrees.
2039 \\[gnus-summary-hide-all-threads]       Hide all thread subtrees.
2040 ESC C-f Go to the same level next thread.
2041 ESC C-b Go to the same level previous thread.
2042 ESC C-d Go downward current thread.
2043 ESC C-u Go upward current thread.
2044 ESC C-k Mark articles under current thread as read.
2045 &       Execute a command for each article conditionally.
2046 \\[gnus-summary-catchup]
2047         Mark all articles as read in the current newsgroup, preserving
2048         articles marked as unread.
2049 \\[gnus-summary-catchup-all]
2050         Mark all articles as read in the current newsgroup.
2051 \\[gnus-summary-catchup-and-exit]
2052         Catch up all articles not marked as unread, and then exit the
2053         current newsgroup.
2054 \\[gnus-summary-catchup-all-and-exit]
2055         Catch up all articles, and then exit the current newsgroup.
2056 C-t     Toggle truncations of subject lines.
2057 x       Delete subject lines marked as read.
2058 X       Delete subject lines with the specific marks.
2059 C-c C-s C-n     Sort subjects by article number.
2060 C-c C-s C-a     Sort subjects by article author.
2061 C-c C-s C-s     Sort subjects alphabetically.
2062 C-c C-s C-d     Sort subjects by date.
2063 =       Expand Summary window to show headers full window.
2064 C-x C-s Reselect the current newsgroup. Prefix argument means to select all.
2065 w       Stop page breaking by linefeed.
2066 C-c C-r Caesar rotates letters by 13/47 places.
2067 g       Force to show the current article.
2068 t       Show original article header if pruned header currently shown, or
2069         vice versa.
2070 ESC-t   Toggle MIME processing.
2071 C-d     Run RMAIL on the current digest article.
2072 a       Post a new article.
2073 f       Post a reply article.
2074 F       Post a reply article with original article.
2075 C       Cancel the current article.
2076 r       Mail a message to the author.
2077 R       Mail a message to the author with original author.
2078 C-c C-f Forward the current message to another user.
2079 m       Mail a message in other window.
2080 o       Save the current article in your favorite format.
2081 C-o     Append the current article to a file in Unix mail format.
2082 |       Pipe the contents of the current article to a subprocess.
2083 q       Quit reading news in the current newsgroup.
2084 Q       Quit reading news without recording unread articles information.
2085 V       Show the version number of this GNUS.
2086 ?       Describe Summary mode commands briefly.
2087 C-h m   Describe Summary mode.
2088 C-c C-i Read Info about Summary mode.
2089
2090 User customizable variables:
2091  gnus-large-newsgroup
2092     The number of articles which indicates a large newsgroup. If the
2093     number of articles in a newsgroup is greater than the value, the
2094     number of articles to be selected is asked for. If the given value
2095     N is positive, the last N articles is selected. If N is negative,
2096     the first N articles are selected. An empty string means to select
2097     all articles.
2098
2099  gnus-use-long-file-name
2100     Non-nil means that a newsgroup name is used as a default file name
2101     to save articles to. If it's nil, the directory form of a
2102     newsgroup is used instead.
2103
2104  gnus-default-article-saver
2105     Specifies your favorite article saver which is interactively
2106     funcallable. Following functions are available:
2107
2108         gnus-summary-save-in-rmail (in Rmail format)
2109         gnus-summary-save-in-mail (in Unix mail format)
2110         gnus-summary-save-in-folder (in MH folder)
2111         gnus-summary-save-in-file (in article format).
2112
2113  gnus-rmail-save-name
2114  gnus-mail-save-name
2115  gnus-folder-save-name
2116  gnus-file-save-name
2117     Specifies a function generating a file name to save articles in
2118     specified format.  The function is called with NEWSGROUP, HEADERS,
2119     and optional LAST-FILE.  Access macros to the headers are defined
2120     as nntp-header-FIELD, and functions are defined as
2121     gnus-header-FIELD.
2122
2123  gnus-article-save-directory
2124     Specifies a directory name to save articles to using the commands
2125     gnus-summary-save-in-rmail, gnus-summary-save-in-mail and
2126     gnus-summary-save-in-file. The variable is initialized from the
2127     SAVEDIR environment variable.
2128
2129  gnus-kill-files-directory
2130     Specifies a directory name to save KILL files to using the commands
2131     gnus-edit-global-kill, and gnus-edit-local-kill. The variable is
2132     initialized from the SAVEDIR environment variable.
2133
2134  gnus-show-all-headers
2135     Non-nil means that all headers of an article are shown.
2136
2137  gnus-save-all-headers
2138     Non-nil means that all headers of an article are saved in a file.
2139
2140  gnus-show-mime
2141     Non-nil means that show a MIME message.
2142
2143  gnus-show-threads
2144     Non-nil means that conversation threads are shown in tree structure.
2145
2146  gnus-thread-hide-subject
2147     Non-nil means that subjects for thread subtrees are hidden.
2148
2149  gnus-thread-hide-subtree
2150     Non-nil means that thread subtrees are hidden initially.
2151
2152  gnus-thread-hide-killed
2153     Non-nil means that killed thread subtrees are hidden automatically.
2154
2155  gnus-thread-ignore-subject
2156     Non-nil means that subject differences are ignored in constructing
2157     thread trees.
2158
2159  gnus-thread-indent-level
2160     Indentation of thread subtrees.
2161
2162  gnus-optional-headers
2163     Specifies a function which generates an optional string displayed
2164     in the Summary buffer. The function is called with an article
2165     HEADERS.  The result must be a string excluding `[' and `]'.  The
2166     default function returns a string like NNN:AUTHOR, where NNN is
2167     the number of lines in an article and AUTHOR is the name of the
2168     author.
2169
2170  gnus-auto-extend-newsgroup
2171     Non-nil means visible articles are extended to forward and
2172     backward automatically if possible.
2173
2174  gnus-auto-select-first
2175     Non-nil means the first unread article is selected automagically
2176     when a newsgroup is selected normally (by gnus-group-read-group).
2177     If you'd like to prevent automatic selection of the first unread
2178     article in some newsgroups, set the variable to nil in
2179     gnus-select-group-hook or gnus-apply-kill-hook.
2180
2181  gnus-auto-select-next
2182     Non-nil means the next newsgroup is selected automagically at the
2183     end of the newsgroup. If the value is t and the next newsgroup is
2184     empty (no unread articles), GNUS will exit Summary mode and go
2185     back to Group mode. If the value is neither nil nor t, GNUS won't
2186     exit Summary mode but select the following unread newsgroup.
2187     Especially, if the value is the symbol `quietly', the next unread
2188     newsgroup will be selected without any confirmations.
2189
2190  gnus-auto-select-same
2191     Non-nil means an article with the same subject as the current
2192     article is selected automagically like `rn -S'.
2193
2194  gnus-auto-center-summary
2195     Non-nil means the point of Summary Mode window is always kept
2196     centered.
2197
2198  gnus-break-pages
2199     Non-nil means an article is broken into pages at page delimiters.
2200     This may not work with some versions of GNU Emacs earlier than
2201     version 18.50.
2202
2203  gnus-page-delimiter
2204     Specifies a regexp describing line-beginnings that separate pages
2205     of news article.
2206
2207  [gnus-more-message is obsolete.  overlay-arrow-string interfares
2208     with other subsystems, such as dbx mode.]
2209
2210  gnus-digest-show-summary
2211     Non-nil means that a summary of digest messages is shown when
2212     reading a digest article using `gnus-summary-rmail-digest'
2213     command.
2214
2215  gnus-digest-separator
2216     Specifies a regexp separating messages in a digest article.
2217
2218  gnus-mail-reply-method
2219  gnus-mail-other-window-method
2220     Specifies a function to begin composing mail message using
2221     commands gnus-summary-reply and gnus-summary-mail-other-window.
2222     Functions gnus-mail-reply-using-mail and gnus-mail-reply-using-mhe
2223     are available for the value of gnus-mail-reply-method.  And
2224     functions gnus-mail-other-window-using-mail and
2225     gnus-mail-other-window-using-mhe are available for the value of
2226     gnus-mail-other-window-method.
2227
2228  gnus-mail-send-method
2229     Specifies a function to mail a message too which is being posted
2230     as an article.  The message must have To: or Cc: field.  The value
2231     of the variable send-mail-function is the default function which
2232     uses sendmail mail program.
2233
2234 Various hooks for customization:
2235  gnus-summary-mode-hook
2236     Entry to this mode calls the value with no arguments, if that
2237     value is non-nil.
2238
2239  gnus-select-group-hook
2240     Called with no arguments when newsgroup is selected, if that value
2241     is non-nil. It is possible to sort subjects in this hook. See the
2242     documentation of this variable for more information.
2243
2244  gnus-summary-prepare-hook
2245     Called with no arguments after a summary list is created in the
2246     Summary buffer, if that value is non-nil. If you'd like to modify
2247     the buffer, you can use this hook.
2248
2249  gnus-select-article-hook
2250     Called with no arguments when an article is selected, if that
2251     value is non-nil. See the documentation of this variable for more
2252     information.
2253
2254  gnus-select-digest-hook
2255     Called with no arguments when reading digest messages using Rmail,
2256     if that value is non-nil. This hook can be used to modify an
2257     article so that Rmail can work with it. See the documentation of
2258     the variable for more information.
2259
2260  gnus-rmail-digest-hook
2261     Called with no arguments when reading digest messages using Rmail,
2262     if that value is non-nil. This hook is intended to customize Rmail
2263     mode.
2264
2265  gnus-apply-kill-hook
2266     Called with no arguments when a newsgroup is selected and the
2267     Summary buffer is prepared. This hook is intended to apply a KILL
2268     file to the selected newsgroup. The format of KILL file is
2269     completely different from that of version 3.8. You have to rewrite
2270     them in the new format. See the documentation of Kill file mode
2271     for more information.
2272
2273  gnus-mark-article-hook
2274     Called with no arguments when an article is selected at the first
2275     time. The hook is intended to mark an article as read (or unread)
2276     automatically when it is selected.  See the documentation of the
2277     variable for more information.
2278
2279  gnus-exit-group-hook
2280     Called with no arguments when exiting the current newsgroup, if
2281     that value is non-nil. If your machine is so slow that exiting
2282     from Summary mode takes very long time, inhibit marking articles
2283     as read using cross-references by setting the variable
2284     gnus-use-cross-reference to nil in this hook."
2285   (interactive)
2286   (kill-all-local-variables)
2287   ;; Gee.  Why don't you upgrade?
2288   (cond ((boundp 'mode-line-modified)
2289          (setq mode-line-modified "--- "))
2290         ((listp (default-value 'mode-line-format))
2291          (setq mode-line-format
2292                (cons "--- " (cdr (default-value 'mode-line-format))))))
2293   ;; To disable display-time facility.
2294   ;;(make-local-variable 'global-mode-string)
2295   ;;(setq global-mode-string nil)
2296   (setq major-mode 'gnus-summary-mode)
2297   (setq mode-name "Summary")
2298   ;;(setq mode-line-process '(" " gnus-newsgroup-name))
2299   (make-local-variable 'minor-mode-alist)
2300   (or (assq 'gnus-show-threads minor-mode-alist)
2301       (setq minor-mode-alist
2302             (cons (list 'gnus-show-threads " Thread") minor-mode-alist)))
2303   (gnus-summary-set-mode-line)
2304   (use-local-map gnus-summary-mode-map)
2305   (buffer-flush-undo (current-buffer))
2306   (setq buffer-read-only t)             ;Disable modification
2307   (setq truncate-lines t)               ;Stop line folding
2308   (setq selective-display t)
2309   (setq selective-display-ellipses t)   ;Display `...'
2310   ;;(setq case-fold-search t)
2311   (run-hooks 'gnus-summary-mode-hook))
2312
2313 (defun gnus-mouse-pick-article (e)
2314   (interactive "e")
2315   (mouse-set-point e)
2316   (gnus-summary-next-page nil))
2317
2318 (defun gnus-summary-setup-buffer ()
2319   "Initialize Summary buffer."
2320   (if (get-buffer gnus-summary-buffer)
2321       (set-buffer gnus-summary-buffer)
2322     (set-buffer (get-buffer-create gnus-summary-buffer))
2323     (gnus-summary-mode)
2324     ))
2325
2326 (defun gnus-summary-read-group (group &optional show-all no-article)
2327   "Start reading news in newsgroup GROUP.
2328 If optional 1st argument SHOW-ALL is non-nil, already read articles are
2329 also listed.
2330 If optional 2nd argument NO-ARTICLE is non-nil, no article is selected
2331 initially."
2332   (message "Retrieving newsgroup: %s..." group)
2333   (if (gnus-select-newsgroup group show-all)
2334       (progn
2335         ;; Don't switch-to-buffer to prevent displaying old contents
2336         ;;  of the buffer until new subjects list is created.
2337         ;; Suggested by Juha Heinanen <jh@tut.fi>
2338         (gnus-summary-setup-buffer)
2339         ;; You can change the order of subjects in this hook.
2340         (run-hooks 'gnus-select-group-hook)
2341         (gnus-summary-prepare)
2342         ;; Function `gnus-apply-kill-file' must be called in this hook.
2343         (run-hooks 'gnus-apply-kill-hook)
2344         (if (zerop (buffer-size))
2345             ;; This newsgroup is empty.
2346             (progn
2347               (gnus-summary-catchup-and-exit nil t) ;Without confirmations.
2348               (message "No unread news"))
2349           ;; Hide conversation thread subtrees.  We cannot do this in
2350           ;; gnus-summary-prepare-hook since kill processing may not
2351           ;; work with hidden articles.
2352           (and gnus-show-threads
2353                gnus-thread-hide-subtree
2354                (gnus-summary-hide-all-threads))
2355           ;; Show first unread article if requested.
2356           (goto-char (point-min))
2357           (if (and (not no-article)
2358                    gnus-auto-select-first
2359                    (gnus-summary-first-unread-article))
2360               ;; Window is configured automatically.
2361               ;; Current buffer may be changed as a result of hook
2362               ;; evaluation, especially by gnus-summary-rmail-digest
2363               ;; command, so we should adjust cursor point carefully.
2364               (if (eq (current-buffer) (get-buffer gnus-summary-buffer))
2365                   (progn
2366                     ;; Adjust cursor point.
2367                     (beginning-of-line)
2368                     (search-forward ":" nil t)))
2369             (gnus-configure-windows 'summary)
2370             (pop-to-buffer gnus-summary-buffer)
2371             (gnus-summary-set-mode-line)
2372             ;; I sometime get confused with the old Article buffer.
2373             (if (get-buffer gnus-article-buffer)
2374                 (if (get-buffer-window gnus-article-buffer)
2375                     (save-excursion
2376                       (set-buffer gnus-article-buffer)
2377                       (let ((buffer-read-only nil))
2378                         (erase-buffer)))
2379                   (kill-buffer gnus-article-buffer)))
2380             ;; Adjust cursor point.
2381             (beginning-of-line)
2382             (search-forward ":" nil t))
2383           ))
2384     ;; Cannot select newsgroup GROUP.
2385     (if (gnus-gethash group gnus-active-hashtb)
2386         (progn
2387           ;; If NNTP is used, nntp_access file may not be installed
2388           ;; properly.  Otherwise, may be active file problem.
2389           (ding)
2390           (message
2391            (gnus-nntp-message
2392             (format "Cannot select %s.  May be security or active file problem." group)))
2393           (sit-for 0))
2394       ;; Check bogus newsgroups.
2395       ;; We must be in Group Mode buffer.
2396       (gnus-group-check-bogus-groups))
2397     ))
2398
2399 (defun gnus-summary-prepare ()
2400   "Prepare summary list of current newsgroup in Summary buffer."
2401   (let ((buffer-read-only nil))
2402     ;; Note: The next codes are not actually used because the user who
2403     ;; want it can define them in gnus-select-group-hook.
2404     ;; Print verbose messages if too many articles are selected.
2405     ;;    (and (numberp gnus-large-newsgroup)
2406     ;;       (> (length gnus-newsgroup-headers) gnus-large-newsgroup)
2407     ;;       (message "Preparing headers..."))
2408     (erase-buffer)
2409     (gnus-summary-prepare-threads
2410      (if gnus-show-threads
2411          (gnus-make-threads gnus-newsgroup-headers)
2412        gnus-newsgroup-headers) 0)
2413     ;; Erase header retrieval message.
2414     (message "")
2415     ;; Call hooks for modifying Summary buffer.
2416     ;; Suggested by sven@tde.LTH.Se (Sven Mattisson).
2417     (goto-char (point-min))
2418     (run-hooks 'gnus-summary-prepare-hook)
2419     ))
2420
2421 ;; Basic ideas by Paul Dworkin <paul@media-lab.media.mit.edu>
2422 ;; Subject bug fix by jbw@bigbird.bu.edu (Joe Wells)
2423
2424 (defun gnus-summary-prepare-threads (threads level &optional parent-subject)
2425   "Prepare Summary buffer from THREADS and indentation LEVEL.
2426 THREADS is a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...]).'
2427 Optional PARENT-SUBJECT specifies the subject of the parent."
2428   (let ((thread nil)
2429         (header nil)
2430         (number nil)
2431         (subject nil)
2432         (child-subject nil)
2433         (parent-subject (or parent-subject ""))
2434         ;; `M Indent NUM: [OPT] SUBJECT'
2435         (cntl (format "%%s %%s%%%dd: [%%s] %%s\n"
2436                       (length (prin1-to-string gnus-newsgroup-end)))))
2437     (while threads
2438       (setq thread (car threads))
2439       (setq threads (cdr threads))
2440       ;; If thread is a cons, hierarchical threads is given.
2441       ;; Otherwise, thread itself is header.
2442       (if (consp thread)
2443           (setq header (car thread))
2444         (setq header thread))
2445       ;; Print valid header only.
2446       (if (vectorp header)              ;Depends on nntp.el.
2447           (progn
2448             (setq number (nntp-header-number header))
2449             (setq subject (nntp-header-subject header))
2450             (setq child-subject (gnus-simplify-subject subject 're-only))
2451             (insert
2452              (format cntl
2453                      ;; Read or not.
2454                      (cond ((memq number gnus-newsgroup-marked)  "-")
2455                            ((memq number gnus-newsgroup-unreads) " ")
2456                            (t "D"))
2457                      ;; Thread level.
2458                      (make-string (* level gnus-thread-indent-level) ? )
2459                      ;; Article number.
2460                      number
2461                      ;; Optional headers.
2462                      (or (and gnus-optional-headers
2463                               (funcall gnus-optional-headers header)) "")
2464                      ;; Its subject string.
2465                      (concat (if (or (zerop level)
2466                                      (not gnus-thread-hide-subject)
2467                                      ;; Subject is different from the parent.
2468                                      (not (string-equal
2469                                            parent-subject child-subject)))
2470                                  nil
2471                                (make-string (window-width) ? ))
2472                              subject)
2473                      ))
2474             ))
2475       ;; Print subthreads.
2476       (and (consp thread)
2477            (cdr thread)
2478            (gnus-summary-prepare-threads
2479             (cdr thread) (1+ level) child-subject))
2480       )))
2481
2482 ;;(defun gnus-summary-set-mode-line ()
2483 ;;  "Set Summary mode line string."
2484 ;;  ;; The value must be a string to escape %-constructs.
2485 ;;  (let ((subject
2486 ;;       (if gnus-current-headers
2487 ;;           (nntp-header-subject gnus-current-headers) gnus-newsgroup-name)))
2488 ;;    (setq mode-line-buffer-identification
2489 ;;        (concat "GNUS: "
2490 ;;                subject
2491 ;;                ;; Enough spaces to pad subject to 17 positions.
2492 ;;                (make-string (max 0 (- 17 (length subject))) ? ))))
2493 ;;  (set-buffer-modified-p t))
2494
2495 ;; New implementation in gnus 3.14.3
2496
2497 (defun gnus-summary-set-mode-line ()
2498   "Set Summary mode line string.
2499 If you don't like it, define your own gnus-summary-set-mode-line."
2500   (let ((unmarked
2501          (- (length gnus-newsgroup-unreads)
2502             (length (gnus-intersection
2503                      gnus-newsgroup-unreads gnus-newsgroup-marked))))
2504         (unselected
2505          (- (length gnus-newsgroup-unselected)
2506             (length (gnus-intersection
2507                      gnus-newsgroup-unselected gnus-newsgroup-marked)))))
2508     (setq mode-line-buffer-identification
2509           (list 17
2510                 (format "GNUS: %s%s %s"
2511                         gnus-newsgroup-name
2512                         (if gnus-current-article
2513                             (format "/%d" gnus-current-article) "")
2514                         ;; Basic ideas by tale@pawl.rpi.edu.
2515                         (cond ((and (zerop unmarked)
2516                                     (zerop unselected))
2517                                "")
2518                               ((zerop unselected)
2519                                (format "{%d more}" unmarked))
2520                               (t
2521                                (format "{%d(+%d) more}" unmarked unselected)))
2522                         ))))
2523   (set-buffer-modified-p t))
2524
2525 ;; GNUS Summary mode command.
2526
2527 (defun gnus-summary-search-group (&optional backward)
2528   "Search for next unread newsgroup.
2529 If optional argument BACKWARD is non-nil, search backward instead."
2530   (save-excursion
2531     (set-buffer gnus-group-buffer)
2532     (save-excursion
2533       ;; We don't want to alter current point of Group mode buffer.
2534       (if (gnus-group-search-forward backward nil)
2535           (gnus-group-group-name))
2536       )))
2537
2538 (defun gnus-summary-search-subject (backward unread subject)
2539   "Search for article forward.
2540 If 1st argument BACKWARD is non-nil, search backward.
2541 If 2nd argument UNREAD is non-nil, only unread article is selected.
2542 If 3rd argument SUBJECT is non-nil, the article which has
2543 the same subject will be searched for."
2544   (let ((func
2545          (if backward
2546              (function re-search-backward) (function re-search-forward)))
2547         (article nil)
2548         ;; We have to take care of hidden lines.
2549         (regexp
2550          (format "^%s[ \t]+\\([0-9]+\\):.\\[[^]\r\n]*\\][ \t]+%s"
2551                  ;;(if unread " " ".")
2552                  (cond ((eq unread t) " ") (unread "[- ]") (t "."))
2553                  (if subject
2554                      (concat "\\([Rr][Ee]:[ \t]+\\)*"
2555                              (regexp-quote (gnus-simplify-subject subject))
2556                              ;; Ignore words in parentheses.
2557                              "\\([ \t]*([^\r\n]*)\\)*[ \t]*\\(\r\\|$\\)")
2558                    "")
2559                  )))
2560     (if backward
2561         (beginning-of-line)
2562       (end-of-line))
2563     (if (funcall func regexp nil t)
2564         (setq article
2565               (string-to-int
2566                (buffer-substring (match-beginning 1) (match-end 1)))))
2567     ;; Adjust cursor point.
2568     (beginning-of-line)
2569     (search-forward ":" nil t)
2570     ;; This is the result.
2571     article
2572     ))
2573
2574 (defun gnus-summary-search-forward (&optional unread subject)
2575   "Search for article forward.
2576 If 1st optional argument UNREAD is non-nil, only unread article is selected.
2577 If 2nd optional argument SUBJECT is non-nil, the article which has
2578 the same subject will be searched for."
2579   (gnus-summary-search-subject nil unread subject))
2580
2581 (defun gnus-summary-search-backward (&optional unread subject)
2582   "Search for article backward.
2583 If 1st optional argument UNREAD is non-nil, only unread article is selected.
2584 If 2nd optional argument SUBJECT is non-nil, the article which has
2585 the same subject will be searched for."
2586   (gnus-summary-search-subject t unread subject))
2587
2588 (defun gnus-summary-article-number ()
2589   "Article number around point. If nothing, return current number."
2590   (save-excursion
2591     (beginning-of-line)
2592     (if (looking-at ".[ \t]+\\([0-9]+\\):")
2593         (string-to-int
2594          (buffer-substring (match-beginning 1) (match-end 1)))
2595       ;; If search fail, return current article number.
2596       gnus-current-article
2597       )))
2598
2599 (defun gnus-summary-subject-string ()
2600   "Return current subject string or nil if nothing."
2601   (save-excursion
2602     ;; It is possible to implement this function using
2603     ;;  `gnus-summary-article-number' and `gnus-newsgroup-headers'.
2604     (beginning-of-line)
2605     ;; We have to take care of hidden lines.
2606     (if (looking-at ".[ \t]+[0-9]+:.\\[[^]\r\n]*\\][ \t]+\\([^\r\n]*\\)[\r\n]")
2607         (buffer-substring (match-beginning 1) (match-end 1)))
2608     ))
2609
2610 (defun gnus-summary-goto-subject (article)
2611   "Move point to ARTICLE's subject."
2612   (interactive
2613    (list
2614     (string-to-int
2615      (completing-read "Article number: "
2616                       (mapcar
2617                        (function
2618                         (lambda (headers)
2619                           (list
2620                            (int-to-string (nntp-header-number headers)))))
2621                        gnus-newsgroup-headers)
2622                       nil 'require-match))))
2623   (let ((current (point)))
2624     (goto-char (point-min))
2625     (or (and article (re-search-forward (format "^.[ \t]+%d:" article) nil t))
2626         (progn (goto-char current) nil))
2627     ))
2628
2629 (defun gnus-summary-recenter ()
2630   "Center point in Summary window."
2631   ;; Scroll window so as to cursor comes center of Summary window
2632   ;;  only when article is displayed.
2633   ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
2634   ;; Recenter only when requested.
2635   ;; Subbested by popovich@park.cs.columbia.edu
2636   (and gnus-auto-center-summary
2637        (get-buffer-window gnus-article-buffer)
2638        (< (/ (- (window-height) 1) 2)
2639           (count-lines (point) (point-max)))
2640        (recenter (/ (- (window-height) 2) 2))))
2641
2642 ;; Walking around Group mode buffer.
2643
2644 (defun gnus-summary-jump-to-group (newsgroup)
2645   "Move point to NEWSGROUP in Group mode buffer."
2646   ;; Keep update point of Group mode buffer if visible.
2647   (if (eq (current-buffer)
2648           (get-buffer gnus-group-buffer))
2649       (save-window-excursion
2650         ;; Take care of tree window mode.
2651         (if (get-buffer-window gnus-group-buffer)
2652             (pop-to-buffer gnus-group-buffer))
2653         (gnus-group-jump-to-group newsgroup))
2654     (save-excursion
2655       ;; Take care of tree window mode.
2656       (if (get-buffer-window gnus-group-buffer)
2657           (pop-to-buffer gnus-group-buffer)
2658         (set-buffer gnus-group-buffer))
2659       (gnus-group-jump-to-group newsgroup))))
2660
2661 (defun gnus-summary-next-group (no-article)
2662   "Exit current newsgroup and then select next unread newsgroup.
2663 If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
2664   (interactive "P")
2665   ;; Make sure Group mode buffer point is on current newsgroup.
2666   (gnus-summary-jump-to-group gnus-newsgroup-name)
2667   (let ((group (gnus-summary-search-group)))
2668     (if (null group)
2669         (progn
2670           (message "Exiting %s..." gnus-newsgroup-name)
2671           (gnus-summary-exit)
2672           (message ""))
2673       (message "Selecting %s..." group)
2674       (gnus-summary-exit t)             ;Exit Summary mode temporary.
2675       ;; We are now in Group mode buffer.
2676       ;; Make sure Group mode buffer point is on GROUP.
2677       (gnus-summary-jump-to-group group)
2678       (gnus-summary-read-group group nil no-article)
2679       (or (eq (current-buffer)
2680               (get-buffer gnus-summary-buffer))
2681           (eq gnus-auto-select-next t)
2682           ;; Expected newsgroup has nothing to read since the articles
2683           ;; are marked as read by cross-referencing. So, try next
2684           ;; newsgroup. (Make sure we are in Group mode buffer now.)
2685           (and (eq (current-buffer)
2686                    (get-buffer gnus-group-buffer))
2687                (gnus-group-group-name)
2688                (gnus-summary-read-group
2689                 (gnus-group-group-name) nil no-article))
2690           )
2691       )))
2692
2693 (defun gnus-summary-prev-group (no-article)
2694   "Exit current newsgroup and then select previous unread newsgroup.
2695 If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
2696   (interactive "P")
2697   ;; Make sure Group mode buffer point is on current newsgroup.
2698   (gnus-summary-jump-to-group gnus-newsgroup-name)
2699   (let ((group (gnus-summary-search-group t)))
2700     (if (null group)
2701         (progn
2702           (message "Exiting %s..." gnus-newsgroup-name)
2703           (gnus-summary-exit)
2704           (message ""))
2705       (message "Selecting %s..." group)
2706       (gnus-summary-exit t)             ;Exit Summary mode temporary.
2707       ;; We are now in Group mode buffer.
2708       ;; We have to adjust point of Group mode buffer because current
2709       ;; point is moved to next unread newsgroup by exiting.
2710       (gnus-summary-jump-to-group group)
2711       (gnus-summary-read-group group nil no-article)
2712       (or (eq (current-buffer)
2713               (get-buffer gnus-summary-buffer))
2714           (eq gnus-auto-select-next t)
2715           ;; Expected newsgroup has nothing to read since the articles
2716           ;; are marked as read by cross-referencing. So, try next
2717           ;; newsgroup. (Make sure we are in Group mode buffer now.)
2718           (and (eq (current-buffer)
2719                    (get-buffer gnus-group-buffer))
2720                (gnus-summary-search-group t)
2721                (gnus-summary-read-group
2722                 (gnus-summary-search-group t) nil no-article))
2723           )
2724       )))
2725
2726 ;; Walking around summary lines.
2727
2728 (defun gnus-summary-next-subject (n &optional unread)
2729   "Go to next N'th summary line.
2730 If optional argument UNREAD is non-nil, only unread article is selected."
2731   (interactive "p")
2732   (while (and (> n 1)
2733               (gnus-summary-search-forward unread))
2734     (setq n (1- n)))
2735   (cond ((gnus-summary-search-forward unread)
2736          (gnus-summary-recenter))
2737         (unread
2738          (message "No more unread articles"))
2739         (t
2740          (message "No more articles"))
2741         ))
2742
2743 (defun gnus-summary-next-unread-subject (n)
2744   "Go to next N'th unread summary line."
2745   (interactive "p")
2746   (gnus-summary-next-subject n t))
2747
2748 (defun gnus-summary-prev-subject (n &optional unread)
2749   "Go to previous N'th summary line.
2750 If optional argument UNREAD is non-nil, only unread article is selected."
2751   (interactive "p")
2752   (while (and (> n 1)
2753               (gnus-summary-search-backward unread))
2754     (setq n (1- n)))
2755   (cond ((gnus-summary-search-backward unread)
2756          (gnus-summary-recenter))
2757         (unread
2758          (message "No more unread articles"))
2759         (t
2760          (message "No more articles"))
2761         ))
2762
2763 (defun gnus-summary-prev-unread-subject (n)
2764   "Go to previous N'th unread summary line."
2765   (interactive "p")
2766   (gnus-summary-prev-subject n t))
2767
2768 ;; Walking around summary lines with displaying articles.
2769
2770 (defun gnus-summary-expand-window ()
2771   "Expand Summary window to show headers full window."
2772   (interactive)
2773   (gnus-configure-windows 'summary)
2774   (pop-to-buffer gnus-summary-buffer))
2775
2776 (defun gnus-summary-display-article (article &optional all-header)
2777   "Display ARTICLE in Article buffer."
2778   (if (null article)
2779       nil
2780     (gnus-configure-windows 'article)
2781     (pop-to-buffer gnus-summary-buffer)
2782     (gnus-article-prepare article all-header)
2783     (gnus-summary-recenter)
2784     (gnus-summary-set-mode-line)
2785     (run-hooks 'gnus-select-article-hook)
2786     ;; Successfully display article.
2787     t
2788     ))
2789
2790 (defun gnus-summary-select-article (&optional all-headers force)
2791   "Select the current article.
2792 Optional first argument ALL-HEADERS is non-nil, show all header fields.
2793 Optional second argument FORCE is nil, the article is only selected
2794 again when current header does not match with ALL-HEADERS option."
2795   (let ((article (gnus-summary-article-number))
2796         (all-headers (not (not all-headers)))) ;Must be T or NIL.
2797     (if (or (null gnus-current-article)
2798             (/= article gnus-current-article)
2799             (and force (not (eq all-headers gnus-have-all-headers))))
2800         ;; The selected one is different from that of the current article.
2801         (gnus-summary-display-article article all-headers)
2802       (gnus-configure-windows 'article)
2803       (pop-to-buffer gnus-summary-buffer))
2804     ))
2805
2806 (defun gnus-summary-set-current-mark (&optional current-mark)
2807   "Put `+' at the current article.
2808 Optional argument specifies CURRENT-MARK instead of `+'."
2809   (save-excursion
2810     (set-buffer gnus-summary-buffer)
2811     (let ((buffer-read-only nil))
2812       (goto-char (point-min))
2813       ;; First of all clear mark at last article.
2814       (if (re-search-forward "^.[ \t]+[0-9]+:[^ \t]" nil t)
2815           (progn
2816             (delete-char -1)
2817             (insert " ")
2818             (goto-char (point-min))))
2819       (if (re-search-forward (format "^.[ \t]+%d:" gnus-current-article) nil t)
2820           (progn
2821             (delete-char 1)
2822             (insert (or current-mark "+"))))
2823       )))
2824
2825 ;;(defun gnus-summary-next-article (unread &optional subject)
2826 ;;  "Select article after current one.
2827 ;;If argument UNREAD is non-nil, only unread article is selected."
2828 ;;  (interactive "P")
2829 ;;  (cond ((gnus-summary-display-article
2830 ;;        (gnus-summary-search-forward unread subject)))
2831 ;;      (unread
2832 ;;       (message "No more unread articles"))
2833 ;;      (t
2834 ;;       (message "No more articles"))
2835 ;;      ))
2836
2837 (defun gnus-summary-next-article (unread &optional subject)
2838   "Select article after current one.
2839 If argument UNREAD is non-nil, only unread article is selected."
2840   (interactive "P")
2841   (let ((header nil))
2842     (cond ((gnus-summary-display-article
2843             (gnus-summary-search-forward unread subject)))
2844           ((and subject
2845                 gnus-auto-select-same
2846                 (gnus-set-difference gnus-newsgroup-unreads
2847                                      gnus-newsgroup-marked)
2848                 (memq this-command
2849                       '(gnus-summary-next-unread-article
2850                         gnus-summary-next-page
2851                         gnus-summary-kill-same-subject-and-select
2852                         ;;gnus-summary-next-article
2853                         ;;gnus-summary-next-same-subject
2854                         ;;gnus-summary-next-unread-same-subject
2855                         )))
2856            ;; Wrap article pointer if there are unread articles.
2857            ;; Hook function, such as gnus-summary-rmail-digest, may
2858            ;; change current buffer, so need check.
2859            (let ((buffer (current-buffer))
2860                  (last-point (point)))
2861              ;; No more articles with same subject, so jump to the first
2862              ;; unread article.
2863              (gnus-summary-first-unread-article)
2864              ;;(and (eq buffer (current-buffer))
2865              ;; (= (point) last-point)
2866              ;; ;; Ignore given SUBJECT, and try again.
2867              ;; (gnus-summary-next-article unread nil))
2868              (and (eq buffer (current-buffer))
2869                   (< (point) last-point)
2870                   (message "Wrapped"))
2871              ))
2872           ((and gnus-auto-extend-newsgroup
2873                 (not unread)            ;Not unread only
2874                 (not subject)           ;Only if subject is not specified.
2875                 (setq header (gnus-more-header-forward)))
2876            ;; Extend to next article if possible.
2877            ;; Basic ideas by himacdonald@watdragon.waterloo.edu
2878            (gnus-extend-newsgroup header nil)
2879            ;; Threads feature must be turned off.
2880            (let ((buffer-read-only nil))
2881              (goto-char (point-max))
2882              (gnus-summary-prepare-threads (list header) 0))
2883            (gnus-summary-goto-article gnus-newsgroup-end))
2884           (t
2885            ;; Select next newsgroup automatically if requested.
2886            (let ((cmd (aref (this-command-keys) 0))
2887                  (group (gnus-summary-search-group))
2888                  (auto-select
2889                   (and gnus-auto-select-next
2890                        ;;(null (gnus-set-difference gnus-newsgroup-unreads
2891                        ;;                               gnus-newsgroup-marked))
2892                        (memq this-command
2893                              '(gnus-summary-next-unread-article
2894                                gnus-summary-next-article
2895                                gnus-summary-next-page
2896                                gnus-summary-next-same-subject
2897                                gnus-summary-next-unread-same-subject
2898                                gnus-summary-kill-same-subject
2899                                gnus-summary-kill-same-subject-and-select
2900                                ))
2901                        ;; Ignore characters typed ahead.
2902                        (not (input-pending-p))
2903                        )))
2904              ;; Keep just the event type of CMD.
2905              (if (listp cmd)
2906                  (setq cmd (car cmd)))
2907              (message "No more%s articles%s"
2908                       (if unread " unread" "")
2909                       (if (and auto-select
2910                                (not (eq gnus-auto-select-next 'quietly)))
2911                           (if group
2912                               (format " (Type %s for %s [%d])"
2913                                       (single-key-description cmd)
2914                                       group
2915                                       (nth 1 (gnus-gethash group
2916                                                            gnus-unread-hashtb)))
2917                             (format " (Type %s to exit %s)"
2918                                     (single-key-description cmd)
2919                                     gnus-newsgroup-name))
2920                         ""))
2921              ;; Select next unread newsgroup automagically.
2922              (cond ((and auto-select
2923                          (eq gnus-auto-select-next 'quietly))
2924                     ;; Select quietly.
2925                     (gnus-summary-next-group nil))
2926                    (auto-select
2927                     ;; Confirm auto selection.
2928                     (let* ((event (read-event))
2929                            (type
2930                             (if (listp event)
2931                                 (car event)
2932                               event)))
2933                       (if (and (eq event type) (eq event cmd))
2934                           (gnus-summary-next-group nil)
2935                         (setq unread-command-events (list event)))))
2936                    )
2937              ))
2938           )))
2939
2940 (defun gnus-summary-next-unread-article ()
2941   "Select unread article after current one."
2942   (interactive)
2943   (gnus-summary-next-article t (and gnus-auto-select-same
2944                                     (gnus-summary-subject-string))))
2945
2946 (defun gnus-summary-prev-article (unread &optional subject)
2947   "Select article before current one.
2948 If argument UNREAD is non-nil, only unread article is selected."
2949   (interactive "P")
2950   (let ((header nil))
2951     (cond ((gnus-summary-display-article
2952             (gnus-summary-search-backward unread subject)))
2953           ((and subject
2954                 gnus-auto-select-same
2955                 (gnus-set-difference gnus-newsgroup-unreads
2956                                      gnus-newsgroup-marked)
2957                 (memq this-command
2958                       '(gnus-summary-prev-unread-article
2959                         ;;gnus-summary-prev-page
2960                         ;;gnus-summary-prev-article
2961                         ;;gnus-summary-prev-same-subject
2962                         ;;gnus-summary-prev-unread-same-subject
2963                         )))
2964            ;; Ignore given SUBJECT, and try again.
2965            (gnus-summary-prev-article unread nil))
2966           (unread
2967            (message "No more unread articles"))
2968           ((and gnus-auto-extend-newsgroup
2969                 (not subject)           ;Only if subject is not specified.
2970                 (setq header (gnus-more-header-backward)))
2971            ;; Extend to previous article if possible.
2972            ;; Basic ideas by himacdonald@watdragon.waterloo.edu
2973            (gnus-extend-newsgroup header t)
2974            (let ((buffer-read-only nil))
2975              (goto-char (point-min))
2976              (gnus-summary-prepare-threads (list header) 0))
2977            (gnus-summary-goto-article gnus-newsgroup-begin))
2978           (t
2979            (message "No more articles"))
2980           )))
2981
2982 (defun gnus-summary-prev-unread-article ()
2983   "Select unred article before current one."
2984   (interactive)
2985   (gnus-summary-prev-article t (and gnus-auto-select-same
2986                                     (gnus-summary-subject-string))))
2987
2988 (defun gnus-summary-next-page (lines)
2989   "Show next page of selected article.
2990 If end of article, select next article.
2991 Argument LINES specifies lines to be scrolled up."
2992   (interactive "P")
2993   (let ((article (gnus-summary-article-number))
2994         (endp nil))
2995     (if (or (null gnus-current-article)
2996             (/= article gnus-current-article))
2997         ;; Selected subject is different from current article's.
2998         (gnus-summary-display-article article)
2999       (gnus-configure-windows 'article)
3000       (pop-to-buffer gnus-summary-buffer)
3001       (gnus-eval-in-buffer-window gnus-article-buffer
3002         (setq endp (gnus-article-next-page lines)))
3003       (cond ((and endp lines)
3004              (message "End of message"))
3005             ((and endp (null lines))
3006              (gnus-summary-next-unread-article)))
3007       )))
3008
3009 (defun gnus-summary-prev-page (lines)
3010   "Show previous page of selected article.
3011 Argument LINES specifies lines to be scrolled down."
3012   (interactive "P")
3013   (let ((article (gnus-summary-article-number)))
3014     (if (or (null gnus-current-article)
3015             (/= article gnus-current-article))
3016         ;; Selected subject is different from current article's.
3017         (gnus-summary-display-article article)
3018       (gnus-configure-windows 'article)
3019       (pop-to-buffer gnus-summary-buffer)
3020       (gnus-eval-in-buffer-window gnus-article-buffer
3021         (gnus-article-prev-page lines))
3022       )))
3023
3024 (defun gnus-summary-scroll-up (lines)
3025   "Scroll up (or down) one line current article.
3026 Argument LINES specifies lines to be scrolled up (or down if negative)."
3027   (interactive "p")
3028   (gnus-summary-select-article)
3029   (gnus-eval-in-buffer-window gnus-article-buffer
3030     (cond ((> lines 0)
3031            (if (gnus-article-next-page lines)
3032                (message "End of message")))
3033           ((< lines 0)
3034            (gnus-article-prev-page (- 0 lines))))
3035     ))
3036
3037 (defun gnus-summary-next-same-subject ()
3038   "Select next article which has the same subject as current one."
3039   (interactive)
3040   (gnus-summary-next-article nil (gnus-summary-subject-string)))
3041
3042 (defun gnus-summary-prev-same-subject ()
3043   "Select previous article which has the same subject as current one."
3044   (interactive)
3045   (gnus-summary-prev-article nil (gnus-summary-subject-string)))
3046
3047 (defun gnus-summary-next-unread-same-subject ()
3048   "Select next unread article which has the same subject as current one."
3049   (interactive)
3050   (gnus-summary-next-article t (gnus-summary-subject-string)))
3051
3052 (defun gnus-summary-prev-unread-same-subject ()
3053   "Select previous unread article which has the same subject as current one."
3054   (interactive)
3055   (gnus-summary-prev-article t (gnus-summary-subject-string)))
3056
3057 (defun gnus-summary-refer-parent-article (child)
3058   "Refer parent article of current article.
3059 If a prefix argument CHILD is non-nil, go back to the child article
3060 using internally maintained articles history.
3061 NOTE: This command may not work with nnspool.el."
3062   (interactive "P")
3063   (gnus-summary-select-article t t)     ;Request all headers.
3064   (let ((referenced-id nil))            ;Message-id of parent or child article.
3065     (if child
3066         ;; Go back to child article using history.
3067         (gnus-summary-refer-article nil)
3068       (gnus-eval-in-buffer-window gnus-article-buffer
3069         ;; Look for parent Message-ID.
3070         ;; We cannot use gnus-current-headers to get references
3071         ;; because we may be looking at parent or referred article.
3072         (let ((references (gnus-fetch-field "References")))
3073           ;; Get the last message-id in the references.
3074           (and references
3075                (string-match "\\(<[^<>]+>\\)[^>]*\\'" references)
3076                (setq referenced-id
3077                      (substring references
3078                                 (match-beginning 1) (match-end 1))))
3079           ))
3080       (if (stringp referenced-id)
3081           (gnus-summary-refer-article referenced-id)
3082         (error "No more parents"))
3083       )))
3084
3085 (defun gnus-summary-refer-article (message-id)
3086   "Refer article specified by MESSAGE-ID.
3087 If the MESSAGE-ID is nil or an empty string, Message-ID is poped from
3088 internally maintained articles history.
3089 NOTE: This command may not work with nnspool.el nor mhspool.el."
3090   (interactive "sMessage-ID: ")
3091   ;; Make sure that this command depends on the fact that article
3092   ;; related information is not updated when an article is retrieved
3093   ;; by Message-ID.
3094   (gnus-summary-select-article t t)     ;Request all headers.
3095   (if (and (stringp message-id)
3096            (> (length message-id) 0))
3097       (gnus-eval-in-buffer-window gnus-article-buffer
3098         ;; Construct the correct Message-ID if necessary.
3099         ;; Suggested by tale@pawl.rpi.edu.
3100         (or (string-match "^<" message-id)
3101             (setq message-id (concat "<" message-id)))
3102         (or (string-match ">$" message-id)
3103             (setq message-id (concat message-id ">")))
3104         ;; Push current message-id on history.
3105         ;; We cannot use gnus-current-headers to get current
3106         ;; message-id because we may be looking at parent or referred
3107         ;; article.
3108         (let ((current (gnus-fetch-field "Message-ID")))
3109           (or (equal current message-id) ;Nothing to do.
3110               (equal current (car gnus-current-history))
3111               (setq gnus-current-history
3112                     (cons current gnus-current-history)))
3113           ))
3114     ;; Pop message-id from history.
3115     (setq message-id (car gnus-current-history))
3116     (setq gnus-current-history (cdr gnus-current-history)))
3117   (if (stringp message-id)
3118       ;; Retrieve article by message-id.  This may not work with
3119       ;; nnspool nor mhspool.
3120       (gnus-article-prepare message-id t)
3121     (error "No such references"))
3122   )
3123
3124 (defun gnus-summary-next-digest (nth)
3125   "Move to head of NTH next digested message."
3126   (interactive "p")
3127   (gnus-summary-select-article)
3128   (gnus-eval-in-buffer-window gnus-article-buffer
3129     (gnus-article-next-digest (or nth 1))
3130     ))
3131
3132 (defun gnus-summary-prev-digest (nth)
3133   "Move to head of NTH previous digested message."
3134   (interactive "p")
3135   (gnus-summary-select-article)
3136   (gnus-eval-in-buffer-window gnus-article-buffer
3137     (gnus-article-prev-digest (or nth 1))
3138     ))
3139
3140 (defun gnus-summary-first-unread-article ()
3141   "Select first unread article. Return non-nil if successfully selected."
3142   (interactive)
3143   (let ((begin (point)))
3144     (goto-char (point-min))
3145     (if (re-search-forward "^ [ \t]+[0-9]+:" nil t)
3146         (gnus-summary-display-article (gnus-summary-article-number))
3147       ;; If there is no unread articles, stay there.
3148       (goto-char begin)
3149       ;;(gnus-summary-display-article (gnus-summary-article-number))
3150       (message "No more unread articles")
3151       nil
3152       )
3153     ))
3154
3155 (defun gnus-summary-isearch-article ()
3156   "Do incremental search forward on current article."
3157   (interactive)
3158   (gnus-summary-select-article)
3159   (gnus-eval-in-buffer-window gnus-article-buffer
3160                               (isearch-forward)))
3161
3162 (defun gnus-summary-search-article-forward (regexp)
3163   "Search for an article containing REGEXP forward.
3164 gnus-select-article-hook is not called during the search."
3165   (interactive
3166    (list (read-string
3167           (concat "Search forward (regexp): "
3168                   (if gnus-last-search-regexp
3169                       (concat "(default " gnus-last-search-regexp ") "))))))
3170   (if (string-equal regexp "")
3171       (setq regexp (or gnus-last-search-regexp ""))
3172     (setq gnus-last-search-regexp regexp))
3173   (if (gnus-summary-search-article regexp nil)
3174       (gnus-eval-in-buffer-window gnus-article-buffer
3175         (recenter 0)
3176         ;;(sit-for 1)
3177         )
3178     (error "Search failed: \"%s\"" regexp)
3179     ))
3180
3181 (defun gnus-summary-search-article-backward (regexp)
3182   "Search for an article containing REGEXP backward.
3183 gnus-select-article-hook is not called during the search."
3184   (interactive
3185    (list (read-string
3186           (concat "Search backward (regexp): "
3187                   (if gnus-last-search-regexp
3188                       (concat "(default " gnus-last-search-regexp ") "))))))
3189   (if (string-equal regexp "")
3190       (setq regexp (or gnus-last-search-regexp ""))
3191     (setq gnus-last-search-regexp regexp))
3192   (if (gnus-summary-search-article regexp t)
3193       (gnus-eval-in-buffer-window gnus-article-buffer
3194         (recenter 0)
3195         ;;(sit-for 1)
3196         )
3197     (error "Search failed: \"%s\"" regexp)
3198     ))
3199
3200 (defun gnus-summary-search-article (regexp &optional backward)
3201   "Search for an article containing REGEXP.
3202 Optional argument BACKWARD means do search for backward.
3203 gnus-select-article-hook is not called during the search."
3204   (let ((gnus-select-article-hook nil)  ;Disable hook.
3205         (gnus-mark-article-hook nil)    ;Inhibit marking as read.
3206         (re-search
3207          (if backward
3208              (function re-search-backward) (function re-search-forward)))
3209         (found nil)
3210         (last nil))
3211     ;; Hidden thread subtrees must be searched for ,too.
3212     (gnus-summary-show-all-threads)
3213     ;; First of all, search current article.
3214     ;; We don't want to read article again from NNTP server nor reset
3215     ;; current point.
3216     (gnus-summary-select-article)
3217     (message "Searching article: %d..." gnus-current-article)
3218     (setq last gnus-current-article)
3219     (gnus-eval-in-buffer-window gnus-article-buffer
3220       (save-restriction
3221         (widen)
3222         ;; Begin search from current point.
3223         (setq found (funcall re-search regexp nil t))))
3224     ;; Then search next articles.
3225     (while (and (not found)
3226                 (gnus-summary-display-article
3227                  (gnus-summary-search-subject backward nil nil)))
3228       (message "Searching article: %d..." gnus-current-article)
3229       (gnus-eval-in-buffer-window gnus-article-buffer
3230         (save-restriction
3231           (widen)
3232           (goto-char (if backward (point-max) (point-min)))
3233           (setq found (funcall re-search regexp nil t)))
3234         ))
3235     (message "")
3236     ;; Adjust article pointer.
3237     (or (eq last gnus-current-article)
3238         (setq gnus-last-article last))
3239     ;; Return T if found such article.
3240     found
3241     ))
3242
3243 (defun gnus-summary-execute-command (field regexp command &optional backward)
3244   "If FIELD of article header matches REGEXP, execute a COMMAND string.
3245 If FIELD is an empty string (or nil), entire article body is searched for.
3246 If optional (prefix) argument BACKWARD is non-nil, do backward instead."
3247   (interactive
3248    (list (let ((completion-ignore-case t))
3249            (completing-read "Field name: "
3250                             '(("Number")("Subject")("From")
3251                               ("Lines")("Date")("Id")
3252                               ("Xref")("References"))
3253                             nil 'require-match))
3254          (read-string "Regexp: ")
3255          (read-key-sequence "Command: ")
3256          current-prefix-arg))
3257   ;; Hidden thread subtrees must be searched for ,too.
3258   (gnus-summary-show-all-threads)
3259   ;; We don't want to change current point nor window configuration.
3260   (save-excursion
3261     (save-window-excursion
3262       (message "Executing %s..." (key-description command))
3263       ;; We'd like to execute COMMAND interactively so as to give arguments.
3264       (gnus-execute field regexp
3265                     (` (lambda ()
3266                          (call-interactively '(, (key-binding command)))))
3267                     backward)
3268       (message "Executing %s... done" (key-description command)))))
3269
3270 (defun gnus-summary-beginning-of-article ()
3271   "Go to beginning of article body"
3272   (interactive)
3273   (gnus-summary-select-article)
3274   (gnus-eval-in-buffer-window gnus-article-buffer
3275     (widen)
3276     (beginning-of-buffer)
3277     (if gnus-break-pages
3278         (gnus-narrow-to-page))
3279     ))
3280
3281 (defun gnus-summary-end-of-article ()
3282   "Go to end of article body"
3283   (interactive)
3284   (gnus-summary-select-article)
3285   (gnus-eval-in-buffer-window gnus-article-buffer
3286     (widen)
3287     (end-of-buffer)
3288     (if gnus-break-pages
3289         (gnus-narrow-to-page))
3290     ))
3291
3292 (defun gnus-summary-goto-article (article &optional all-headers)
3293   "Read ARTICLE if exists.
3294 Optional argument ALL-HEADERS means all headers are shown."
3295   (interactive
3296    (list
3297     (string-to-int
3298      (completing-read "Article number: "
3299                       (mapcar
3300                        (function
3301                         (lambda (headers)
3302                           (list
3303                            (int-to-string (nntp-header-number headers)))))
3304                        gnus-newsgroup-headers)
3305                       nil 'require-match))))
3306   (if (gnus-summary-goto-subject article)
3307       (gnus-summary-display-article article all-headers)))
3308
3309 (defun gnus-summary-goto-last-article ()
3310   "Go to last subject line."
3311   (interactive)
3312   (if gnus-last-article
3313       (gnus-summary-goto-article gnus-last-article)))
3314
3315 (defun gnus-summary-show-article ()
3316   "Force to show current article."
3317   (interactive)
3318   ;; The following is a trick to force to read the current article again.
3319   (setq gnus-have-all-headers (not gnus-have-all-headers))
3320   (gnus-summary-select-article (not gnus-have-all-headers) t))
3321
3322 (defun gnus-summary-toggle-header (arg)
3323   "Show original header if pruned header currently shown, or vice versa.
3324 With arg, show original header iff arg is positive."
3325   (interactive "P")
3326   ;; Variable gnus-show-all-headers must be NIL to toggle really.
3327   (let ((gnus-show-all-headers nil)
3328         (all-headers
3329          (if (null arg) (not gnus-have-all-headers)
3330            (> (prefix-numeric-value arg) 0))))
3331     (gnus-summary-select-article all-headers t)))
3332
3333 (defun gnus-summary-show-all-headers ()
3334   "Show original article header."
3335   (interactive)
3336   (gnus-summary-select-article t t))
3337
3338 (defun gnus-summary-toggle-mime (arg)
3339   "Toggle MIME processing.
3340 With arg, turn MIME processing on iff arg is positive."
3341   (interactive "P")
3342   (setq gnus-show-mime
3343         (if (null arg) (not gnus-show-mime)
3344           (> (prefix-numeric-value arg) 0)))
3345   ;; The following is a trick to force to read the current article again.
3346   (setq gnus-have-all-headers (not gnus-have-all-headers))
3347   (gnus-summary-select-article (not gnus-have-all-headers) t))
3348
3349 (defun gnus-summary-stop-page-breaking ()
3350   "Stop page breaking by linefeed temporary (Widen article buffer)."
3351   (interactive)
3352   (gnus-summary-select-article)
3353   (gnus-eval-in-buffer-window gnus-article-buffer
3354     (widen)
3355     ))
3356
3357 (defun gnus-summary-kill-same-subject-and-select (unmark)
3358   "Mark articles which has the same subject as read, and then select next.
3359 If argument UNMARK is positive, remove any kinds of marks.
3360 If argument UNMARK is negative, mark articles as unread instead."
3361   (interactive "P")
3362   (if unmark
3363       (setq unmark (prefix-numeric-value unmark)))
3364   (let ((count
3365          (gnus-summary-mark-same-subject
3366           (gnus-summary-subject-string) unmark)))
3367     ;; Select next unread article. If auto-select-same mode, should
3368     ;; select the first unread article.
3369     (gnus-summary-next-article t (and gnus-auto-select-same
3370                                       (gnus-summary-subject-string)))
3371     (message "%d articles are marked as %s"
3372              count (if unmark "unread" "read"))
3373     ))
3374
3375 (defun gnus-summary-kill-same-subject (unmark)
3376   "Mark articles which has the same subject as read.
3377 If argument UNMARK is positive, remove any kinds of marks.
3378 If argument UNMARK is negative, mark articles as unread instead."
3379   (interactive "P")
3380   (if unmark
3381       (setq unmark (prefix-numeric-value unmark)))
3382   (let ((count
3383          (gnus-summary-mark-same-subject
3384           (gnus-summary-subject-string) unmark)))
3385     ;; If marked as read, go to next unread subject.
3386     (if (null unmark)
3387         ;; Go to next unread subject.
3388         (gnus-summary-next-subject 1 t))
3389     (message "%d articles are marked as %s"
3390              count (if unmark "unread" "read"))
3391     ))
3392
3393 (defun gnus-summary-mark-same-subject (subject &optional unmark)
3394   "Mark articles with same SUBJECT as read, and return marked number.
3395 If optional argument UNMARK is positive, remove any kinds of marks.
3396 If optional argument UNMARK is negative, mark articles as unread instead."
3397   (let ((count 1))
3398     (save-excursion
3399       (cond ((null unmark)
3400              (gnus-summary-mark-as-read nil "K"))
3401             ((> unmark 0)
3402              (gnus-summary-mark-as-unread nil t))
3403             (t
3404              (gnus-summary-mark-as-unread)))
3405       (while (and subject
3406                   (gnus-summary-search-forward nil subject))
3407         (cond ((null unmark)
3408                (gnus-summary-mark-as-read nil "K"))
3409               ((> unmark 0)
3410                (gnus-summary-mark-as-unread nil t))
3411               (t
3412                (gnus-summary-mark-as-unread)))
3413         (setq count (1+ count))
3414         ))
3415     ;; Hide killed thread subtrees.  Does not work properly always.
3416     ;;(and (null unmark)
3417     ;;     gnus-thread-hide-killed
3418     ;;     (gnus-summary-hide-thread))
3419     ;; Return number of articles marked as read.
3420     count
3421     ))
3422
3423 (defun gnus-summary-mark-as-unread-forward (count)
3424   "Mark current article as unread, and then go forward.
3425 Argument COUNT specifies number of articles marked as unread."
3426   (interactive "p")
3427   (while (> count 0)
3428     (gnus-summary-mark-as-unread nil nil)
3429     (gnus-summary-next-subject 1 nil)
3430     (setq count (1- count))))
3431
3432 (defun gnus-summary-mark-as-unread-backward (count)
3433   "Mark current article as unread, and then go backward.
3434 Argument COUNT specifies number of articles marked as unread."
3435   (interactive "p")
3436   (while (> count 0)
3437     (gnus-summary-mark-as-unread nil nil)
3438     (gnus-summary-prev-subject 1 nil)
3439     (setq count (1- count))))
3440
3441 (defun gnus-summary-mark-as-unread (&optional article clear-mark)
3442   "Mark current article as unread.
3443 Optional 1st argument ARTICLE specifies article number to be marked as unread.
3444 Optional 2nd argument CLEAR-MARK remove any kinds of mark."
3445   (save-excursion
3446     (set-buffer gnus-summary-buffer)
3447     ;; First of all, show hidden thread subtrees.
3448     (gnus-summary-show-thread)
3449     (let* ((buffer-read-only nil)
3450            (current (gnus-summary-article-number))
3451            (article (or article current)))
3452       (gnus-mark-article-as-unread article clear-mark)
3453       (if (or (eq article current)
3454               (gnus-summary-goto-subject article))
3455           (progn
3456             (beginning-of-line)
3457             (delete-char 1)
3458             (insert (if clear-mark " " "-"))))
3459       )))
3460
3461 (defun gnus-summary-mark-as-read-forward (count)
3462   "Mark current article as read, and then go forward.
3463 Argument COUNT specifies number of articles marked as read"
3464   (interactive "p")
3465   (while (> count 0)
3466     (gnus-summary-mark-as-read)
3467     (gnus-summary-next-subject 1 'unread-only)
3468     (setq count (1- count))))
3469
3470 (defun gnus-summary-mark-as-read-backward (count)
3471   "Mark current article as read, and then go backward.
3472 Argument COUNT specifies number of articles marked as read"
3473   (interactive "p")
3474   (while (> count 0)
3475     (gnus-summary-mark-as-read)
3476     (gnus-summary-prev-subject 1 'unread-only)
3477     (setq count (1- count))))
3478
3479 (defun gnus-summary-mark-as-read (&optional article mark)
3480   "Mark current article as read.
3481 Optional 1st argument ARTICLE specifies article number to be marked as read.
3482 Optional 2nd argument MARK specifies a string inserted at beginning of line.
3483 Any kind of string (length 1) except for a space and `-' is ok."
3484   (save-excursion
3485     (set-buffer gnus-summary-buffer)
3486     ;; First of all, show hidden thread subtrees.
3487     (gnus-summary-show-thread)
3488     (let* ((buffer-read-only nil)
3489            (mark (or mark "D"))         ;Default mark is `D'.
3490            (current (gnus-summary-article-number))
3491            (article (or article current)))
3492       (gnus-mark-article-as-read article)
3493       (if (or (eq article current)
3494               (gnus-summary-goto-subject article))
3495           (progn
3496             (beginning-of-line)
3497             (delete-char 1)
3498             (insert mark)))
3499       )))
3500
3501 (defun gnus-summary-clear-mark-forward (count)
3502   "Remove current article's mark, and go forward.
3503 Argument COUNT specifies number of articles unmarked"
3504   (interactive "p")
3505   (while (> count 0)
3506     (gnus-summary-mark-as-unread nil t)
3507     (gnus-summary-next-subject 1 nil)
3508     (setq count (1- count))))
3509
3510 (defun gnus-summary-clear-mark-backward (count)
3511   "Remove current article's mark, and go backward.
3512 Argument COUNT specifies number of articles unmarked"
3513   (interactive "p")
3514   (while (> count 0)
3515     (gnus-summary-mark-as-unread nil t)
3516     (gnus-summary-prev-subject 1 nil)
3517     (setq count (1- count))))
3518
3519 (defun gnus-summary-delete-marked-as-read ()
3520   "Delete lines which is marked as read."
3521   (interactive)
3522   (if gnus-newsgroup-unreads
3523       (let ((buffer-read-only nil))
3524         (save-excursion
3525           (goto-char (point-min))
3526           (delete-non-matching-lines "^[- ]"))
3527         ;; Adjust point.
3528         (if (eobp)
3529             (gnus-summary-prev-subject 1)
3530           (beginning-of-line)
3531           (search-forward ":" nil t)))
3532     ;; It is not so good idea to make the buffer empty.
3533     (message "All articles are marked as read")
3534     ))
3535
3536 (defun gnus-summary-delete-marked-with (marks)
3537   "Delete lines which are marked with MARKS (e.g. \"DK\")."
3538   (interactive "sMarks: ")
3539   (let ((buffer-read-only nil))
3540     (save-excursion
3541       (goto-char (point-min))
3542       (delete-matching-lines (concat "^[" marks "]")))
3543     ;; Adjust point.
3544     (or (zerop (buffer-size))
3545         (if (eobp)
3546             (gnus-summary-prev-subject 1)
3547           (beginning-of-line)
3548           (search-forward ":" nil t)))
3549     ))
3550
3551 ;; Thread-based commands.
3552
3553 (defun gnus-summary-toggle-threads (arg)
3554   "Toggle showing conversation threads.
3555 With arg, turn showing conversation threads on iff arg is positive."
3556   (interactive "P")
3557   (let ((current (gnus-summary-article-number)))
3558     (setq gnus-show-threads
3559           (if (null arg) (not gnus-show-threads)
3560             (> (prefix-numeric-value arg) 0)))
3561     (gnus-summary-prepare)
3562     (gnus-summary-goto-subject current)
3563     ))
3564
3565 (defun gnus-summary-show-all-threads ()
3566   "Show all thread subtrees."
3567   (interactive)
3568   (if gnus-show-threads
3569       (save-excursion
3570         (let ((buffer-read-only nil))
3571           (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
3572           ))))
3573
3574 (defun gnus-summary-show-thread ()
3575   "Show thread subtrees."
3576   (interactive)
3577   (if gnus-show-threads
3578       (save-excursion
3579         (let ((buffer-read-only nil))
3580           (subst-char-in-region (progn
3581                                   (beginning-of-line) (point))
3582                                 (progn
3583                                   (end-of-line) (point))
3584                                 ?\^M ?\n t)
3585           ))))
3586
3587 (defun gnus-summary-hide-all-threads ()
3588   "Hide all thread subtrees."
3589   (interactive)
3590   (if gnus-show-threads
3591       (save-excursion
3592         ;; Adjust cursor point.
3593         (goto-char (point-min))
3594         (search-forward ":" nil t)
3595         (let ((level (current-column)))
3596           (gnus-summary-hide-thread)
3597           (while (gnus-summary-search-forward)
3598             (and (>= level (current-column))
3599                  (gnus-summary-hide-thread)))
3600           ))))
3601
3602 (defun gnus-summary-hide-thread ()
3603   "Hide thread subtrees."
3604   (interactive)
3605   (if gnus-show-threads
3606       (save-excursion
3607         ;; Adjust cursor point.
3608         (beginning-of-line)
3609         (search-forward ":" nil t)
3610         (let ((buffer-read-only nil)
3611               (init (point))
3612               (last (point))
3613               (level (current-column)))
3614           (while (and (gnus-summary-search-forward)
3615                       (< level (current-column)))
3616             ;; Interested in lower levels.
3617             (if (< level (current-column))
3618                 (progn
3619                   (setq last (point))
3620                   ))
3621             )
3622           (subst-char-in-region init last ?\n ?\^M t)
3623           ))))
3624
3625 (defun gnus-summary-next-thread (n)
3626   "Go to the same level next thread.
3627 Argument N specifies the number of threads."
3628   (interactive "p")
3629   ;; Adjust cursor point.
3630   (beginning-of-line)
3631   (search-forward ":" nil t)
3632   (let ((init (point))
3633         (last (point))
3634         (level (current-column)))
3635     (while (and (> n 0)
3636                 (gnus-summary-search-forward)
3637                 (<= level (current-column)))
3638       ;; We have to skip lower levels.
3639       (if (= level (current-column))
3640           (progn
3641             (setq last (point))
3642             (setq n (1- n))
3643             ))
3644       )
3645     ;; Return non-nil if successfully move to the next.
3646     (prog1 (not (= init last))
3647       (goto-char last))
3648     ))
3649
3650 (defun gnus-summary-prev-thread (n)
3651   "Go to the same level previous thread.
3652 Argument N specifies the number of threads."
3653   (interactive "p")
3654   ;; Adjust cursor point.
3655   (beginning-of-line)
3656   (search-forward ":" nil t)
3657   (let ((init (point))
3658         (last (point))
3659         (level (current-column)))
3660     (while (and (> n 0)
3661                 (gnus-summary-search-backward)
3662                 (<= level (current-column)))
3663       ;; We have to skip lower levels.
3664       (if (= level (current-column))
3665           (progn
3666             (setq last (point))
3667             (setq n (1- n))
3668             ))
3669       )
3670     ;; Return non-nil if successfully move to the previous.
3671     (prog1 (not (= init last))
3672       (goto-char last))
3673     ))
3674
3675 (defun gnus-summary-down-thread (d)
3676   "Go downward current thread.
3677 Argument D specifies the depth goes down."
3678   (interactive "p")
3679   ;; Adjust cursor point.
3680   (beginning-of-line)
3681   (search-forward ":" nil t)
3682   (let ((last (point))
3683         (level (current-column)))
3684     (while (and (> d 0)
3685                 (gnus-summary-search-forward)
3686                 (<= level (current-column))) ;<= can be <.  Which do you like?
3687       ;; We have to skip the same levels.
3688       (if (< level (current-column))
3689           (progn
3690             (setq last (point))
3691             (setq level (current-column))
3692             (setq d (1- d))
3693             ))
3694       )
3695     (goto-char last)
3696     ))
3697
3698 (defun gnus-summary-up-thread (d)
3699   "Go upward current thread.
3700 Argument D specifies the depth goes up."
3701   (interactive "p")
3702   ;; Adjust cursor point.
3703   (beginning-of-line)
3704   (search-forward ":" nil t)
3705   (let ((last (point))
3706         (level (current-column)))
3707     (while (and (> d 0)
3708                 (gnus-summary-search-backward))
3709       ;; We have to skip the same levels.
3710       (if (> level (current-column))
3711           (progn
3712             (setq last (point))
3713             (setq level (current-column))
3714             (setq d (1- d))
3715             ))
3716       )
3717     (goto-char last)
3718     ))
3719
3720 (defun gnus-summary-kill-thread (unmark)
3721   "Mark articles under current thread as read.
3722 If argument UNMARK is positive, remove any kinds of marks.
3723 If argument UNMARK is negative, mark articles as unread instead."
3724   (interactive "P")
3725   (if unmark
3726       (setq unmark (prefix-numeric-value unmark)))
3727   ;; Adjust cursor point.
3728   (beginning-of-line)
3729   (search-forward ":" nil t)
3730   (save-excursion
3731     (let ((level (current-column)))
3732       ;; Mark current article.
3733       (cond ((null unmark)
3734              (gnus-summary-mark-as-read nil "K"))
3735             ((> unmark 0)
3736              (gnus-summary-mark-as-unread nil t))
3737             (t
3738              (gnus-summary-mark-as-unread))
3739             )
3740       ;; Mark following articles.
3741       (while (and (gnus-summary-search-forward)
3742                   (< level (current-column)))
3743         (cond ((null unmark)
3744                (gnus-summary-mark-as-read nil "K"))
3745               ((> unmark 0)
3746                (gnus-summary-mark-as-unread nil t))
3747               (t
3748                (gnus-summary-mark-as-unread))
3749               ))
3750       ))
3751   ;; Hide killed subtrees.
3752   (and (null unmark)
3753        gnus-thread-hide-killed
3754        (gnus-summary-hide-thread))
3755   ;; If marked as read, go to next unread subject.
3756   (if (null unmark)
3757       ;; Go to next unread subject.
3758       (gnus-summary-next-subject 1 t))
3759   )
3760
3761 (defun gnus-summary-toggle-truncation (arg)
3762   "Toggle truncation of summary lines.
3763 With arg, turn line truncation on iff arg is positive."
3764   (interactive "P")
3765   (setq truncate-lines
3766         (if (null arg) (not truncate-lines)
3767           (> (prefix-numeric-value arg) 0)))
3768   (redraw-display))
3769
3770 (defun gnus-summary-sort-by-number (reverse)
3771   "Sort Summary buffer by article number.
3772 Argument REVERSE means reverse order."
3773   (interactive "P")
3774   (gnus-summary-keysort-summary
3775    (function <)
3776    (function
3777     (lambda (a)
3778       (nntp-header-number a)))
3779    reverse
3780    ))
3781
3782 (defun gnus-summary-sort-by-author (reverse)
3783   "Sort Summary buffer by author name alphabetically.
3784 If case-fold-search is non-nil, case of letters is ignored.
3785 Argument REVERSE means reverse order."
3786   (interactive "P")
3787   (gnus-summary-keysort-summary
3788    (function string-lessp)
3789    (function
3790     (lambda (a)
3791       (if case-fold-search
3792           (downcase (nntp-header-from a))
3793         (nntp-header-from a))))
3794    reverse
3795    ))
3796
3797 (defun gnus-summary-sort-by-subject (reverse)
3798   "Sort Summary buffer by subject alphabetically. `Re:'s are ignored.
3799 If case-fold-search is non-nil, case of letters is ignored.
3800 Argument REVERSE means reverse order."
3801   (interactive "P")
3802   (gnus-summary-keysort-summary
3803    (function string-lessp)
3804    (function
3805     (lambda (a)
3806       (if case-fold-search
3807           (downcase (gnus-simplify-subject (nntp-header-subject a) 're-only))
3808         (gnus-simplify-subject (nntp-header-subject a) 're-only))))
3809    reverse
3810    ))
3811
3812 (defun gnus-summary-sort-by-date (reverse)
3813   "Sort Summary buffer by date.
3814 Argument REVERSE means reverse order."
3815   (interactive "P")
3816   (gnus-summary-keysort-summary
3817    (function string-lessp)
3818    (function
3819     (lambda (a)
3820       (gnus-sortable-date (nntp-header-date a))))
3821    reverse
3822    ))
3823
3824 (defun gnus-summary-keysort-summary (predicate key &optional reverse)
3825   "Sort Summary buffer by PREDICATE using a value passed by KEY.
3826 Optional argument REVERSE means reverse order."
3827   (let ((current (gnus-summary-article-number)))
3828     (gnus-keysort-headers predicate key reverse)
3829     (gnus-summary-prepare)
3830     (gnus-summary-goto-subject current)
3831     ))
3832
3833 (defun gnus-summary-sort-summary (predicate &optional reverse)
3834   "Sort Summary buffer by PREDICATE.
3835 Optional argument REVERSE means reverse order."
3836   (let ((current (gnus-summary-article-number)))
3837     (gnus-sort-headers predicate reverse)
3838     (gnus-summary-prepare)
3839     (gnus-summary-goto-subject current)
3840     ))
3841
3842 (defun gnus-summary-reselect-current-group (show-all)
3843   "Once exit and then reselect the current newsgroup.
3844 Prefix argument SHOW-ALL means to select all articles."
3845   (interactive "P")
3846   (let ((current-subject (gnus-summary-article-number)))
3847     (gnus-summary-exit t)
3848     ;; We have to adjust the point of Group mode buffer because the
3849     ;; current point was moved to the next unread newsgroup by
3850     ;; exiting.
3851     (gnus-summary-jump-to-group gnus-newsgroup-name)
3852     (gnus-group-read-group show-all t)
3853     (gnus-summary-goto-subject current-subject)
3854     ))
3855
3856 (defun gnus-summary-caesar-message (rotnum)
3857   "Caesar rotates all letters of current message by 13/47 places.
3858 With prefix arg, specifies the number of places to rotate each letter forward.
3859 Caesar rotates Japanese letters by 47 places in any case."
3860   (interactive "P")
3861   (gnus-summary-select-article)
3862   (gnus-overload-functions)
3863   (gnus-eval-in-buffer-window gnus-article-buffer
3864     (save-restriction
3865       (widen)
3866       ;; We don't want to jump to the beginning of the message.
3867       ;; `save-excursion' does not do its job.
3868       (move-to-window-line 0)
3869       (let ((last (point)))
3870         (news-caesar-buffer-body rotnum)
3871         (goto-char last)
3872         (recenter 0)
3873         ))
3874     ))
3875
3876 (defun gnus-summary-rmail-digest ()
3877   "Run RMAIL on current digest article.
3878 gnus-select-digest-hook will be called with no arguments, if that
3879 value is non-nil. It is possible to modify the article so that Rmail
3880 can work with it.
3881 gnus-rmail-digest-hook will be called with no arguments, if that value
3882 is non-nil. The hook is intended to customize Rmail mode."
3883   (interactive)
3884   (gnus-summary-select-article)
3885   (require 'rmail)
3886   (let ((artbuf gnus-article-buffer)
3887         (digbuf (get-buffer-create gnus-digest-buffer))
3888         (mail-header-separator ""))
3889     (set-buffer digbuf)
3890     (buffer-flush-undo (current-buffer))
3891     (setq buffer-read-only nil)
3892     (erase-buffer)
3893     (insert-buffer-substring artbuf)
3894     (run-hooks 'gnus-select-digest-hook)
3895     (gnus-convert-article-to-rmail)
3896     (goto-char (point-min))
3897     ;; Rmail initializations.
3898     (rmail-insert-rmail-file-header)
3899     (rmail-mode)
3900     (rmail-set-message-counters)
3901     (rmail-show-message)
3902     (condition-case ()
3903         (progn
3904           (undigestify-rmail-message)
3905           (rmail-expunge)               ;Delete original message.
3906           ;; File name is meaningless but `save-buffer' requires it.
3907           (setq buffer-file-name "GNUS Digest")
3908           (setq mode-line-buffer-identification
3909                 (concat "Digest: "
3910                         (nntp-header-subject gnus-current-headers)))
3911           ;; There is no need to write this buffer to a file.
3912           (make-local-variable 'write-file-hooks)
3913           (setq write-file-hooks
3914                 (list (function
3915                        (lambda ()
3916                          (set-buffer-modified-p nil)
3917                          (message "(No changes need to be saved)")
3918                          'no-need-to-write-this-buffer))))
3919           ;; Default file name saving digest messages.
3920           (setq rmail-default-rmail-file
3921                 (funcall gnus-rmail-save-name
3922                          gnus-newsgroup-name
3923                          gnus-current-headers
3924                          gnus-newsgroup-last-rmail
3925                          ))
3926           (setq rmail-default-file
3927                 (funcall gnus-mail-save-name
3928                          gnus-newsgroup-name
3929                          gnus-current-headers
3930                          gnus-newsgroup-last-mail
3931                          ))
3932           ;; Prevent generating new buffer named ***<N> each time.
3933           (setq rmail-summary-buffer
3934                 (get-buffer-create gnus-digest-summary-buffer))
3935           (run-hooks 'gnus-rmail-digest-hook)
3936           ;; Take all windows safely.
3937           (gnus-configure-windows '(1 0 0))
3938           (pop-to-buffer gnus-group-buffer)
3939           ;; Use Summary Article windows for Digest summary and
3940           ;; Digest buffers.
3941           (if gnus-digest-show-summary
3942               (let ((gnus-summary-buffer gnus-digest-summary-buffer)
3943                     (gnus-article-buffer gnus-digest-buffer))
3944                 (gnus-configure-windows 'article)
3945                 (pop-to-buffer gnus-digest-buffer)
3946                 (rmail-summary)
3947                 (pop-to-buffer gnus-digest-summary-buffer)
3948                 (message (substitute-command-keys
3949                           "Type \\[rmail-summary-quit] to return to GNUS")))
3950             (let ((gnus-summary-buffer gnus-digest-buffer))
3951               (gnus-configure-windows 'summary)
3952               (pop-to-buffer gnus-digest-buffer)
3953               (message (substitute-command-keys
3954                         "Type \\[rmail-quit] to return to GNUS")))
3955             )
3956           ;; Move the buffers to the end of buffer list.
3957           (bury-buffer gnus-article-buffer)
3958           (bury-buffer gnus-group-buffer)
3959           (bury-buffer gnus-digest-summary-buffer)
3960           (bury-buffer gnus-digest-buffer))
3961       (error (set-buffer-modified-p nil)
3962              (kill-buffer digbuf)
3963              ;; This command should not signal an error because the
3964              ;; command is called from hooks.
3965              (ding) (message "Article is not a digest")))
3966     ))
3967
3968 (defun gnus-summary-save-article ()
3969   "Save this article using default saver function.
3970 The variable `gnus-default-article-saver' specifies the saver function."
3971   (interactive)
3972   (gnus-summary-select-article gnus-save-all-headers gnus-save-all-headers)
3973   (if gnus-default-article-saver
3974       (call-interactively gnus-default-article-saver)
3975     (error "No default saver is defined.")))
3976
3977 (defun gnus-summary-save-in-rmail (&optional filename)
3978   "Append this article to Rmail file.
3979 Optional argument FILENAME specifies file name.
3980 Directory to save to is default to `gnus-article-save-directory' which
3981 is initialized from the SAVEDIR environment variable."
3982   (interactive)
3983   (gnus-summary-select-article gnus-save-all-headers gnus-save-all-headers)
3984   (gnus-eval-in-buffer-window gnus-article-buffer
3985     (save-excursion
3986       (save-restriction
3987         (widen)
3988         (let ((default-name
3989                 (funcall gnus-rmail-save-name
3990                          gnus-newsgroup-name
3991                          gnus-current-headers
3992                          gnus-newsgroup-last-rmail
3993                          )))
3994           (or filename
3995               (setq filename
3996                     (read-file-name
3997                      (concat "Save article in Rmail file: (default "
3998                              (file-name-nondirectory default-name)
3999                              ") ")
4000                      (file-name-directory default-name)
4001                      default-name)))
4002           (gnus-make-directory (file-name-directory filename))
4003           (gnus-output-to-rmail filename)
4004           ;; Remember the directory name to save articles.
4005           (setq gnus-newsgroup-last-rmail filename)
4006           )))
4007     ))
4008
4009 (defun gnus-summary-save-in-mail (&optional filename)
4010   "Append this article to Unix mail file.
4011 Optional argument FILENAME specifies file name.
4012 Directory to save to is default to `gnus-article-save-directory' which
4013 is initialized from the SAVEDIR environment variable."
4014   (interactive)
4015   (gnus-summary-select-article gnus-save-all-headers gnus-save-all-headers)
4016   (gnus-eval-in-buffer-window gnus-article-buffer
4017     (save-excursion
4018       (save-restriction
4019         (widen)
4020         (let ((default-name
4021                 (funcall gnus-mail-save-name
4022                          gnus-newsgroup-name
4023                          gnus-current-headers
4024                          gnus-newsgroup-last-mail
4025                          )))
4026           (or filename
4027               (setq filename
4028                     (read-file-name
4029                      (concat "Save article in Unix mail file: (default "
4030                              (file-name-nondirectory default-name)
4031                              ") ")
4032                      (file-name-directory default-name)
4033                      default-name)))
4034           (setq filename
4035                 (expand-file-name filename
4036                                   (and default-name
4037                                        (file-name-directory default-name))))
4038           (gnus-make-directory (file-name-directory filename))
4039           (if (and (file-readable-p filename) (rmail-file-p filename))
4040               (gnus-output-to-rmail filename)
4041             (rmail-output filename 1 t t))
4042           ;; Remember the directory name to save articles.
4043           (setq gnus-newsgroup-last-mail filename)
4044           )))
4045     ))
4046
4047 (defun gnus-summary-save-in-file (&optional filename)
4048   "Append this article to file.
4049 Optional argument FILENAME specifies file name.
4050 Directory to save to is default to `gnus-article-save-directory' which
4051 is initialized from the SAVEDIR environment variable."
4052   (interactive)
4053   (gnus-summary-select-article gnus-save-all-headers gnus-save-all-headers)
4054   (gnus-eval-in-buffer-window gnus-article-buffer
4055     (save-excursion
4056       (save-restriction
4057         (widen)
4058         (let ((default-name
4059                 (funcall gnus-file-save-name
4060                          gnus-newsgroup-name
4061                          gnus-current-headers
4062                          gnus-newsgroup-last-file
4063                          )))
4064           (or filename
4065               (setq filename
4066                     (read-file-name
4067                      (concat "Save article in file: (default "
4068                              (file-name-nondirectory default-name)
4069                              ") ")
4070                      (file-name-directory default-name)
4071                      default-name)))
4072           (gnus-make-directory (file-name-directory filename))
4073           (gnus-output-to-file filename)
4074           ;; Remember the directory name to save articles.
4075           (setq gnus-newsgroup-last-file filename)
4076           )))
4077     ))
4078
4079 (defun gnus-summary-save-in-folder (&optional folder)
4080   "Save this article to MH folder (using `rcvstore' in MH library).
4081 Optional argument FOLDER specifies folder name."
4082   (interactive)
4083   (gnus-summary-select-article gnus-save-all-headers gnus-save-all-headers)
4084   (gnus-eval-in-buffer-window gnus-article-buffer
4085     (save-restriction
4086       (widen)
4087       ;; Thanks to yuki@flab.Fujitsu.JUNET and ohm@kaba.junet.
4088       (mh-find-path)
4089       (let ((folder
4090              (or folder
4091                  (mh-prompt-for-folder "Save article in"
4092                                        (funcall gnus-folder-save-name
4093                                                 gnus-newsgroup-name
4094                                                 gnus-current-headers
4095                                                 gnus-newsgroup-last-folder
4096                                                 )
4097                                        t
4098                                        )))
4099             (errbuf (get-buffer-create " *GNUS rcvstore*")))
4100         (unwind-protect
4101             (call-process-region (point-min) (point-max)
4102                                  (expand-file-name "rcvstore" mh-lib)
4103                                  nil errbuf nil folder)
4104           (set-buffer errbuf)
4105           (if (zerop (buffer-size))
4106               (message "Article saved in folder: %s" folder)
4107             (message "%s" (buffer-string)))
4108           (kill-buffer errbuf)
4109           (setq gnus-newsgroup-last-folder folder))
4110         ))
4111     ))
4112
4113 (defun gnus-summary-pipe-output ()
4114   "Pipe this article to subprocess."
4115   (interactive)
4116   ;; Ignore `gnus-save-all-headers' since this is not save command.
4117   ;;(gnus-summary-select-article)
4118   ;; Huuum.  Is this right?
4119   (gnus-summary-select-article gnus-save-all-headers gnus-save-all-headers)
4120   (gnus-eval-in-buffer-window gnus-article-buffer
4121     (save-restriction
4122       (widen)
4123       (let ((command (read-string "Shell command on article: "
4124                                   gnus-last-shell-command)))
4125         (if (string-equal command "")
4126             (setq command gnus-last-shell-command))
4127         (shell-command-on-region (point-min) (point-max) command nil)
4128         (setq gnus-last-shell-command command)
4129         ))
4130     ))
4131
4132 (defun gnus-summary-catchup (all &optional quietly)
4133   "Mark all articles not marked as unread in this newsgroup as read.
4134 If prefix argument ALL is non-nil, all articles are marked as read."
4135   (interactive "P")
4136   (if (or quietly
4137           (not gnus-interactive-catchup) ;Without confirmation?
4138           (y-or-n-p
4139            (if all
4140                "Do you really want to mark everything as read? "
4141              "Delete all articles not marked as unread? ")))
4142       (let ((unmarked
4143              (gnus-set-difference gnus-newsgroup-unreads
4144                                   (if (not all) gnus-newsgroup-marked))))
4145         (message "")                    ;Erase "Yes or No" question.
4146         ;; Hidden thread subtrees must be searched for ,too.
4147         (gnus-summary-show-all-threads)
4148         (while unmarked
4149           (gnus-summary-mark-as-read (car unmarked) "C")
4150           (setq unmarked (cdr unmarked))
4151           ))
4152     ))
4153
4154 (defun gnus-summary-catchup-to-here ()
4155   "Mark all articles before the current one in this newsgroup as read."
4156   (interactive)
4157   (beginning-of-line)
4158   (let ((current (gnus-summary-article-number)))
4159         (beginning-of-buffer)
4160         (while (not (= (gnus-summary-article-number) current))
4161           (gnus-summary-mark-as-read)
4162           (gnus-summary-next-subject 1))))
4163
4164 (defun gnus-summary-catchup-all (&optional quietly)
4165   "Mark all articles in this newsgroup as read."
4166   (interactive)
4167   (gnus-summary-catchup t quietly))
4168
4169 (defun gnus-summary-catchup-and-exit (all &optional quietly)
4170   "Mark all articles not marked as unread in this newsgroup as read, then exit.
4171 If prefix argument ALL is non-nil, all articles are marked as read."
4172   (interactive "P")
4173   (if (or quietly
4174           (not gnus-interactive-catchup) ;Without confirmation?
4175           (y-or-n-p
4176            (if all
4177                "Do you really want to mark everything as read? "
4178              "Delete all articles not marked as unread? ")))
4179       (let ((unmarked
4180              (gnus-set-difference gnus-newsgroup-unreads
4181                                   (if (not all) gnus-newsgroup-marked))))
4182         (message "")                    ;Erase "Yes or No" question.
4183         (while unmarked
4184           (gnus-mark-article-as-read (car unmarked))
4185           (setq unmarked (cdr unmarked)))
4186         ;; Select next newsgroup or exit.
4187         (cond ((eq gnus-auto-select-next 'quietly)
4188                ;; Select next newsgroup quietly.
4189                (gnus-summary-next-group nil))
4190               (t
4191                (gnus-summary-exit)))
4192         )))
4193
4194 (defun gnus-summary-catchup-all-and-exit (&optional quietly)
4195   "Mark all articles in this newsgroup as read, and then exit."
4196   (interactive)
4197   (gnus-summary-catchup-and-exit t quietly))
4198
4199 (defun gnus-summary-edit-global-kill ()
4200   "Edit a global KILL file."
4201   (interactive)
4202   (setq gnus-current-kill-article (gnus-summary-article-number))
4203   (gnus-kill-file-edit-file nil)        ;Nil stands for global KILL file.
4204   (message
4205    (substitute-command-keys
4206     "Editing a global KILL file (Type \\[gnus-kill-file-exit] to exit)")))
4207
4208 (defun gnus-summary-edit-local-kill ()
4209   "Edit a local KILL file applied to the current newsgroup."
4210   (interactive)
4211   (setq gnus-current-kill-article (gnus-summary-article-number))
4212   (gnus-kill-file-edit-file gnus-newsgroup-name)
4213   (message
4214    (substitute-command-keys
4215     "Editing a local KILL file (Type \\[gnus-kill-file-exit] to exit)")))
4216
4217 (defun gnus-summary-exit (&optional temporary)
4218   "Exit reading current newsgroup, and then return to group selection mode.
4219 gnus-exit-group-hook is called with no arguments if that value is non-nil."
4220   (interactive)
4221   (let ((updated nil)
4222         (gnus-newsgroup-headers gnus-newsgroup-headers)
4223         (gnus-newsgroup-unreads gnus-newsgroup-unreads)
4224         (gnus-newsgroup-unselected gnus-newsgroup-unselected)
4225         (gnus-newsgroup-marked gnus-newsgroup-marked))
4226     ;; Important internal variables are saved, so we can reenter
4227     ;; Summary buffer even if hook changes them.
4228     (run-hooks 'gnus-exit-group-hook)
4229     (gnus-update-unread-articles gnus-newsgroup-name
4230                                  (append gnus-newsgroup-unselected
4231                                          gnus-newsgroup-unreads)
4232                                  gnus-newsgroup-marked)
4233     ;; T means ignore unsubscribed newsgroups.
4234     (if gnus-use-cross-reference
4235         (setq updated
4236               (gnus-mark-as-read-by-xref gnus-newsgroup-name
4237                                          gnus-newsgroup-headers
4238                                          gnus-newsgroup-unreads
4239                                          (eq gnus-use-cross-reference t)
4240                                          )))
4241     ;; Do not switch windows but change the buffer to work.
4242     (set-buffer gnus-group-buffer)
4243     ;; Update cross referenced group info.
4244     (while updated
4245       (gnus-group-update-group (car updated) t) ;Ignore invisible group.
4246       (setq updated (cdr updated)))
4247     (gnus-group-update-group gnus-newsgroup-name))
4248   ;; Make sure where I was, and go to next newsgroup.
4249   (gnus-group-jump-to-group gnus-newsgroup-name)
4250   (gnus-group-next-unread-group 1)
4251   (if temporary
4252       ;; If exiting temporary, caller should adjust Group mode
4253       ;; buffer point by itself.
4254       nil                               ;Nothing to do.
4255     ;; Return to Group mode buffer.
4256     (if (get-buffer gnus-summary-buffer)
4257         (bury-buffer gnus-summary-buffer))
4258     (if (get-buffer gnus-article-buffer)
4259         (bury-buffer gnus-article-buffer))
4260     (gnus-configure-windows 'newsgroups)
4261     (pop-to-buffer gnus-group-buffer)))
4262
4263 (defun gnus-summary-quit ()
4264   "Quit reading current newsgroup without updating read article info."
4265   (interactive)
4266   (if (y-or-n-p "Do you really wanna quit reading this group? ")
4267       (progn
4268         (message "")                    ;Erase "Yes or No" question.
4269         ;; Return to Group selection mode.
4270         (if (get-buffer gnus-summary-buffer)
4271             (bury-buffer gnus-summary-buffer))
4272         (if (get-buffer gnus-article-buffer)
4273             (bury-buffer gnus-article-buffer))
4274         (gnus-configure-windows 'newsgroups)
4275         (pop-to-buffer gnus-group-buffer)
4276         (gnus-group-jump-to-group gnus-newsgroup-name) ;Make sure where I was.
4277         (gnus-group-next-group 1)       ;(gnus-group-next-unread-group 1)
4278         )))
4279
4280 (defun gnus-summary-describe-briefly ()
4281   "Describe Summary mode commands briefly."
4282   (interactive)
4283   (message
4284    (concat
4285     (substitute-command-keys "\\[gnus-summary-next-page]:Select  ")
4286     (substitute-command-keys "\\[gnus-summary-next-unread-article]:Forward  ")
4287     (substitute-command-keys "\\[gnus-summary-prev-unread-article]:Backward  ")
4288     (substitute-command-keys "\\[gnus-summary-exit]:Exit  ")
4289     (substitute-command-keys "\\[gnus-info-find-node]:Run Info  ")
4290     (substitute-command-keys "\\[gnus-summary-describe-briefly]:This help")
4291     )))
4292
4293 \f
4294 ;;;
4295 ;;; GNUS Article Mode
4296 ;;;
4297
4298 (if gnus-article-mode-map
4299     nil
4300   (setq gnus-article-mode-map (make-keymap))
4301   (suppress-keymap gnus-article-mode-map)
4302   (define-key gnus-article-mode-map " " 'gnus-article-next-page)
4303   (define-key gnus-article-mode-map "\177" 'gnus-article-prev-page)
4304   (define-key gnus-article-mode-map "r" 'gnus-article-refer-article)
4305   (define-key gnus-article-mode-map "o" 'gnus-article-pop-article)
4306   (define-key gnus-article-mode-map "h" 'gnus-article-show-summary)
4307   (define-key gnus-article-mode-map "s" 'gnus-article-show-summary)
4308   (define-key gnus-article-mode-map "?" 'gnus-article-describe-briefly)
4309   (define-key gnus-article-mode-map "\C-c\C-i" 'gnus-info-find-node))
4310
4311 (defun gnus-article-mode ()
4312   "Major mode for browsing through an article.
4313 All normal editing commands are turned off.
4314 Instead, these commands are available:
4315 \\{gnus-article-mode-map}
4316
4317 Various hooks for customization:
4318  gnus-article-mode-hook
4319     Entry to this mode calls the value with no arguments, if that
4320     value is non-nil.
4321
4322  gnus-article-prepare-hook
4323     Called with no arguments after an article is prepared for reading,
4324     if that value is non-nil."
4325   (interactive)
4326   (kill-all-local-variables)
4327   ;; Gee.  Why don't you upgrade?
4328   (cond ((boundp 'mode-line-modified)
4329          (setq mode-line-modified "--- "))
4330         ((listp (default-value 'mode-line-format))
4331          (setq mode-line-format
4332                (cons "--- " (cdr (default-value 'mode-line-format))))))
4333   ;; To disable display-time facility.
4334   ;;(make-local-variable 'global-mode-string)
4335   ;;(setq global-mode-string nil)
4336   (setq major-mode 'gnus-article-mode)
4337   (setq mode-name "Article")
4338   (make-local-variable 'minor-mode-alist)
4339   (or (assq 'gnus-show-mime minor-mode-alist)
4340       (setq minor-mode-alist
4341             (cons (list 'gnus-show-mime " MIME") minor-mode-alist)))
4342   (gnus-article-set-mode-line)
4343   (use-local-map gnus-article-mode-map)
4344   (make-local-variable 'page-delimiter)
4345   (setq page-delimiter gnus-page-delimiter)
4346   (make-local-variable 'mail-header-separator)
4347   (setq mail-header-separator "")       ;For caesar function.
4348   (buffer-flush-undo (current-buffer))
4349   (setq buffer-read-only t)             ;Disable modification
4350   (run-hooks 'gnus-article-mode-hook))
4351
4352 (defun gnus-article-setup-buffer ()
4353   "Initialize Article mode buffer."
4354   (or (get-buffer gnus-article-buffer)
4355       (save-excursion
4356         (set-buffer (get-buffer-create gnus-article-buffer))
4357         (gnus-article-mode))
4358       ))
4359
4360 (defun gnus-article-prepare (article &optional all-headers)
4361   "Prepare ARTICLE in Article mode buffer.
4362 ARTICLE can be either a article number or Message-ID.
4363 If optional argument ALL-HEADERS is non-nil, all headers are inserted."
4364   ;; Make sure a connection to NNTP server is alive.
4365   (if (not (gnus-server-opened))
4366       (progn
4367         (gnus-start-news-server)
4368         (gnus-request-group gnus-newsgroup-name)))
4369   (save-excursion
4370     (set-buffer gnus-article-buffer)
4371     (let ((buffer-read-only nil))
4372       (erase-buffer)
4373       ;; mhspool does not work with Message-ID.  So, let's translate
4374       ;; it into an article number as possible as can.  This may help
4375       ;; nnspool too.
4376       ;; Note: this conversion must be done here since if the article
4377       ;; is specified by number or message-id has a different meaning
4378       ;; in the following.
4379       (if (let* ((header
4380                   (and (stringp article)
4381                        (gnus-get-header-by-id article)))
4382                  (article
4383                   (if header
4384                       (nntp-header-number header) article)))
4385             (gnus-request-article article))
4386           (progn
4387             ;; Prepare article buffer
4388             (insert-buffer-substring nntp-server-buffer)
4389             ;; gnus-have-all-headers must be either T or NIL.
4390             (setq gnus-have-all-headers
4391                   (not (not (or all-headers gnus-show-all-headers))))
4392             (if (and (numberp article)
4393                      (not (eq article gnus-current-article)))
4394                 ;; Seems me that a new article has been selected.
4395                 (progn
4396                   ;; gnus-current-article must be an article number.
4397                   (setq gnus-last-article gnus-current-article)
4398                   (setq gnus-current-article article)
4399 ;;                (setq gnus-current-headers
4400 ;;                      (gnus-find-header-by-number gnus-newsgroup-headers
4401 ;;                                                  gnus-current-article))
4402                   (setq gnus-current-headers
4403                         (gnus-get-header-by-number gnus-current-article))
4404                   (run-hooks 'gnus-mark-article-hook)
4405                   ))
4406             ;; Clear article history only when the article is
4407             ;; retrieved by the article number.
4408             (if (numberp article)
4409                 (setq gnus-current-history nil))
4410             ;; Hooks for modifying contents of the article.  This hook
4411             ;; must be called before being narrowed.
4412             (run-hooks 'gnus-article-prepare-hook)
4413             ;; Decode MIME message.
4414             (if (and gnus-show-mime
4415                      (gnus-fetch-field "Mime-Version"))
4416                 (funcall gnus-show-mime-method))
4417             ;; Delete unnecessary headers.
4418             (or gnus-have-all-headers
4419                 (gnus-article-delete-headers))
4420             ;; Do page break.
4421             (goto-char (point-min))
4422             (if gnus-break-pages
4423                 (gnus-narrow-to-page))
4424             ;; Next function must be called after setting
4425             ;;  `gnus-current-article' variable and narrowed to page.
4426             (gnus-article-set-mode-line)
4427             )
4428         ;; There is no such article.
4429         (if (numberp article)
4430             (gnus-summary-mark-as-read article))
4431         (ding) (message "No such article (may be canceled)"))
4432       )))
4433
4434 (defun gnus-article-show-all-headers ()
4435   "Show all article headers in Article mode buffer."
4436   (or gnus-have-all-headers
4437       (gnus-article-prepare gnus-current-article t)))
4438
4439 ;;(defun gnus-article-set-mode-line ()
4440 ;;  "Set Article mode line string."
4441 ;;  (setq mode-line-buffer-identification
4442 ;;      (list 17
4443 ;;            (format "GNUS: %s {%d-%d} %d"
4444 ;;                    gnus-newsgroup-name
4445 ;;                    gnus-newsgroup-begin
4446 ;;                    gnus-newsgroup-end
4447 ;;                    gnus-current-article
4448 ;;                    )))
4449 ;;  (set-buffer-modified-p t))
4450
4451 ;;(defun gnus-article-set-mode-line ()
4452 ;;  "Set Article mode line string."
4453 ;;  (let ((unmarked
4454 ;;       (- (length gnus-newsgroup-unreads)
4455 ;;          (length (gnus-intersection
4456 ;;                   gnus-newsgroup-unreads gnus-newsgroup-marked))))
4457 ;;      (unselected
4458 ;;       (- (length gnus-newsgroup-unselected)
4459 ;;          (length (gnus-intersection
4460 ;;                   gnus-newsgroup-unselected gnus-newsgroup-marked)))))
4461 ;;    (setq mode-line-buffer-identification
4462 ;;        (list 17
4463 ;;              (format "GNUS: %s{%d} %s"
4464 ;;                      gnus-newsgroup-name
4465 ;;                      gnus-current-article
4466 ;;                      ;; This is proposed by tale@pawl.rpi.edu.
4467 ;;                      (cond ((and (zerop unmarked)
4468 ;;                                  (zerop unselected))
4469 ;;                             "      ")
4470 ;;                            ((zerop unselected)
4471 ;;                             (format "%d more" unmarked))
4472 ;;                            (t
4473 ;;                             (format "%d(+%d) more" unmarked unselected)))
4474 ;;                      ))))
4475 ;;  (set-buffer-modified-p t))
4476
4477 ;; New implementation in gnus 3.14.3
4478
4479 (defun gnus-article-set-mode-line ()
4480   "Set Article mode line string.
4481 If you don't like it, define your own gnus-article-set-mode-line."
4482   (let ((maxlen 15)                     ;Maximum subject length
4483         (subject
4484          (if gnus-current-headers
4485              (nntp-header-subject gnus-current-headers) "")))
4486     ;; The value must be a string to escape %-constructs because of subject.
4487     (setq mode-line-buffer-identification
4488           (format "GNUS: %s%s %s%s%s"
4489                   gnus-newsgroup-name
4490                   (if gnus-current-article
4491                       (format "/%d" gnus-current-article) "")
4492                   (substring subject 0 (min (length subject) maxlen))
4493                   (if (> (length subject) maxlen) "..." "")
4494                   (make-string (max 0 (- 17 (length subject))) ? )
4495                   )))
4496   (set-buffer-modified-p t))
4497
4498 (defun gnus-article-delete-headers ()
4499   "Delete unnecessary headers."
4500   (save-excursion
4501     (save-restriction
4502       (goto-char (point-min))
4503       (narrow-to-region (point-min)
4504                         (progn (search-forward "\n\n" nil 'move) (point)))
4505       (goto-char (point-min))
4506       (and (stringp gnus-ignored-headers)
4507            (while (re-search-forward gnus-ignored-headers nil t)
4508              (beginning-of-line)
4509              (delete-region (point)
4510                             (progn (re-search-forward "\n[^ \t]")
4511                                    (forward-char -1)
4512                                    (point)))))
4513       )))
4514
4515 ;; Working on article's buffer
4516
4517 (defun gnus-article-next-page (lines)
4518   "Show next page of current article.
4519 If end of article, return non-nil. Otherwise return nil.
4520 Argument LINES specifies lines to be scrolled up."
4521   (interactive "P")
4522   (move-to-window-line -1)
4523   ;; Fixed by enami@ptgd.sony.co.jp (enami tsugutomo)
4524   (if (save-excursion
4525         (end-of-line)
4526         (and (pos-visible-in-window-p)  ;Not continuation line.
4527              (eobp)))
4528       ;; Nothing in this page.
4529       (if (or (not gnus-break-pages)
4530               (save-excursion
4531                 (save-restriction
4532                   (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer?
4533           t                             ;Nothing more.
4534         (gnus-narrow-to-page 1)         ;Go to next page.
4535         nil
4536         )
4537     ;; More in this page.
4538     (condition-case ()
4539         (scroll-up lines)
4540       (end-of-buffer
4541        ;; Long lines may cause an end-of-buffer error.
4542        (goto-char (point-max))))
4543     nil
4544     ))
4545
4546 (defun gnus-article-prev-page (lines)
4547   "Show previous page of current article.
4548 Argument LINES specifies lines to be scrolled down."
4549   (interactive "P")
4550   (move-to-window-line 0)
4551   (if (and gnus-break-pages
4552            (bobp)
4553            (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer?
4554       (progn
4555         (gnus-narrow-to-page -1) ;Go to previous page.
4556         (goto-char (point-max))
4557         (recenter -1))
4558     (scroll-down lines)))
4559
4560 (defun gnus-article-next-digest (nth)
4561   "Move to head of NTH next digested message.
4562 Set mark at end of digested message."
4563   ;; Stop page breaking in digest mode.
4564   (widen)
4565   (end-of-line)
4566   ;; Skip NTH - 1 digest.
4567   ;; Suggested by Khalid Sattar <admin@cs.exeter.ac.uk>.
4568   ;; Digest separator is customizable.
4569   ;; Suggested by Skip Montanaro <montanaro@sprite.crd.ge.com>.
4570   (while (and (> nth 1)
4571               (re-search-forward gnus-digest-separator nil 'move))
4572     (setq nth (1- nth)))
4573   (if (re-search-forward gnus-digest-separator nil t)
4574       (let ((begin (point)))
4575         ;; Search for end of this message.
4576         (end-of-line)
4577         (if (re-search-forward gnus-digest-separator nil t)
4578             (progn
4579               (search-backward "\n\n")  ;This may be incorrect.
4580               (forward-line 1))
4581           (goto-char (point-max)))
4582         (push-mark)                     ;Set mark at end of digested message.
4583         (goto-char begin)
4584         (beginning-of-line)
4585         ;; Show From: and Subject: fields.
4586         (recenter 1))
4587     (message "End of message")
4588     ))
4589
4590 (defun gnus-article-prev-digest (nth)
4591   "Move to head of NTH previous digested message."
4592   ;; Stop page breaking in digest mode.
4593   (widen)
4594   (beginning-of-line)
4595   ;; Skip NTH - 1 digest.
4596   ;; Suggested by Khalid Sattar <admin@cs.exeter.ac.uk>.
4597   ;; Digest separator is customizable.
4598   ;; Suggested by Skip Montanaro <montanaro@sprite.crd.ge.com>.
4599   (while (and (> nth 1)
4600               (re-search-backward gnus-digest-separator nil 'move))
4601     (setq nth (1- nth)))
4602   (if (re-search-backward gnus-digest-separator nil t)
4603       (let ((begin (point)))
4604         ;; Search for end of this message.
4605         (end-of-line)
4606         (if (re-search-forward gnus-digest-separator nil t)
4607             (progn
4608               (search-backward "\n\n")  ;This may be incorrect.
4609               (forward-line 1))
4610           (goto-char (point-max)))
4611         (push-mark)                     ;Set mark at end of digested message.
4612         (goto-char begin)
4613         ;; Show From: and Subject: fields.
4614         (recenter 1))
4615     (goto-char (point-min))
4616     (message "Top of message")
4617     ))
4618
4619 (defun gnus-article-refer-article ()
4620   "Read article specified by message-id around point."
4621   (interactive)
4622   (save-window-excursion
4623     (save-excursion
4624       (re-search-forward ">" nil t)     ;Move point to end of "<....>".
4625       (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t)
4626           (let ((message-id
4627                  (buffer-substring (match-beginning 1) (match-end 1))))
4628             (set-buffer gnus-summary-buffer)
4629             (gnus-summary-refer-article message-id))
4630         (error "No references around point"))
4631       )))
4632
4633 (defun gnus-article-pop-article ()
4634   "Pop up article history."
4635   (interactive)
4636   (save-window-excursion
4637     (set-buffer gnus-summary-buffer)
4638     (gnus-summary-refer-article nil)))
4639
4640 (defun gnus-article-show-summary ()
4641   "Reconfigure windows to show Summary buffer."
4642   (interactive)
4643   (gnus-configure-windows 'article)
4644   (pop-to-buffer gnus-summary-buffer)
4645   (gnus-summary-goto-subject gnus-current-article))
4646
4647 (defun gnus-article-describe-briefly ()
4648   "Describe Article mode commands briefly."
4649   (interactive)
4650   (message
4651    (concat
4652     (substitute-command-keys "\\[gnus-article-next-page]:Next page  ")
4653     (substitute-command-keys "\\[gnus-article-prev-page]:Prev page  ")
4654     (substitute-command-keys "\\[gnus-article-show-summary]:Show Summary  ")
4655     (substitute-command-keys "\\[gnus-info-find-node]:Run Info  ")
4656     (substitute-command-keys "\\[gnus-article-describe-briefly]:This help")
4657     )))
4658
4659 \f
4660 ;;;
4661 ;;; GNUS KILL-File Mode
4662 ;;;
4663
4664 (if gnus-kill-file-mode-map
4665     nil
4666   (setq gnus-kill-file-mode-map (copy-keymap emacs-lisp-mode-map))
4667   (define-key gnus-kill-file-mode-map "\C-c\C-k\C-s" 'gnus-kill-file-kill-by-subject)
4668   (define-key gnus-kill-file-mode-map "\C-c\C-k\C-a" 'gnus-kill-file-kill-by-author)
4669   (define-key gnus-kill-file-mode-map "\C-c\C-a" 'gnus-kill-file-apply-buffer)
4670   (define-key gnus-kill-file-mode-map "\C-c\C-e" 'gnus-kill-file-apply-last-sexp)
4671   (define-key gnus-kill-file-mode-map "\C-c\C-c" 'gnus-kill-file-exit)
4672   (define-key gnus-kill-file-mode-map "\C-c\C-i" 'gnus-info-find-node))
4673
4674 (defun gnus-kill-file-mode ()
4675   "Major mode for editing KILL file.
4676
4677 In addition to Emacs-Lisp Mode, the following commands are available:
4678
4679 \\[gnus-kill-file-kill-by-subject]      Insert KILL command for current subject.
4680 \\[gnus-kill-file-kill-by-author]       Insert KILL command for current author.
4681 \\[gnus-kill-file-apply-buffer] Apply current buffer to selected newsgroup.
4682 \\[gnus-kill-file-apply-last-sexp]      Apply sexp before point to selected newsgroup.
4683 \\[gnus-kill-file-exit] Save file and exit editing KILL file.
4684 \\[gnus-info-find-node] Read Info about KILL file.
4685
4686   A KILL file contains Lisp expressions to be applied to a selected
4687 newsgroup.  The purpose is to mark articles as read on the basis of
4688 some set of regexps.  A global KILL file is applied to every newsgroup,
4689 and a local KILL file is applied to a specified newsgroup.  Since a
4690 global KILL file is applied to every newsgroup, for better performance
4691 use a local one.
4692
4693   A KILL file can contain any kind of Emacs Lisp expressions expected
4694 to be evaluated in the Summary buffer.  Writing Lisp programs for this
4695 purpose is not so easy because the internal working of GNUS must be
4696 well-known.  For this reason, GNUS provides a general function which
4697 does this easily for non-Lisp programmers.
4698
4699   The `gnus-kill' function executes commands available in Summary Mode
4700 by their key sequences. `gnus-kill' should be called with FIELD,
4701 REGEXP and optional COMMAND and ALL.  FIELD is a string representing
4702 the header field or an empty string.  If FIELD is an empty string, the
4703 entire article body is searched for.  REGEXP is a string which is
4704 compared with FIELD value. COMMAND is a string representing a valid
4705 key sequence in Summary mode or Lisp expression. COMMAND defaults to
4706 '(gnus-summary-mark-as-read nil \"X\").  Make sure that COMMAND is
4707 executed in the Summary buffer.  If the second optional argument ALL
4708 is non-nil, the COMMAND is applied to articles which are already
4709 marked as read or unread.  Articles which are marked are skipped over
4710 by default.
4711
4712   For example, if you want to mark articles of which subjects contain
4713 the string `AI' as read, a possible KILL file may look like:
4714
4715         (gnus-kill \"Subject\" \"AI\")
4716
4717   If you want to mark articles with `D' instead of `X', you can use
4718 the following expression:
4719
4720         (gnus-kill \"Subject\" \"AI\" \"d\")
4721
4722 In this example it is assumed that the command
4723 `gnus-summary-mark-as-read-forward' is assigned to `d' in Summary Mode.
4724
4725   It is possible to delete unnecessary headers which are marked with
4726 `X' in a KILL file as follows:
4727
4728         (gnus-expunge \"X\")
4729
4730   If the Summary buffer is empty after applying KILL files, GNUS will
4731 exit the selected newsgroup normally.  If headers which are marked
4732 with `D' are deleted in a KILL file, it is impossible to read articles
4733 which are marked as read in the previous GNUS sessions.  Marks other
4734 than `D' should be used for articles which should really be deleted.
4735
4736 Entry to this mode calls emacs-lisp-mode-hook and
4737 gnus-kill-file-mode-hook with no arguments, if that value is non-nil."
4738   (interactive)
4739   (kill-all-local-variables)
4740   (use-local-map gnus-kill-file-mode-map)
4741   (set-syntax-table emacs-lisp-mode-syntax-table)
4742   (setq major-mode 'gnus-kill-file-mode)
4743   (setq mode-name "KILL-File")
4744   (lisp-mode-variables nil)
4745   (run-hooks 'emacs-lisp-mode-hook 'gnus-kill-file-mode-hook))
4746
4747 (defun gnus-kill-file-edit-file (newsgroup)
4748   "Begin editing a KILL file of NEWSGROUP.
4749 If NEWSGROUP is nil, the global KILL file is selected."
4750   (interactive "sNewsgroup: ")
4751   (let ((file (gnus-newsgroup-kill-file newsgroup)))
4752     (gnus-make-directory (file-name-directory file))
4753     ;; Save current window configuration if this is first invocation.
4754     (or (and (get-file-buffer file)
4755              (get-buffer-window (get-file-buffer file)))
4756         (setq gnus-winconf-kill-file (current-window-configuration)))
4757     ;; Hack windows.
4758     (let ((buffer (find-file-noselect file)))
4759       (cond ((get-buffer-window buffer)
4760              (pop-to-buffer buffer))
4761             ((eq major-mode 'gnus-group-mode)
4762              (gnus-configure-windows '(1 0 0)) ;Take all windows.
4763              (pop-to-buffer gnus-group-buffer)
4764              (let ((gnus-summary-buffer buffer))
4765                (gnus-configure-windows '(1 1 0)) ;Split into two.
4766                (pop-to-buffer buffer)))
4767             ((eq major-mode 'gnus-summary-mode)
4768              (gnus-configure-windows 'article)
4769              (pop-to-buffer gnus-article-buffer)
4770              (bury-buffer gnus-article-buffer)
4771              (switch-to-buffer buffer))
4772             (t                          ;No good rules.
4773              (find-file-other-window file))
4774             ))
4775     (gnus-kill-file-mode)
4776     ))
4777
4778 (defun gnus-kill-file-kill-by-subject ()
4779   "Insert KILL command for current subject."
4780   (interactive)
4781   (insert
4782    (format "(gnus-kill \"Subject\" %s)\n"
4783            (prin1-to-string
4784             (if gnus-current-kill-article
4785                 (regexp-quote
4786                  (nntp-header-subject
4787                   ;; No need to speed up this command.
4788                   ;;(gnus-get-header-by-number gnus-current-kill-article)
4789                   (gnus-find-header-by-number gnus-newsgroup-headers
4790                                               gnus-current-kill-article)))
4791               "")))))
4792
4793 (defun gnus-kill-file-kill-by-author ()
4794   "Insert KILL command for current author."
4795   (interactive)
4796   (insert
4797    (format "(gnus-kill \"From\" %s)\n"
4798            (prin1-to-string
4799             (if gnus-current-kill-article
4800                 (regexp-quote
4801                  (nntp-header-from
4802                   ;; No need to speed up this command.
4803                   ;;(gnus-get-header-by-number gnus-current-kill-article)
4804                   (gnus-find-header-by-number gnus-newsgroup-headers
4805                                               gnus-current-kill-article)))
4806               "")))))
4807
4808 (defun gnus-kill-file-apply-buffer ()
4809   "Apply current buffer to current newsgroup."
4810   (interactive)
4811   (if (and gnus-current-kill-article
4812            (get-buffer gnus-summary-buffer))
4813       ;; Assume newsgroup is selected.
4814       (let ((string (concat "(progn \n" (buffer-string) "\n)" )))
4815         (save-excursion
4816           (save-window-excursion
4817             (pop-to-buffer gnus-summary-buffer)
4818             (eval (car (read-from-string string))))))
4819     (ding) (message "No newsgroup is selected.")))
4820
4821 (defun gnus-kill-file-apply-last-sexp ()
4822   "Apply sexp before point in current buffer to current newsgroup."
4823   (interactive)
4824   (if (and gnus-current-kill-article
4825            (get-buffer gnus-summary-buffer))
4826       ;; Assume newsgroup is selected.
4827       (let ((string
4828              (buffer-substring
4829               (save-excursion (forward-sexp -1) (point)) (point))))
4830         (save-excursion
4831           (save-window-excursion
4832             (pop-to-buffer gnus-summary-buffer)
4833             (eval (car (read-from-string string))))))
4834     (ding) (message "No newsgroup is selected.")))
4835
4836 (defun gnus-kill-file-exit ()
4837   "Save a KILL file, then return to the previous buffer."
4838   (interactive)
4839   (save-buffer)
4840   (let ((killbuf (current-buffer)))
4841     ;; We don't want to return to Article buffer.
4842     (and (get-buffer gnus-article-buffer)
4843          (bury-buffer (get-buffer gnus-article-buffer)))
4844     ;; Delete the KILL file windows.
4845     (delete-windows-on killbuf)
4846     ;; Restore last window configuration if available.
4847     (and gnus-winconf-kill-file
4848          (set-window-configuration gnus-winconf-kill-file))
4849     (setq gnus-winconf-kill-file nil)
4850     ;; Kill the KILL file buffer.  Suggested by tale@pawl.rpi.edu.
4851     (kill-buffer killbuf)))
4852
4853 \f
4854 ;;;
4855 ;;; Utility functions
4856 ;;;
4857
4858 ;; Basic ideas by emv@math.lsa.umich.edu (Edward Vielmetti)
4859
4860 (defun gnus-batch-kill ()
4861   "Run batched KILL.
4862 Usage: emacs -batch -l gnus -f gnus-batch-kill NEWSGROUP ..."
4863   (if (not noninteractive)
4864       (error "gnus-batch-kill is to be used only with -batch"))
4865   (let* ((group nil)
4866          (subscribed nil)
4867          (newsrc nil)
4868          (yes-and-no
4869           (gnus-parse-n-options
4870            (apply (function concat)
4871                   (mapcar (function (lambda (g) (concat g " ")))
4872                           command-line-args-left))))
4873          (yes (car yes-and-no))
4874          (no  (cdr yes-and-no))
4875          ;; Disable verbose message.
4876          (gnus-novice-user nil)
4877          (gnus-large-newsgroup nil)
4878          (nntp-large-newsgroup nil))
4879     ;; Eat all arguments.
4880     (setq command-line-args-left nil)
4881     ;; Startup GNUS.
4882     (gnus)
4883     ;; Apply kills to specified newsgroups in command line arguments.
4884     (setq newsrc (copy-sequence gnus-newsrc-assoc))
4885     (while newsrc
4886       (setq group (car (car newsrc)))
4887       (setq subscribed (nth 1 (car newsrc)))
4888       (setq newsrc (cdr newsrc))
4889       (if (and subscribed
4890                (not (zerop (nth 1 (gnus-gethash group gnus-unread-hashtb))))
4891                (if yes
4892                    (string-match yes group) t)
4893                (or (null no)
4894                    (not (string-match no group))))
4895           (progn
4896             (gnus-summary-read-group group nil t)
4897             (if (eq (current-buffer) (get-buffer gnus-summary-buffer))
4898                 (gnus-summary-exit t))
4899             ))
4900       )
4901     ;; Finally, exit Emacs.
4902     (set-buffer gnus-group-buffer)
4903     (gnus-group-exit)
4904     ))
4905
4906 ;; For saving articles
4907
4908 (defun gnus-Numeric-save-name (newsgroup headers &optional last-file)
4909   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
4910 If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group/num.
4911 Otherwise, it is like ~/News/news/group/num."
4912   (let ((default
4913           (expand-file-name
4914            (concat (if gnus-use-long-file-name
4915                        (gnus-capitalize-newsgroup newsgroup)
4916                      (gnus-newsgroup-directory-form newsgroup))
4917                    "/" (int-to-string (nntp-header-number headers)))
4918            (or gnus-article-save-directory "~/News"))))
4919     (if (and last-file
4920              (string-equal (file-name-directory default)
4921                            (file-name-directory last-file))
4922              (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
4923         default
4924       (or last-file default))))
4925
4926 (defun gnus-numeric-save-name (newsgroup headers &optional last-file)
4927   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
4928 If variable `gnus-use-long-file-name' is nil, it is ~/News/news.group/num.
4929 Otherwise, it is like ~/News/news/group/num."
4930   (let ((default
4931           (expand-file-name
4932            (concat (if gnus-use-long-file-name
4933                        newsgroup
4934                      (gnus-newsgroup-directory-form newsgroup))
4935                    "/" (int-to-string (nntp-header-number headers)))
4936            (or gnus-article-save-directory "~/News"))))
4937     (if (and last-file
4938              (string-equal (file-name-directory default)
4939                            (file-name-directory last-file))
4940              (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
4941         default
4942       (or last-file default))))
4943
4944 (defun gnus-Plain-save-name (newsgroup headers &optional last-file)
4945   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
4946 If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group.
4947 Otherwise, it is like ~/News/news/group/news."
4948   (or last-file
4949       (expand-file-name
4950        (if gnus-use-long-file-name
4951            (gnus-capitalize-newsgroup newsgroup)
4952          (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
4953        (or gnus-article-save-directory "~/News"))))
4954
4955 (defun gnus-plain-save-name (newsgroup headers &optional last-file)
4956   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
4957 If variable `gnus-use-long-file-name' is nil, it is ~/News/news.group.
4958 Otherwise, it is like ~/News/news/group/news."
4959   (or last-file
4960       (expand-file-name
4961        (if gnus-use-long-file-name
4962            newsgroup
4963          (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
4964        (or gnus-article-save-directory "~/News"))))
4965
4966 (defun gnus-Folder-save-name (newsgroup headers &optional last-folder)
4967   "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER.
4968 If variable `gnus-use-long-file-name' is nil, it is +News.group.
4969 Otherwise, it is like +news/group."
4970   (or last-folder
4971       (concat "+"
4972               (if gnus-use-long-file-name
4973                   (gnus-capitalize-newsgroup newsgroup)
4974                 (gnus-newsgroup-directory-form newsgroup)))))
4975
4976 (defun gnus-folder-save-name (newsgroup headers &optional last-folder)
4977   "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER.
4978 If variable `gnus-use-long-file-name' is nil, it is +news.group.
4979 Otherwise, it is like +news/group."
4980   (or last-folder
4981       (concat "+"
4982               (if gnus-use-long-file-name
4983                   newsgroup
4984                 (gnus-newsgroup-directory-form newsgroup)))))
4985
4986 ;; For KILL files
4987
4988 (defun gnus-apply-kill-file ()
4989   "Apply KILL file to the current newsgroup."
4990   ;; Apply the global KILL file.
4991   (load (gnus-newsgroup-kill-file nil) t nil t)
4992   ;; And then apply the local KILL file.
4993   (load (gnus-newsgroup-kill-file gnus-newsgroup-name) t nil t))
4994
4995 (defun gnus-Newsgroup-kill-file (newsgroup)
4996   "Return the name of a KILL file of NEWSGROUP.
4997 If NEWSGROUP is nil, return the global KILL file instead."
4998   (cond ((or (null newsgroup)
4999              (string-equal newsgroup ""))
5000          ;; The global KILL file is placed at top of the directory.
5001          (expand-file-name gnus-kill-file-name
5002                            (or gnus-kill-files-directory "~/News")))
5003         (gnus-use-long-file-name
5004          ;; Append ".KILL" to capitalized newsgroup name.
5005          (expand-file-name (concat (gnus-capitalize-newsgroup newsgroup)
5006                                    "." gnus-kill-file-name)
5007                            (or gnus-kill-files-directory "~/News")))
5008         (t
5009          ;; Place "KILL" under the hierarchical directory.
5010          (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
5011                                    "/" gnus-kill-file-name)
5012                            (or gnus-kill-files-directory "~/News")))
5013         ))
5014
5015 (defun gnus-newsgroup-kill-file (newsgroup)
5016   "Return the name of a KILL file of NEWSGROUP.
5017 If NEWSGROUP is nil, return the global KILL file instead."
5018   (cond ((or (null newsgroup)
5019              (string-equal newsgroup ""))
5020          ;; The global KILL file is placed at top of the directory.
5021          (expand-file-name gnus-kill-file-name
5022                            (or gnus-kill-files-directory "~/News")))
5023         (gnus-use-long-file-name
5024          ;; Append ".KILL" to newsgroup name.
5025          (expand-file-name (concat newsgroup "." gnus-kill-file-name)
5026                            (or gnus-kill-files-directory "~/News")))
5027         (t
5028          ;; Place "KILL" under the hierarchical directory.
5029          (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
5030                                    "/" gnus-kill-file-name)
5031                            (or gnus-kill-files-directory "~/News")))
5032         ))
5033
5034 ;; For subscribing new newsgroup
5035
5036 (defun gnus-subscribe-randomly (newsgroup)
5037   "Subscribe new NEWSGROUP and insert it at the beginning of newsgroups."
5038   (gnus-subscribe-newsgroup newsgroup
5039                             (car (car gnus-newsrc-assoc))))
5040
5041 (defun gnus-subscribe-alphabetically (newgroup)
5042   "Subscribe new NEWSGROUP and insert it in strict alphabetic order."
5043   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
5044   (let ((groups gnus-newsrc-assoc)
5045         (before nil))
5046     (while (and (not before) groups)
5047       (if (string< newgroup (car (car groups)))
5048           (setq before (car (car groups)))
5049         (setq groups (cdr groups))))
5050     (gnus-subscribe-newsgroup newgroup before)
5051     ))
5052
5053 (defun gnus-subscribe-hierarchically (newgroup)
5054   "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order."
5055   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
5056   (save-excursion
5057     (set-buffer (find-file-noselect gnus-current-startup-file))
5058     (let ((groupkey newgroup)
5059           (before nil))
5060       (while (and (not before) groupkey)
5061         (goto-char (point-min))
5062         (let ((groupkey-re
5063                (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
5064           (while (and (re-search-forward groupkey-re nil t)
5065                       (progn
5066                         (setq before (buffer-substring
5067                                       (match-beginning 1) (match-end 1)))
5068                         (string< before newgroup)))
5069             ))
5070         ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
5071         (setq groupkey
5072               (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
5073                   (substring groupkey (match-beginning 1) (match-end 1)))))
5074       (gnus-subscribe-newsgroup newgroup before)
5075       )))
5076
5077 (defun gnus-subscribe-interactively (newsgroup)
5078   "Subscribe new NEWSGROUP interactively.
5079 It is inserted in hierarchical newsgroup order if subscribed.
5080 Unless, it is killed."
5081   (if (y-or-n-p (format "Subscribe new newsgroup: %s " newsgroup))
5082       (gnus-subscribe-hierarchically newsgroup)
5083     ;; Save in kill-ring
5084     (gnus-subscribe-newsgroup newsgroup)
5085     (gnus-kill-newsgroup newsgroup)))
5086
5087 (defun gnus-subscribe-newsgroup (newsgroup &optional next)
5088   "Subscribe new NEWSGROUP.
5089 If optional argument NEXT is non-nil, it is inserted before NEXT."
5090   (gnus-insert-newsgroup (list newsgroup t) next)
5091   (message "Subscribe newsgroup: %s" newsgroup))
5092
5093 ;; For directories
5094
5095 (defun gnus-newsgroup-directory-form (newsgroup)
5096   "Make hierarchical directory name from NEWSGROUP name."
5097   (let ((newsgroup (substring newsgroup 0)) ;Copy string.
5098         (len (length newsgroup))
5099         (idx 0))
5100     ;; Replace all occurrences of `.' with `/'.
5101     (while (< idx len)
5102       (if (= (aref newsgroup idx) ?.)
5103           (aset newsgroup idx ?/))
5104       (setq idx (1+ idx)))
5105     newsgroup
5106     ))
5107
5108 (defun gnus-make-directory (directory)
5109   "Make DIRECTORY recursively."
5110   (let ((directory (expand-file-name directory default-directory)))
5111     (or (file-exists-p directory)
5112         (gnus-make-directory-1 "" directory))
5113     ))
5114
5115 (defun gnus-make-directory-1 (head tail)
5116   (cond ((string-match "^/\\([^/]+\\)" tail)
5117          ;; ange-ftp interferes with calling match-* after
5118          ;; calling file-name-as-directory.
5119          (let ((beg (match-beginning 1))
5120                (end (match-end 1)))
5121            (setq head (concat (file-name-as-directory head)
5122                               (substring tail beg end)))
5123            (or (file-exists-p head)
5124                (call-process "mkdir" nil nil nil head))
5125            (gnus-make-directory-1 head (substring tail end))))
5126         ((string-equal tail "") t)
5127         ))
5128
5129 (defun gnus-capitalize-newsgroup (newsgroup)
5130   "Capitalize NEWSGROUP name with treating '.' and '-' as part of words."
5131   ;; Suggested by "Jonathan I. Kamens" <jik@pit-manager.MIT.EDU>.
5132   (let ((current-syntax-table (syntax-table)))
5133     (unwind-protect
5134         (progn
5135           (set-syntax-table (copy-syntax-table current-syntax-table))
5136           (modify-syntax-entry ?- "w")
5137           (modify-syntax-entry ?. "w")
5138           (capitalize newsgroup))
5139       (set-syntax-table current-syntax-table))))
5140
5141 (defun gnus-simplify-subject (subject &optional re-only)
5142   "Remove `Re:' and words in parentheses.
5143 If optional argument RE-ONLY is non-nil, strip `Re:' only."
5144   (let ((case-fold-search t))           ;Ignore case.
5145     ;; Remove `Re:' and `Re^N:'.
5146     (if (string-match "\\`\\(re\\(\\^[0-9]+\\)?:[ \t]+\\)+" subject)
5147         (setq subject (substring subject (match-end 0))))
5148     ;; Remove words in parentheses from end.
5149     (or re-only
5150         (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject)
5151           (setq subject (substring subject 0 (match-beginning 0)))))
5152     ;; Return subject string.
5153     subject
5154     ))
5155
5156 (defun gnus-optional-lines-and-from (header)
5157   "Return a string like `NNN:AUTHOR' from HEADER."
5158   (let ((name-length (length "umerin@photon")))
5159     (substring (format "%3d:%s"
5160                        ;; Lines of the article.
5161                        ;; Suggested by dana@bellcore.com.
5162                        (nntp-header-lines header)
5163                        ;; Its author.
5164                        (concat (mail-strip-quoted-names
5165                                 (nntp-header-from header))
5166                                (make-string name-length ? )))
5167                ;; 4 stands for length of `NNN:'.
5168                0 (+ 4 name-length))))
5169
5170 (defun gnus-optional-lines (header)
5171   "Return a string like `NNN' from HEADER."
5172   (format "%4d" (nntp-header-lines header)))
5173
5174 ;; Basic ideas by flee@cs.psu.edu (Felix Lee)
5175
5176 (defun gnus-keysort-headers (predicate key &optional reverse)
5177   "Sort current headers by PREDICATE using a value passed by KEY safely.
5178 *Safely* means C-g quitting is disabled during sort.
5179 Optional argument REVERSE means reverse order."
5180   (let ((inhibit-quit t))
5181     (setq gnus-newsgroup-headers
5182           (if reverse
5183               (nreverse
5184                (gnus-keysort (nreverse gnus-newsgroup-headers) predicate key))
5185             (gnus-keysort gnus-newsgroup-headers predicate key)))
5186     ;; Make sure we don't have to call
5187     ;; gnus-clear-hashtables-for-newsgroup-headers to clear hash
5188     ;; tables for the variable gnus-newsgroup-headers since no new
5189     ;; entry is added to nor deleted from the variable.
5190     ))
5191
5192 (defun gnus-keysort (list predicate key)
5193   "Sort LIST by PREDICATE using a value passed by KEY."
5194   (mapcar (function cdr)
5195           (sort (mapcar (function (lambda (a) (cons (funcall key a) a))) list)
5196                 (function (lambda (a b)
5197                             (funcall predicate (car a) (car b)))))))
5198
5199 (defun gnus-sort-headers (predicate &optional reverse)
5200   "Sort current headers by PREDICATE safely.
5201 *Safely* means C-g quitting is disabled during sort.
5202 Optional argument REVERSE means reverse order."
5203   (let ((inhibit-quit t))
5204     (setq gnus-newsgroup-headers
5205           (if reverse
5206               (nreverse (sort (nreverse gnus-newsgroup-headers) predicate))
5207             (sort gnus-newsgroup-headers predicate)))
5208     ;; Make sure we don't have to call
5209     ;; gnus-clear-hashtables-for-newsgroup-headers to clear hash
5210     ;; tables for the variable gnus-newsgroup-headers since no new
5211     ;; entry is added to nor deleted from the variable.
5212     ))
5213
5214 (defun gnus-string-lessp (a b)
5215   "Return T if first arg string is less than second in lexicographic order.
5216 If case-fold-search is non-nil, case of letters is ignored."
5217   (if case-fold-search
5218       (string-lessp (downcase a) (downcase b))
5219     (string-lessp a b)))
5220
5221 (defun gnus-date-lessp (date1 date2)
5222   "Return T if DATE1 is earlyer than DATE2."
5223   (string-lessp (gnus-sortable-date date1)
5224                 (gnus-sortable-date date2)))
5225
5226 (defun gnus-sortable-date (date)
5227   "Make sortable string by string-lessp from DATE.
5228 Timezone package is used."
5229   (let* ((date   (timezone-fix-time date nil nil)) ;[Y M D H M S]
5230          (year   (aref date 0))
5231          (month  (aref date 1))
5232          (day    (aref date 2)))
5233     (timezone-make-sortable-date year month day
5234                                  (timezone-make-time-string
5235                                   (aref date 3) (aref date 4) (aref date 5)))
5236     ))
5237
5238 ;;(defun gnus-sortable-date (date)
5239 ;;  "Make sortable string by string-lessp from DATE."
5240 ;;  (let ((month '(("JAN" . " 1")("FEB" . " 2")("MAR" . " 3")
5241 ;;               ("APR" . " 4")("MAY" . " 5")("JUN" . " 6")
5242 ;;               ("JUL" . " 7")("AUG" . " 8")("SEP" . " 9")
5243 ;;               ("OCT" . "10")("NOV" . "11")("DEC" . "12")))
5244 ;;      (date (or date "")))
5245 ;;    ;; Can understand the following styles:
5246 ;;    ;; (1) 14 Apr 89 03:20:12 GMT
5247 ;;    ;; (2) Fri, 17 Mar 89 4:01:33 GMT
5248 ;;    (if (string-match
5249 ;;       "\\([0-9]+\\) \\([^ ,]+\\) \\([0-9]+\\) \\([0-9:]+\\)" date)
5250 ;;      (concat
5251 ;;       ;; Year
5252 ;;       (substring date (match-beginning 3) (match-end 3))
5253 ;;       ;; Month
5254 ;;       (cdr
5255 ;;        (assoc
5256 ;;         (upcase (substring date (match-beginning 2) (match-end 2))) month))
5257 ;;       ;; Day
5258 ;;       (format "%2d" (string-to-int
5259 ;;                      (substring date
5260 ;;                                 (match-beginning 1) (match-end 1))))
5261 ;;       ;; Time
5262 ;;       (substring date (match-beginning 4) (match-end 4)))
5263 ;;      ;; Cannot understand DATE string.
5264 ;;      date
5265 ;;      )
5266 ;;    ))
5267
5268 (defun gnus-fetch-field (field)
5269   "Return the value of the header FIELD of current article."
5270   (save-excursion
5271     (save-restriction
5272       (widen)
5273       (goto-char (point-min))
5274       (narrow-to-region (point-min)
5275                         (progn (search-forward "\n\n" nil 'move) (point)))
5276       (mail-fetch-field field))))
5277
5278 (fset 'gnus-expunge 'gnus-summary-delete-marked-with)
5279
5280 (defun gnus-kill (field regexp &optional command all)
5281   "If FIELD of an article matches REGEXP, execute COMMAND.
5282 Optional 1st argument COMMAND is default to
5283         (gnus-summary-mark-as-read nil \"X\").
5284 If optional 2nd argument ALL is non-nil, articles marked are also applied to.
5285 If FIELD is an empty string (or nil), entire article body is searched for.
5286 COMMAND must be a lisp expression or a string representing a key sequence."
5287   ;; We don't want to change current point nor window configuration.
5288   (save-excursion
5289     (save-window-excursion
5290       ;; Selected window must be Summary buffer to execute keyboard
5291       ;; macros correctly. See command_loop_1.
5292       (switch-to-buffer gnus-summary-buffer 'norecord)
5293       (goto-char (point-min))           ;From the beginning.
5294       (if (null command)
5295           (setq command '(gnus-summary-mark-as-read nil "X")))
5296       (gnus-execute field regexp command nil (not all))
5297       )))
5298
5299 (defun gnus-execute (field regexp form &optional backward ignore-marked)
5300   "If FIELD of article header matches REGEXP, execute lisp FORM (or a string).
5301 If FIELD is an empty string (or nil), entire article body is searched for.
5302 If optional 1st argument BACKWARD is non-nil, do backward instead.
5303 If optional 2nd argument IGNORE-MARKED is non-nil, articles which are
5304 marked as read or unread are ignored."
5305   (let ((function nil)
5306         (header nil)
5307         (article nil))
5308     (if (string-equal field "")
5309         (setq field nil))
5310     (if (null field)
5311         nil
5312       (or (stringp field)
5313           (setq field (symbol-name field)))
5314       ;; Get access function of header filed.
5315       (setq function (intern-soft (concat "gnus-header-" (downcase field))))
5316       (if (and function (fboundp function))
5317           (setq function (symbol-function function))
5318         (error "Unknown header field: \"%s\"" field)))
5319     ;; Make FORM funcallable.
5320     (if (and (listp form) (not (eq (car form) 'lambda)))
5321         (setq form (list 'lambda nil form)))
5322     ;; Starting from the current article.
5323     (or (and ignore-marked
5324              ;; Articles marked as read and unread should be ignored.
5325              (setq article (gnus-summary-article-number))
5326              (or (not (memq article gnus-newsgroup-unreads)) ;Marked as read.
5327                  (memq article gnus-newsgroup-marked) ;Marked as unread.
5328                  ))
5329         (gnus-execute-1 function regexp form))
5330     (while (gnus-summary-search-subject backward ignore-marked nil)
5331       (gnus-execute-1 function regexp form))
5332     ))
5333
5334 (defun gnus-execute-1 (function regexp form)
5335   (save-excursion
5336     ;; The point of Summary buffer must be saved during execution.
5337     (let ((article (gnus-summary-article-number)))
5338       (if (null article)
5339           nil                           ;Nothing to do.
5340         (if function
5341             ;; Compare with header field.
5342             (let (;;(header (gnus-find-header-by-number
5343                   ;;        gnus-newsgroup-headers article))
5344                   (header (gnus-get-header-by-number article))
5345                   (value nil))
5346               (and header
5347                    (progn
5348                      (setq value (funcall function header))
5349                      ;; Number (Lines:) or symbol must be converted to string.
5350                      (or (stringp value)
5351                          (setq value (prin1-to-string value)))
5352                      (string-match regexp value))
5353                    (if (stringp form)   ;Keyboard macro.
5354                        (execute-kbd-macro form)
5355                      (funcall form))))
5356           ;; Search article body.
5357           (let ((gnus-current-article nil) ;Save article pointer.
5358                 (gnus-last-article nil)
5359                 (gnus-break-pages nil)  ;No need to break pages.
5360                 (gnus-mark-article-hook nil)) ;Inhibit marking as read.
5361             (message "Searching for article: %d..." article)
5362             (gnus-article-setup-buffer)
5363             (gnus-article-prepare article t)
5364             (if (save-excursion
5365                   (set-buffer gnus-article-buffer)
5366                   (goto-char (point-min))
5367                   (re-search-forward regexp nil t))
5368                 (if (stringp form)      ;Keyboard macro.
5369                     (execute-kbd-macro form)
5370                   (funcall form))))
5371           ))
5372       )))
5373
5374 ;;; caesar-region written by phr@prep.ai.mit.edu  Nov 86
5375 ;;; modified by tower@prep Nov 86
5376 ;;; Modified by umerin@flab.flab.Fujitsu.JUNET for ROT47.
5377
5378 (defun gnus-caesar-region (&optional n)
5379   "Caesar rotation of region by N, default 13, for decrypting netnews.
5380 ROT47 will be performed for Japanese text in any case."
5381   (interactive (if current-prefix-arg   ; Was there a prefix arg?
5382                    (list (prefix-numeric-value current-prefix-arg))
5383                  (list nil)))
5384   (cond ((not (numberp n)) (setq n 13))
5385         (t (setq n (mod n 26))))        ;canonicalize N
5386   (if (not (zerop n))           ; no action needed for a rot of 0
5387       (progn
5388         (if (or (not (boundp 'caesar-translate-table))
5389                 (/= (aref caesar-translate-table ?a) (+ ?a n)))
5390             (let ((i 0) (lower "abcdefghijklmnopqrstuvwxyz") upper)
5391               (message "Building caesar-translate-table...")
5392               (setq caesar-translate-table (make-vector 256 0))
5393               (while (< i 256)
5394                 (aset caesar-translate-table i i)
5395                 (setq i (1+ i)))
5396               (setq lower (concat lower lower) upper (upcase lower) i 0)
5397               (while (< i 26)
5398                 (aset caesar-translate-table (+ ?a i) (aref lower (+ i n)))
5399                 (aset caesar-translate-table (+ ?A i) (aref upper (+ i n)))
5400                 (setq i (1+ i)))
5401               ;; ROT47 for Japanese text.
5402               ;; Thanks to ichikawa@flab.fujitsu.junet.
5403               (setq i 161)
5404               (let ((t1 (logior ?O 128))
5405                     (t2 (logior ?! 128))
5406                     (t3 (logior ?~ 128)))
5407                 (while (< i 256)
5408                   (aset caesar-translate-table i
5409                         (let ((v (aref caesar-translate-table i)))
5410                           (if (<= v t1) (if (< v t2) v (+ v 47))
5411                             (if (<= v t3) (- v 47) v))))
5412                   (setq i (1+ i))))
5413               (message "Building caesar-translate-table... done")))
5414         (let ((from (region-beginning))
5415               (to (region-end))
5416               (i 0) str len)
5417           (setq str (buffer-substring from to))
5418           (setq len (length str))
5419           (while (< i len)
5420             (aset str i (aref caesar-translate-table (aref str i)))
5421             (setq i (1+ i)))
5422           (goto-char from)
5423           (delete-region from to)
5424           (insert str)))))
5425
5426 ;; Functions accessing headers.
5427 ;; Functions are more convenient than macros in some case.
5428
5429 (defun gnus-header-number (header)
5430   "Return article number in HEADER."
5431   (nntp-header-number header))
5432
5433 (defun gnus-header-subject (header)
5434   "Return subject string in HEADER."
5435   (nntp-header-subject header))
5436
5437 (defun gnus-header-from (header)
5438   "Return author string in HEADER."
5439   (nntp-header-from header))
5440
5441 (defun gnus-header-xref (header)
5442   "Return xref string in HEADER."
5443   (nntp-header-xref header))
5444
5445 (defun gnus-header-lines (header)
5446   "Return lines in HEADER."
5447   (nntp-header-lines header))
5448
5449 (defun gnus-header-date (header)
5450   "Return date in HEADER."
5451   (nntp-header-date header))
5452
5453 (defun gnus-header-id (header)
5454   "Return Id in HEADER."
5455   (nntp-header-id header))
5456
5457 (defun gnus-header-references (header)
5458   "Return references in HEADER."
5459   (nntp-header-references header))
5460
5461 \f
5462 ;;;
5463 ;;; Article savers.
5464 ;;;
5465
5466 (defun gnus-output-to-rmail (file-name)
5467   "Append the current article to an Rmail file named FILE-NAME."
5468   (require 'rmail)
5469   ;; Most of these codes are borrowed from rmailout.el.
5470   (setq file-name (expand-file-name file-name))
5471   (setq rmail-default-rmail-file file-name)
5472   (let ((artbuf (current-buffer))
5473         (tmpbuf (get-buffer-create " *GNUS-output*")))
5474     (save-excursion
5475       (or (get-file-buffer file-name)
5476           (file-exists-p file-name)
5477           (if (yes-or-no-p
5478                (concat "\"" file-name "\" does not exist, create it? "))
5479               (let ((file-buffer (create-file-buffer file-name)))
5480                 (save-excursion
5481                   (set-buffer file-buffer)
5482                   (rmail-insert-rmail-file-header)
5483                   (let ((require-final-newline nil))
5484                     (write-region (point-min) (point-max) file-name t 1)))
5485                 (kill-buffer file-buffer))
5486             (error "Output file does not exist")))
5487       (set-buffer tmpbuf)
5488       (buffer-flush-undo (current-buffer))
5489       (erase-buffer)
5490       (insert-buffer-substring artbuf)
5491       (gnus-convert-article-to-rmail)
5492       ;; Decide whether to append to a file or to an Emacs buffer.
5493       (let ((outbuf (get-file-buffer file-name)))
5494         (if (not outbuf)
5495             (append-to-file (point-min) (point-max) file-name)
5496           ;; File has been visited, in buffer OUTBUF.
5497           (set-buffer outbuf)
5498           (let ((buffer-read-only nil)
5499                 (msg (and (boundp 'rmail-current-message)
5500                           rmail-current-message)))
5501             ;; If MSG is non-nil, buffer is in RMAIL mode.
5502             (if msg
5503                 (progn (widen)
5504                        (narrow-to-region (point-max) (point-max))))
5505             (insert-buffer-substring tmpbuf)
5506             (if msg
5507                 (progn
5508                   (goto-char (point-min))
5509                   (widen)
5510                   (search-backward "\^_")
5511                   (narrow-to-region (point) (point-max))
5512                   (goto-char (1+ (point-min)))
5513                   (rmail-count-new-messages t)
5514                   (rmail-show-message msg))))))
5515       )
5516     (kill-buffer tmpbuf)
5517     ))
5518
5519 (defun gnus-output-to-file (file-name)
5520   "Append the current article to a file named FILE-NAME."
5521   (setq file-name (expand-file-name file-name))
5522   (let ((artbuf (current-buffer))
5523         (tmpbuf (get-buffer-create " *GNUS-output*")))
5524     (save-excursion
5525       (set-buffer tmpbuf)
5526       (buffer-flush-undo (current-buffer))
5527       (erase-buffer)
5528       (insert-buffer-substring artbuf)
5529       ;; Append newline at end of the buffer as separator, and then
5530       ;; save it to file.
5531       (goto-char (point-max))
5532       (insert "\n")
5533       (append-to-file (point-min) (point-max) file-name))
5534     (kill-buffer tmpbuf)
5535     ))
5536
5537 (defun gnus-convert-article-to-rmail ()
5538   "Convert article in current buffer to Rmail message format."
5539   (let ((buffer-read-only nil))
5540     ;; Convert article directly into Babyl format.
5541     ;; Suggested by Rob Austein <sra@lcs.mit.edu>
5542     (goto-char (point-min))
5543     (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
5544     (while (search-forward "\n\^_" nil t) ;single char
5545       (replace-match "\n^_"))           ;2 chars: "^" and "_"
5546     (goto-char (point-max))
5547     (insert "\^_")))
5548
5549 ;;(defun gnus-convert-article-to-rmail ()
5550 ;;  "Convert article in current buffer to Rmail message format."
5551 ;;  (let ((buffer-read-only nil))
5552 ;;    ;; Insert special header of Unix mail.
5553 ;;    (goto-char (point-min))
5554 ;;    (insert "From "
5555 ;;          (or (mail-strip-quoted-names (mail-fetch-field "from"))
5556 ;;              "unknown")
5557 ;;          " " (current-time-string) "\n")
5558 ;;    ;; Stop quoting `From' since this seems unnecessary in most cases.
5559 ;;    ;; ``Quote'' "\nFrom " as "\n>From "
5560 ;;    ;;(while (search-forward "\nFrom " nil t)
5561 ;;    ;;  (forward-char -5)
5562 ;;    ;;  (insert ?>))
5563 ;;    ;; Convert article to babyl format.
5564 ;;    (rmail-convert-to-babyl-format)
5565 ;;    ))
5566
5567 \f
5568 ;;;
5569 ;;; Internal functions.
5570 ;;;
5571
5572 (defun gnus-start-news-server (&optional confirm)
5573   "Open network stream to remote NNTP server.
5574 If optional argument CONFIRM is non-nil, ask you host that NNTP server
5575 is running even if it is defined.
5576 Run gnus-open-server-hook just before opening news server."
5577   (if (gnus-server-opened)
5578       ;; Stream is already opened.
5579       nil
5580     ;; Open NNTP server.
5581     (if (or confirm
5582             (null gnus-nntp-server))
5583         ;; If someone has set the service to nil, then this should always
5584         ;; be the local host.
5585         (if gnus-nntp-service
5586             (if (and (boundp 'gnus-secondary-servers) gnus-secondary-servers)
5587                 ;; Read server name with completion.
5588                 (setq gnus-nntp-server
5589                       (completing-read "NNTP server: "
5590                                        (cons (list gnus-nntp-server)
5591                                              gnus-secondary-servers)
5592                                        nil nil gnus-nntp-server))
5593               (setq gnus-nntp-server
5594                     (read-string "NNTP server: " gnus-nntp-server)))
5595           (setq gnus-nntp-server "")))
5596     ;; If no server name is given, local host is assumed.
5597     (if (or (string-equal gnus-nntp-server "")
5598             (string-equal gnus-nntp-server "::")) ;RMS preference.
5599         (setq gnus-nntp-server (system-name)))
5600     ;; gnus-nntp-server must be either (system-name), ':DIRECTORY', or
5601     ;; nntp server name.  I mean '::' cannot be a value of
5602     ;; gnus-nntp-server.
5603     (cond ((and (null gnus-nntp-service)
5604                 (string-equal gnus-nntp-server (system-name)))
5605            (require 'nnspool)
5606            (gnus-define-access-method 'nnspool)
5607            (message "Looking up local news spool..."))
5608           ((string-match ":" gnus-nntp-server)
5609            ;; :DIRECTORY
5610            (require 'mhspool)
5611            (gnus-define-access-method 'mhspool)
5612            (message "Looking up private directory..."))
5613           (t
5614            (gnus-define-access-method 'nntp)
5615            (message "Connecting to NNTP server on %s..." gnus-nntp-server)))
5616     (run-hooks 'gnus-open-server-hook)
5617     (cond ((gnus-server-opened)         ;Maybe opened in gnus-open-server-hook.
5618            (message ""))
5619           ((gnus-open-server gnus-nntp-server gnus-nntp-service)
5620            (message ""))
5621           (t
5622            (error "%s"
5623             (gnus-nntp-message
5624              (format "Cannot open NNTP server on %s" gnus-nntp-server)))))
5625     ))
5626
5627 ;; Dummy functions used only once. Should return nil.
5628 (defun gnus-server-opened () nil)
5629 (defun gnus-close-server () nil)
5630
5631 (defun gnus-nntp-message (&optional message)
5632   "Return a message returned from NNTP server.
5633 If no message is available and optional MESSAGE is given, return it."
5634   (let ((status (gnus-status-message))
5635         (message (or message "")))
5636     (if (and (stringp status)
5637              (> (length status) 0))
5638         status message)))
5639
5640 (defun gnus-define-access-method (method &optional access-methods)
5641   "Define access functions for the access METHOD.
5642 Methods definition is taken from optional argument ACCESS-METHODS or
5643 the variable gnus-access-methods."
5644   (let ((bindings
5645          (cdr (assoc method (or access-methods gnus-access-methods)))))
5646     (if (null bindings)
5647         (error "Unknown access method: %s" method)
5648       ;; Should not use symbol-function here since overload does not work.
5649       (while bindings
5650         ;; Alist syntax is different from that of 3.14.3.
5651         (fset (car (car bindings)) (car (cdr (car bindings))))
5652         (setq bindings (cdr bindings)))
5653       )))
5654
5655 (defun gnus-select-newsgroup (group &optional show-all)
5656   "Select newsgroup GROUP.
5657 If optional argument SHOW-ALL is non-nil, all of articles in the group
5658 are selected."
5659   ;; Make sure a connection to NNTP server is alive.
5660   (gnus-start-news-server)
5661   (if (gnus-request-group group)
5662       (let ((articles nil))
5663         (setq gnus-newsgroup-name group)
5664         (setq gnus-newsgroup-unreads
5665               (gnus-uncompress-sequence
5666                (nthcdr 2 (gnus-gethash group gnus-unread-hashtb))))
5667         (cond (show-all
5668                ;; Select all active articles.
5669                (setq articles
5670                      (gnus-uncompress-sequence
5671                       (nthcdr 2 (gnus-gethash group gnus-active-hashtb)))))
5672               (t
5673                ;; Select unread articles only.
5674                (setq articles gnus-newsgroup-unreads)))
5675         ;; Require confirmation if selecting large newsgroup.
5676         (setq gnus-newsgroup-unselected nil)
5677         (if (not (numberp gnus-large-newsgroup))
5678             nil
5679           (let ((selected nil)
5680                 (number (length articles)))
5681             (if (> number gnus-large-newsgroup)
5682                 (progn
5683                   (condition-case ()
5684                       (let ((input
5685                              (read-string
5686                               (format
5687                                "How many articles from %s (default %d): "
5688                                gnus-newsgroup-name number))))
5689                         (setq selected
5690                               (if (string-equal input "")
5691                                   number (string-to-int input))))
5692                     (quit
5693                      (setq selected 0)))
5694                   (cond ((and (> selected 0)
5695                               (< selected number))
5696                          ;; Select last N articles.
5697                          (setq articles (nthcdr (- number selected) articles)))
5698                         ((and (< selected 0)
5699                               (< (- 0 selected) number))
5700                          ;; Select first N articles.
5701                          (setq selected (- 0 selected))
5702                          (setq articles (copy-sequence articles))
5703                          (setcdr (nthcdr (1- selected) articles) nil))
5704                         ((zerop selected)
5705                          (setq articles nil))
5706                         ;; Otherwise select all.
5707                         )
5708                   ;; Get unselected unread articles.
5709                   (setq gnus-newsgroup-unselected
5710                         (gnus-set-difference gnus-newsgroup-unreads articles))
5711                   ))
5712             ))
5713         ;; Get headers list.
5714         (setq gnus-newsgroup-headers (gnus-retrieve-headers articles))
5715         ;; UNREADS may contain expired articles, so we have to remove
5716         ;;  them from the list.
5717         (setq gnus-newsgroup-unreads
5718               (gnus-intersection gnus-newsgroup-unreads
5719                                  (mapcar
5720                                   (function
5721                                    (lambda (header)
5722                                      (nntp-header-number header)))
5723                                   gnus-newsgroup-headers)))
5724         ;; Marked article must be a subset of unread articles.
5725         (setq gnus-newsgroup-marked
5726               (gnus-intersection (append gnus-newsgroup-unselected
5727                                          gnus-newsgroup-unreads)
5728                                  (cdr
5729                                   (gnus-gethash group gnus-marked-hashtb))))
5730         ;; First and last article in this newsgroup.
5731         (setq gnus-newsgroup-begin
5732               (if gnus-newsgroup-headers
5733                   (nntp-header-number (car gnus-newsgroup-headers))
5734                 0
5735                 ))
5736         (setq gnus-newsgroup-end
5737               (if gnus-newsgroup-headers
5738                   (nntp-header-number
5739                    (gnus-last-element gnus-newsgroup-headers))
5740                 0
5741                 ))
5742         ;; File name that an article was saved last.
5743         (setq gnus-newsgroup-last-rmail nil)
5744         (setq gnus-newsgroup-last-mail nil)
5745         (setq gnus-newsgroup-last-folder nil)
5746         (setq gnus-newsgroup-last-file nil)
5747         ;; Reset article pointer etc.
5748         (setq gnus-current-article nil)
5749         (setq gnus-current-headers nil)
5750         (setq gnus-current-history nil)
5751         (setq gnus-have-all-headers nil)
5752         (setq gnus-last-article nil)
5753         ;; Clear old hash tables for the variable gnus-newsgroup-headers.
5754         (gnus-clear-hashtables-for-newsgroup-headers)
5755         ;; GROUP is successfully selected.
5756         t
5757         )
5758     ))
5759
5760 ;; Hacking for making header search much faster.
5761
5762 (defun gnus-get-header-by-number (number)
5763   "Return a header specified by a NUMBER.
5764 If the variable gnus-newsgroup-headers is updated, the hashed table
5765 gnus-newsgroup-headers-hashtb-by-number must be set to nil to indicate
5766 rehash is necessary."
5767   (or gnus-newsgroup-headers-hashtb-by-number
5768       (gnus-make-headers-hashtable-by-number))
5769   (gnus-gethash (int-to-string number)
5770                 gnus-newsgroup-headers-hashtb-by-number))
5771
5772 (defun gnus-get-header-by-id (id)
5773   "Return a header specified by an ID.
5774 If the variable gnus-newsgroup-headers is updated, the hashed table
5775 gnus-newsgroup-headers-hashtb-by-id must be set to nil to indicate
5776 rehash is necessary."
5777   (or gnus-newsgroup-headers-hashtb-by-id
5778       (gnus-make-headers-hashtable-by-id))
5779   (and (stringp id)
5780        (gnus-gethash id gnus-newsgroup-headers-hashtb-by-id)))
5781
5782 (defun gnus-make-headers-hashtable-by-number ()
5783   "Make hashtable for the variable gnus-newsgroup-headers by number."
5784   (let ((header nil)
5785         (headers gnus-newsgroup-headers))
5786     (setq gnus-newsgroup-headers-hashtb-by-number
5787           (gnus-make-hashtable (length headers)))
5788     (while headers
5789       (setq header (car headers))
5790       (gnus-sethash (int-to-string (nntp-header-number header))
5791                     header gnus-newsgroup-headers-hashtb-by-number)
5792       (setq headers (cdr headers))
5793       )))
5794
5795 (defun gnus-make-headers-hashtable-by-id ()
5796   "Make hashtable for the variable gnus-newsgroup-headers by id."
5797   (let ((header nil)
5798         (headers gnus-newsgroup-headers))
5799     (setq gnus-newsgroup-headers-hashtb-by-id
5800           (gnus-make-hashtable (length headers)))
5801     (while headers
5802       (setq header (car headers))
5803       (gnus-sethash (nntp-header-id header)
5804                     header gnus-newsgroup-headers-hashtb-by-id)
5805       (setq headers (cdr headers))
5806       )))
5807
5808 (defun gnus-clear-hashtables-for-newsgroup-headers ()
5809   "Clear hash tables created for the variable gnus-newsgroup-headers."
5810   (setq gnus-newsgroup-headers-hashtb-by-id nil)
5811   (setq gnus-newsgroup-headers-hashtb-by-number nil))
5812
5813 (defun gnus-more-header-backward ()
5814   "Find new header backward."
5815   (let ((first
5816          (car (nth 2 (gnus-gethash gnus-newsgroup-name gnus-active-hashtb))))
5817         (artnum gnus-newsgroup-begin)
5818         (header nil))
5819     (while (and (not header)
5820                 (> artnum first))
5821       (setq artnum (1- artnum))
5822       (setq header (car (gnus-retrieve-headers (list artnum)))))
5823     header
5824     ))
5825
5826 (defun gnus-more-header-forward ()
5827   "Find new header forward."
5828   (let ((last
5829          (cdr (nth 2 (gnus-gethash gnus-newsgroup-name gnus-active-hashtb))))
5830         (artnum gnus-newsgroup-end)
5831         (header nil))
5832     (while (and (not header)
5833                 (< artnum last))
5834       (setq artnum (1+ artnum))
5835       (setq header (car (gnus-retrieve-headers (list artnum)))))
5836     header
5837     ))
5838
5839 (defun gnus-extend-newsgroup (header &optional backward)
5840   "Extend newsgroup selection with HEADER.
5841 Optional argument BACKWARD means extend toward backward."
5842   (if header
5843       (let ((artnum (nntp-header-number header)))
5844         (setq gnus-newsgroup-headers
5845               (if backward
5846                   (cons header gnus-newsgroup-headers)
5847                 (append gnus-newsgroup-headers (list header))))
5848         ;; Clear current hash tables for the variable gnus-newsgroup-headers.
5849         (gnus-clear-hashtables-for-newsgroup-headers)
5850         ;; We have to update unreads and unselected, but don't have to
5851         ;; care about gnus-newsgroup-marked.
5852         (if (memq artnum gnus-newsgroup-unselected)
5853             (setq gnus-newsgroup-unreads
5854                   (cons artnum gnus-newsgroup-unreads)))
5855         (setq gnus-newsgroup-unselected
5856               (delq artnum gnus-newsgroup-unselected))
5857         (setq gnus-newsgroup-begin (min gnus-newsgroup-begin artnum))
5858         (setq gnus-newsgroup-end (max gnus-newsgroup-end artnum))
5859         )))
5860
5861 (defun gnus-mark-article-as-read (article)
5862   "Remember that ARTICLE is marked as read."
5863   ;; Remove from unread and marked list.
5864   (setq gnus-newsgroup-unreads
5865         (delq article gnus-newsgroup-unreads))
5866   (setq gnus-newsgroup-marked
5867         (delq article gnus-newsgroup-marked)))
5868
5869 (defun gnus-mark-article-as-unread (article &optional clear-mark)
5870   "Remember that ARTICLE is marked as unread.
5871 Optional argument CLEAR-MARK means ARTICLE should not be remembered
5872 that it was marked as read once."
5873   ;; Add to unread list.
5874   (or (memq article gnus-newsgroup-unreads)
5875       (setq gnus-newsgroup-unreads
5876             (cons article gnus-newsgroup-unreads)))
5877   ;; If CLEAR-MARK is non-nil, the article must be removed from marked
5878   ;; list.  Otherwise, it must be added to the list.
5879   (if clear-mark
5880       (setq gnus-newsgroup-marked
5881             (delq article gnus-newsgroup-marked))
5882     (or (memq article gnus-newsgroup-marked)
5883         (setq gnus-newsgroup-marked
5884               (cons article gnus-newsgroup-marked)))))
5885
5886 (defun gnus-clear-system ()
5887   "Clear all variables and buffer."
5888   ;; Clear GNUS variables.
5889   (let ((variables gnus-variable-list))
5890     (while variables
5891       (set (car variables) nil)
5892       (setq variables (cdr variables))))
5893   ;; Clear other internal variables.
5894   (setq gnus-newsrc-hashtb nil)
5895   (setq gnus-marked-hashtb nil)
5896   (setq gnus-killed-hashtb nil)
5897   (setq gnus-active-hashtb nil)
5898   (setq gnus-octive-hashtb nil)
5899   (setq gnus-unread-hashtb nil)
5900   (setq gnus-newsgroup-headers nil)
5901   (setq gnus-newsgroup-headers-hashtb-by-id nil)
5902   (setq gnus-newsgroup-headers-hashtb-by-number nil)
5903   ;; Kill the startup file.
5904   (and gnus-current-startup-file
5905        (get-file-buffer gnus-current-startup-file)
5906        (kill-buffer (get-file-buffer gnus-current-startup-file)))
5907   (setq gnus-current-startup-file nil)
5908   ;; Kill GNUS buffers.
5909   (let ((buffers gnus-buffer-list))
5910     (while buffers
5911       (if (get-buffer (car buffers))
5912           (kill-buffer (car buffers)))
5913       (setq buffers (cdr buffers))
5914       )))
5915
5916 (defun gnus-configure-windows (action)
5917   "Configure GNUS windows according to the next ACTION.
5918 The ACTION is either a symbol, such as `summary', or a
5919 configuration list such as `(1 1 2)'.  If ACTION is not a list,
5920 configuration list is got from the variable gnus-window-configuration."
5921   (let* ((windows
5922           (if (listp action)
5923               action (car (cdr (assq action gnus-window-configuration)))))
5924          (grpwin (get-buffer-window gnus-group-buffer))
5925          (subwin (get-buffer-window gnus-summary-buffer))
5926          (artwin (get-buffer-window gnus-article-buffer))
5927          (winsum nil)
5928          (height nil)
5929          (grpheight 0)
5930          (subheight 0)
5931          (artheight 0))
5932     (if (or (null windows)              ;No configuration is specified.
5933             (and (eq (null grpwin)
5934                      (zerop (nth 0 windows)))
5935                  (eq (null subwin)
5936                      (zerop (nth 1 windows)))
5937                  (eq (null artwin)
5938                      (zerop (nth 2 windows)))))
5939         ;; No need to change window configuration.
5940         nil
5941       (select-window (or grpwin subwin artwin (selected-window)))
5942       ;; First of all, compute the height of each window.
5943       (cond (gnus-use-full-window
5944              ;; Take up the entire screen.
5945              (delete-other-windows)
5946              (setq height (window-height (selected-window))))
5947             (t
5948              (setq height (+ (if grpwin (window-height grpwin) 0)
5949                              (if subwin (window-height subwin) 0)
5950                              (if artwin (window-height artwin) 0)))))
5951       ;; The Newsgroup buffer exits always. So, use it to extend the
5952       ;; Group window so as to get enough window space.
5953       (switch-to-buffer gnus-group-buffer 'norecord)
5954       (and (get-buffer gnus-summary-buffer)
5955            (delete-windows-on gnus-summary-buffer))
5956       (and (get-buffer gnus-article-buffer)
5957            (delete-windows-on gnus-article-buffer))
5958       ;; Compute expected window height.
5959       (setq winsum (apply (function +) windows))
5960       (if (not (zerop (nth 0 windows)))
5961           (setq grpheight (max window-min-height
5962                                (/ (* height (nth 0 windows)) winsum))))
5963       (if (not (zerop (nth 1 windows)))
5964           (setq subheight (max window-min-height
5965                                (/ (* height (nth 1 windows)) winsum))))
5966       (if (not (zerop (nth 2 windows)))
5967           (setq artheight (max window-min-height
5968                                (/ (* height (nth 2 windows)) winsum))))
5969       (setq height (+ grpheight subheight artheight))
5970       (enlarge-window (max 0 (- height (window-height (selected-window)))))
5971       ;; Then split the window.
5972       (and (not (zerop artheight))
5973            (or (not (zerop grpheight))
5974                (not (zerop subheight)))
5975            (split-window-vertically (+ grpheight subheight)))
5976       (and (not (zerop grpheight))
5977            (not (zerop subheight))
5978            (split-window-vertically grpheight))
5979       ;; Then select buffers in each window.
5980       (and (not (zerop grpheight))
5981            (progn
5982              (switch-to-buffer gnus-group-buffer 'norecord)
5983              (other-window 1)))
5984       (and (not (zerop subheight))
5985            (progn
5986              (switch-to-buffer gnus-summary-buffer 'norecord)
5987              (other-window 1)))
5988       (and (not (zerop artheight))
5989            (progn
5990              ;; If Article buffer does not exist, it will be created
5991              ;; and initialized.
5992              (gnus-article-setup-buffer)
5993              (switch-to-buffer gnus-article-buffer 'norecord)))
5994       )
5995     ))
5996
5997 (defun gnus-find-header-by-number (headers number)
5998   "Return a header which is a element of HEADERS and has NUMBER."
5999   (let ((found nil))
6000     (while (and headers (not found))
6001       ;; We cannot use `=' to accept non-numeric NUMBER.
6002       (if (eq number (nntp-header-number (car headers)))
6003           (setq found (car headers)))
6004       (setq headers (cdr headers)))
6005     found
6006     ))
6007
6008 (defun gnus-find-header-by-id (headers id)
6009   "Return a header which is a element of HEADERS and has Message-ID."
6010   (let ((found nil))
6011     (while (and headers (not found))
6012       (if (string-equal id (nntp-header-id (car headers)))
6013           (setq found (car headers)))
6014       (setq headers (cdr headers)))
6015     found
6016     ))
6017
6018 (defun gnus-version ()
6019   "Version numbers of this version of GNUS."
6020   (interactive)
6021   (cond ((and (boundp 'mhspool-version) (boundp 'nnspool-version))
6022          (message "%s; %s; %s; %s"
6023                   gnus-version nntp-version nnspool-version mhspool-version))
6024         ((boundp 'mhspool-version)
6025          (message "%s; %s; %s"
6026                   gnus-version nntp-version mhspool-version))
6027         ((boundp 'nnspool-version)
6028          (message "%s; %s; %s"
6029                   gnus-version nntp-version nnspool-version))
6030         (t
6031          (message "%s; %s" gnus-version nntp-version))))
6032
6033 (defun gnus-info-find-node ()
6034   "Find Info documentation of GNUS."
6035   (interactive)
6036   (require 'info)
6037   ;; Enlarge info window if needed.
6038   (cond ((eq major-mode 'gnus-group-mode)
6039          (gnus-configure-windows '(1 0 0)) ;Take all windows.
6040          (pop-to-buffer gnus-group-buffer))
6041         ((eq major-mode 'gnus-summary-mode)
6042          (gnus-configure-windows '(0 1 0)) ;Take all windows.
6043          (pop-to-buffer gnus-summary-buffer)))
6044   (Info-goto-node (car (cdr (assq major-mode gnus-info-nodes)))))
6045
6046 (defun gnus-overload-functions (&optional overloads)
6047   "Overload functions specified by optional argument OVERLOADS.
6048 If nothing is specified, use the variable gnus-overload-functions."
6049   (let ((defs nil)
6050         (overloads (or overloads gnus-overload-functions)))
6051     (while overloads
6052       (setq defs (car overloads))
6053       (setq overloads (cdr overloads))
6054       ;; Load file before overloading function if necessary.  Make
6055       ;; sure we cannot use `require' always.
6056       (and (not (fboundp (car defs)))
6057            (car (cdr (cdr defs)))
6058            (load (car (cdr (cdr defs))) nil 'nomessage))
6059       (fset (car defs) (car (cdr defs)))
6060       )))
6061
6062 (defun gnus-make-threads (newsgroup-headers)
6063   "Make conversation threads tree from NEWSGROUP-HEADERS."
6064   (let ((headers newsgroup-headers)
6065         (refer nil)
6066         (h nil)
6067         (d nil)
6068         (roots nil)
6069         (dependencies nil))
6070     ;; Make message dependency alist.
6071     (while headers
6072       (setq h (car headers))
6073       (setq headers (cdr headers))
6074       ;; Ignore invalid headers.
6075       (if (vectorp h)                   ;Depends on nntp.el.
6076           (progn
6077             ;; Ignore broken references, e.g "<123@a.b.c".
6078             (setq refer (nntp-header-references h))
6079             (setq d (and refer
6080                          (string-match "\\(<[^<>]+>\\)[^>]*$" refer)
6081 ;;                       (gnus-find-header-by-id
6082 ;;                        newsgroup-headers
6083 ;;                        (substring refer (match-beginning 1) (match-end 1)))
6084                          ;; In fact if the variable newsgroup-headers
6085                          ;; is not 'equal' to the variable
6086                          ;; gnus-newsgroup-headers, the following
6087                          ;; function call may return bogus value.
6088                          (gnus-get-header-by-id
6089                           (substring refer (match-beginning 1) (match-end 1)))
6090                          ))
6091             ;; Check subject equality.
6092             (or gnus-thread-ignore-subject
6093                 (null d)
6094                 (string-equal (gnus-simplify-subject
6095                                (nntp-header-subject h) 're)
6096                               (gnus-simplify-subject
6097                                (nntp-header-subject d) 're))
6098                 ;; H should be a thread root.
6099                 (setq d nil))
6100             ;; H depends on D.
6101             (setq dependencies
6102                   (cons (cons h d) dependencies))
6103             ;; H is a thread root.
6104             (if (null d)
6105                 (setq roots (cons h roots)))
6106             ))
6107       )
6108     ;; Make complete threads from the roots.
6109     ;; Note: dependencies are in reverse order, but
6110     ;; gnus-make-threads-1 processes it in reverse order again.  So,
6111     ;; we don't have to worry about it.
6112     (mapcar
6113      (function
6114       (lambda (root)
6115         (gnus-make-threads-1 root dependencies))) (nreverse roots))
6116     ))
6117
6118 (defun gnus-make-threads-1 (parent dependencies)
6119   (let ((children nil)
6120         (d nil)
6121         (depends dependencies))
6122     ;; Find children.
6123     (while depends
6124       (setq d (car depends))
6125       (setq depends (cdr depends))
6126       (and (cdr d)
6127            (eq (nntp-header-id parent) (nntp-header-id (cdr d)))
6128            (setq children (cons (car d) children))))
6129     ;; Go down.
6130     (cons parent
6131           (mapcar
6132            (function
6133             (lambda (child)
6134               (gnus-make-threads-1 child dependencies))) children))
6135     ))
6136
6137 (defun gnus-narrow-to-page (&optional arg)
6138   "Make text outside current page invisible except for page delimiter.
6139 A numeric arg specifies to move forward or backward by that many pages,
6140 thus showing a page other than the one point was originally in."
6141   (interactive "P")
6142   (setq arg (if arg (prefix-numeric-value arg) 0))
6143   (save-excursion
6144     (forward-page -1)                   ;Beginning of current page.
6145     (widen)
6146     (if (> arg 0)
6147         (forward-page arg)
6148       (if (< arg 0)
6149           (forward-page (1- arg))))
6150     ;; Find the end of the page.
6151     (forward-page)
6152     ;; If we stopped due to end of buffer, stay there.
6153     ;; If we stopped after a page delimiter, put end of restriction
6154     ;; at the beginning of that line.
6155     ;; These are commented out.
6156     ;;    (if (save-excursion (beginning-of-line)
6157     ;;                  (looking-at page-delimiter))
6158     ;;  (beginning-of-line))
6159     (narrow-to-region (point)
6160                       (progn
6161                         ;; Find the top of the page.
6162                         (forward-page -1)
6163                         ;; If we found beginning of buffer, stay there.
6164                         ;; If extra text follows page delimiter on same line,
6165                         ;; include it.
6166                         ;; Otherwise, show text starting with following line.
6167                         (if (and (eolp) (not (bobp)))
6168                             (forward-line 1))
6169                         (point)))
6170     ))
6171
6172 ;; Create hash table for alist, such as gnus-newsrc-assoc,
6173 ;; gnus-killed-assoc, and gnus-marked-assoc.
6174
6175 (defun gnus-make-hashtable-from-alist (alist &optional hashsize)
6176   "Return hash table for ALIST.
6177 Optional argument HASHSIZE specifies the hashtable size.
6178 Hash key is a car of alist element, which must be a string."
6179   (let ((hashtb (gnus-make-hashtable (or hashsize (length alist)))))
6180     (while alist
6181       (gnus-sethash (car (car alist))   ;Newsgroup name
6182                     (car alist)         ;Alist element
6183                     hashtb)
6184       (setq alist (cdr alist)))
6185     hashtb
6186     ))
6187
6188 (defun gnus-last-element (list)
6189   "Return last element of LIST."
6190   (let ((last nil))
6191     (while list
6192       (if (null (cdr list))
6193           (setq last (car list)))
6194       (setq list (cdr list)))
6195     last
6196     ))
6197
6198 (defun gnus-set-difference (list1 list2)
6199   "Return a list of elements of LIST1 that do not appear in LIST2."
6200   (let ((list1 (copy-sequence list1)))
6201     (while list2
6202       (setq list1 (delq (car list2) list1))
6203       (setq list2 (cdr list2)))
6204     list1
6205     ))
6206
6207 (defun gnus-intersection (list1 list2)
6208   "Return a list of elements that appear in both LIST1 and LIST2."
6209   (let ((result nil))
6210     (while list2
6211       (if (memq (car list2) list1)
6212           (setq result (cons (car list2) result)))
6213       (setq list2 (cdr list2)))
6214     result
6215     ))
6216
6217 \f
6218 ;;;
6219 ;;; Get information about active articles, already read articles, and
6220 ;;;  still unread articles.
6221 ;;;
6222
6223 ;; GNUS internal format of gnus-newsrc-assoc and gnus-killed-assoc:
6224 ;; (("general" t (1 . 1))
6225 ;;  ("misc"    t (1 . 10) (12 . 15))
6226 ;;  ("test"  nil (1 . 99)) ...)
6227 ;; GNUS internal format of gnus-marked-assoc:
6228 ;; (("general" 1 2 3)
6229 ;;  ("misc" 2) ...)
6230 ;; GNUS internal format of gnus-active-hashtb:
6231 ;; (("general" t (1 . 1))
6232 ;;  ("misc"    t (1 . 10))
6233 ;;  ("test"  nil (1 . 99)) ...)
6234 ;; GNUS internal format of gnus-unread-hashtb:
6235 ;; (("general" 1 (1 . 1))
6236 ;;  ("misc"   14 (1 . 10) (12 . 15))
6237 ;;  ("test"   99 (1 . 99)) ...)
6238
6239 (defun gnus-setup-news (&optional rawfile)
6240   "Setup news information.
6241 If optional argument RAWFILE is non-nil, force to read raw startup file."
6242   (let ((init (not (and gnus-newsrc-assoc
6243                         gnus-active-hashtb
6244                         gnus-unread-hashtb
6245                         (not rawfile)
6246                         ))))
6247     ;; We have to clear some variables to re-initialize news info.
6248     (if init
6249         (setq gnus-newsrc-assoc nil
6250               gnus-active-hashtb nil
6251               gnus-unread-hashtb nil))
6252     (gnus-read-active-file)
6253     ;; Initialize only once.
6254     (if init
6255         (progn
6256           ;; Get distributions only once.
6257           (gnus-read-distributions-file)
6258           ;; newsrc file must be read after reading active file since
6259           ;; its size is used to guess the size of gnus-newsrc-hashtb.
6260           (gnus-read-newsrc-file rawfile)
6261           ))
6262     (gnus-expire-marked-articles)
6263     (gnus-get-unread-articles)
6264     ;; Check new newsgroups and subscribe them.
6265     (if init
6266         (let ((new-newsgroups (gnus-find-new-newsgroups)))
6267           (while new-newsgroups
6268             (funcall gnus-subscribe-newsgroup-method (car new-newsgroups))
6269             (setq new-newsgroups (cdr new-newsgroups))
6270             )))
6271     ))
6272
6273 (defun gnus-add-newsgroup (newsgroup)
6274   "Subscribe new NEWSGROUP safely and put it at top."
6275   (and (null (gnus-gethash newsgroup gnus-newsrc-hashtb)) ;Really new?
6276        (gnus-gethash newsgroup gnus-active-hashtb) ;Really exist?
6277        (gnus-insert-newsgroup (or (gnus-gethash newsgroup gnus-killed-hashtb)
6278                                   (list newsgroup t))
6279                               (car (car gnus-newsrc-assoc)))))
6280
6281 (defun gnus-find-new-newsgroups ()
6282   "Looking for new newsgroups and return names.
6283 `-n' option of options line in .newsrc file is recognized."
6284   (let ((group nil)
6285         (new-newsgroups nil))
6286     (mapatoms
6287      (function
6288       (lambda (sym)
6289         (setq group (symbol-name sym))
6290         ;; Taking account of `-n' option.
6291         (and (or (null gnus-newsrc-options-n-no)
6292                  (not (string-match gnus-newsrc-options-n-no group))
6293                  (and gnus-newsrc-options-n-yes
6294                       (string-match gnus-newsrc-options-n-yes group)))
6295              (null (gnus-gethash group gnus-killed-hashtb)) ;Ignore killed.
6296              (null (gnus-gethash group gnus-newsrc-hashtb)) ;Really new.
6297              ;; Find new newsgroup.
6298              (setq new-newsgroups
6299                    (cons group new-newsgroups)))
6300         ))
6301      gnus-active-hashtb)
6302     ;; Return new newsgroups.
6303     new-newsgroups
6304     ))
6305
6306 (defun gnus-kill-newsgroup (group)
6307   "Kill GROUP from gnus-newsrc-assoc, .newsrc and gnus-unread-hashtb."
6308   (let ((info (gnus-gethash group gnus-newsrc-hashtb)))
6309     (if (null info)
6310         nil
6311       ;; Delete from gnus-newsrc-assoc and gnus-newsrc-hashtb.
6312       (setq gnus-newsrc-assoc (delq info gnus-newsrc-assoc))
6313       (gnus-sethash group nil gnus-newsrc-hashtb)
6314       ;; Add to gnus-killed-assoc and gnus-killed-hashtb.
6315       (setq gnus-killed-assoc
6316             (cons info
6317                   (delq (gnus-gethash group gnus-killed-hashtb)
6318                         gnus-killed-assoc)))
6319       (gnus-sethash group info gnus-killed-hashtb)
6320       ;; Clear unread hashtable.
6321       ;; Thanks cwitty@csli.Stanford.EDU (Carl Witty).
6322       (gnus-sethash group nil gnus-unread-hashtb)
6323       ;; Then delete from .newsrc
6324       (gnus-update-newsrc-buffer group 'delete)
6325       ;; Return the deleted newsrc entry.
6326       info
6327       )))
6328
6329 (defun gnus-insert-newsgroup (info &optional next)
6330   "Insert newsrc INFO entry before NEXT.
6331 If optional argument NEXT is nil, appended to the last."
6332   (if (null info)
6333       (error "Invalid argument: %s" info))
6334   (let* ((group (car info))             ;Newsgroup name.
6335          (range
6336           (gnus-difference-of-range
6337            (nth 2 (gnus-gethash group gnus-active-hashtb)) (nthcdr 2 info))))
6338     ;; Check duplication.
6339     (if (gnus-gethash group gnus-newsrc-hashtb)
6340         (error "Duplicated: %s" group))
6341     ;; Insert to gnus-newsrc-assoc and gnus-newsrc-hashtb.
6342     (if (string-equal next (car (car gnus-newsrc-assoc)))
6343         (setq gnus-newsrc-assoc
6344               (cons info gnus-newsrc-assoc))
6345       (let ((found nil)
6346             (rest (cdr gnus-newsrc-assoc))
6347             (tail gnus-newsrc-assoc))
6348         ;; Seach insertion point.
6349         (while (and (not found) rest)
6350           (if (string-equal next (car (car rest)))
6351               (setq found t)
6352             (setq rest (cdr rest))
6353             (setq tail (cdr tail))
6354             ))
6355         ;; Find it.
6356         (if (consp tail)
6357             (setcdr tail (cons info rest))
6358           ;; gnus-newsrc-assoc must be nil.
6359           (setq gnus-newsrc-assoc
6360                 (append gnus-newsrc-assoc (cons info rest))))
6361         ))
6362     (gnus-sethash group info gnus-newsrc-hashtb)
6363     ;; Delete from gnus-killed-assoc and gnus-killed-hashtb.
6364     (setq gnus-killed-assoc
6365           (delq (gnus-gethash group gnus-killed-hashtb) gnus-killed-assoc))
6366     (gnus-sethash group nil gnus-killed-hashtb)
6367     ;; Then insert to .newsrc.
6368     (gnus-update-newsrc-buffer group nil next)
6369     ;; Add to gnus-unread-hashtb.
6370     (gnus-sethash group
6371                   (cons group           ;Newsgroup name.
6372                         (cons (gnus-number-of-articles range) range))
6373                   gnus-unread-hashtb)
6374     ))
6375
6376 (defun gnus-check-killed-newsgroups ()
6377   "Check consistency between gnus-newsrc-assoc and gnus-killed-assoc.
6378 gnus-killed-hashtb is also updated."
6379   (let ((group nil)
6380         (new-killed nil)
6381         (old-killed gnus-killed-assoc))
6382     (while old-killed
6383       (setq group (car (car old-killed)))
6384       (and (or (null gnus-newsrc-options-n-no)
6385                (not (string-match gnus-newsrc-options-n-no group))
6386                (and gnus-newsrc-options-n-yes
6387                     (string-match gnus-newsrc-options-n-yes group)))
6388            (null (gnus-gethash group gnus-newsrc-hashtb)) ;No duplication.
6389            ;; Subscribed in options line and not in gnus-newsrc-assoc.
6390            (setq new-killed
6391                  (cons (car old-killed) new-killed)))
6392       (setq old-killed (cdr old-killed))
6393       )
6394     (setq gnus-killed-assoc (nreverse new-killed))
6395     (setq gnus-killed-hashtb
6396           (gnus-make-hashtable-from-alist gnus-killed-assoc))
6397     ))
6398
6399 (defun gnus-check-bogus-newsgroups (&optional confirm)
6400   "Delete bogus newsgroups.
6401 If optional argument CONFIRM is non-nil, confirm deletion of newsgroups."
6402   (let ((group nil)                     ;Newsgroup name temporary used.
6403         (old-newsrc gnus-newsrc-assoc)
6404         (new-newsrc nil)
6405         (bogus nil)                     ;List of bogus newsgroups.
6406         (old-killed gnus-killed-assoc)
6407         (new-killed nil)
6408         (old-marked gnus-marked-assoc)
6409         (new-marked nil))
6410     (message "Checking bogus newsgroups...")
6411     ;; Update gnus-newsrc-assoc and gnus-newsrc-hashtb.
6412     (while old-newsrc
6413       (setq group (car (car old-newsrc)))
6414       (if (or (gnus-gethash group gnus-active-hashtb)
6415               (and confirm
6416                    (not (y-or-n-p
6417                          (format "Delete bogus newsgroup: %s " group)))))
6418           ;; Active newsgroup.
6419           (setq new-newsrc (cons (car old-newsrc) new-newsrc))
6420         ;; Found a bogus newsgroup.
6421         (setq bogus (cons group bogus)))
6422       (setq old-newsrc (cdr old-newsrc))
6423       )
6424     (setq gnus-newsrc-assoc (nreverse new-newsrc))
6425     (setq gnus-newsrc-hashtb
6426           (gnus-make-hashtable-from-alist gnus-newsrc-assoc))
6427     ;; Update gnus-killed-assoc and gnus-killed-hashtb.
6428     ;; The killed newsgroups are deleted without any confirmations.
6429     (while old-killed
6430       (setq group (car (car old-killed)))
6431       (and (gnus-gethash group gnus-active-hashtb)
6432            (null (gnus-gethash group gnus-newsrc-hashtb))
6433            ;; Active and really killed newsgroup.
6434            (setq new-killed (cons (car old-killed) new-killed)))
6435       (setq old-killed (cdr old-killed))
6436       )
6437     (setq gnus-killed-assoc (nreverse new-killed))
6438     (setq gnus-killed-hashtb
6439           (gnus-make-hashtable-from-alist gnus-killed-assoc))
6440     ;; Remove BOGUS from .newsrc file.
6441     (while bogus
6442       (gnus-update-newsrc-buffer (car bogus) 'delete)
6443       (setq bogus (cdr bogus)))
6444     ;; Update gnus-marked-assoc and gnus-marked-hashtb.
6445     (while old-marked
6446       (setq group (car (car old-marked)))
6447       (if (and (cdr (car old-marked))   ;Non-empty?
6448                (gnus-gethash group gnus-newsrc-hashtb)) ;Not bogus?
6449           (setq new-marked (cons (car old-marked) new-marked)))
6450       (setq old-marked (cdr old-marked)))
6451     (setq gnus-marked-assoc new-marked)
6452     (setq gnus-marked-hashtb
6453           (gnus-make-hashtable-from-alist gnus-marked-assoc))
6454     (message "Checking bogus newsgroups... done")
6455     ))
6456
6457 (defun gnus-get-unread-articles ()
6458   "Compute diffs between active and read articles."
6459   (let ((read gnus-newsrc-assoc)
6460         (group-info nil)
6461         (group-name nil)
6462         (active nil)
6463         (range nil))
6464     (message "Checking new news...")
6465     (or gnus-unread-hashtb
6466         (setq gnus-unread-hashtb
6467               (gnus-make-hashtable (length gnus-active-hashtb))))
6468     (while read
6469       (setq group-info (car read))      ;About one newsgroup
6470       (setq group-name (car group-info))
6471       (setq active (nth 2 (gnus-gethash group-name gnus-active-hashtb)))
6472       (if (and gnus-octive-hashtb
6473                ;; Is nothing changed?
6474                (equal active
6475                       (nth 2 (gnus-gethash group-name gnus-octive-hashtb)))
6476                ;; Is this newsgroup in the unread hash table?
6477                (gnus-gethash group-name gnus-unread-hashtb)
6478                )
6479           nil                           ;Nothing to do.
6480         (setq range (gnus-difference-of-range active (nthcdr 2 group-info)))
6481         (gnus-sethash group-name
6482                       (cons group-name  ;Group name
6483                             (cons (gnus-number-of-articles range)
6484                                   range)) ;Range of unread articles
6485                       gnus-unread-hashtb)
6486         )
6487       (setq read (cdr read))
6488       )
6489     (message "Checking new news... done")
6490     ))
6491
6492 (defun gnus-expire-marked-articles ()
6493   "Check expired article which is marked as unread."
6494   (let ((marked-assoc gnus-marked-assoc)
6495         (updated-assoc nil)
6496         (marked nil)                    ;Current marked info.
6497         (articles nil)                  ;List of marked articles.
6498         (updated nil)                   ;List of real marked.
6499         (begin nil))
6500     (while marked-assoc
6501       (setq marked (car marked-assoc))
6502       (setq articles (cdr marked))
6503       (setq updated nil)
6504       (setq begin
6505             (car (nth 2 (gnus-gethash (car marked) gnus-active-hashtb))))
6506       (while (and begin articles)
6507         (if (>= (car articles) begin)
6508             ;; This article is still active.
6509             (setq updated (cons (car articles) updated)))
6510         (setq articles (cdr articles)))
6511       (if updated
6512           (setq updated-assoc
6513                 (cons (cons (car marked) updated) updated-assoc)))
6514       (setq marked-assoc (cdr marked-assoc)))
6515     (setq gnus-marked-assoc updated-assoc)
6516     (setq gnus-marked-hashtb
6517           (gnus-make-hashtable-from-alist gnus-marked-assoc))
6518     ))
6519
6520 (defun gnus-mark-as-read-by-xref
6521   (group headers unreads &optional subscribed-only)
6522   "Mark articles as read using cross references and return updated newsgroups.
6523 Arguments are GROUP, HEADERS, UNREADS, and optional SUBSCRIBED-ONLY."
6524   (let ((xref-list nil)
6525         (header nil)
6526         (xrefs nil)                     ;One Xref: field info.
6527         (xref nil)                      ;(NEWSGROUP . ARTICLE)
6528         (gname nil)                     ;Newsgroup name
6529         (article nil))                  ;Article number
6530     (while headers
6531       (setq header (car headers))
6532       (if (memq (nntp-header-number header) unreads)
6533           ;; This article is not yet marked as read.
6534           nil
6535         (setq xrefs (gnus-parse-xref-field (nntp-header-xref header)))
6536         ;; For each cross reference info. in one Xref: field.
6537         (while xrefs
6538           (setq xref (car xrefs))
6539           (setq gname (car xref))       ;Newsgroup name
6540           (setq article (cdr xref))     ;Article number
6541           (or (string-equal group gname) ;Ignore current newsgroup.
6542               ;; Ignore unsubscribed newsgroup if requested.
6543               (and subscribed-only
6544                    (not (nth 1 (gnus-gethash gname gnus-newsrc-hashtb))))
6545               ;; Ignore article marked as unread.
6546               (memq article (cdr (gnus-gethash gname gnus-marked-hashtb)))
6547               (let ((group-xref (assoc gname xref-list)))
6548                 (if group-xref
6549                     (if (memq article (cdr group-xref))
6550                         nil             ;Alread marked.
6551                       (setcdr group-xref (cons article (cdr group-xref))))
6552                   ;; Create new assoc entry for GROUP.
6553                   (setq xref-list (cons (list gname article) xref-list)))
6554                 ))
6555           (setq xrefs (cdr xrefs))
6556           ))
6557       (setq headers (cdr headers)))
6558     ;; Mark cross referenced articles as read.
6559     (gnus-mark-xrefed-as-read xref-list)
6560     ;;(message "%s %s" (prin1-to-string unreads) (prin1-to-string xref-list))
6561     ;; Return list of updated group name.
6562     (mapcar (function car) xref-list)
6563     ))
6564
6565 (defun gnus-parse-xref-field (xref-value)
6566   "Parse Xref: field value, and return list of `(group . article-id)'."
6567   (let ((xref-list nil)
6568         (xref-value (or xref-value "")))
6569     ;; Remove server host name.
6570     (if (string-match "^[ \t]*[^ \t,]+[ \t,]+\\(.*\\)$" xref-value)
6571         (setq xref-value (substring xref-value (match-beginning 1)))
6572       (setq xref-value nil))
6573     ;; Process each xref info.
6574     (while xref-value
6575       (if (string-match
6576            "^[ \t,]*\\([^ \t,]+\\):\\([0-9]+\\)[^0-9]*" xref-value)
6577           (progn
6578             (setq xref-list
6579                   (cons
6580                    (cons
6581                     ;; Group name
6582                     (substring xref-value (match-beginning 1) (match-end 1))
6583                     ;; Article-ID
6584                     (string-to-int
6585                      (substring xref-value (match-beginning 2) (match-end 2))))
6586                    xref-list))
6587             (setq xref-value (substring xref-value (match-end 2))))
6588         (setq xref-value nil)))
6589     ;; Return alist.
6590     xref-list
6591     ))
6592
6593 (defun gnus-mark-xrefed-as-read (xrefs)
6594   "Update unread article information using XREFS alist."
6595   (let ((group nil)
6596         (idlist nil)
6597         (unread nil))
6598     (while xrefs
6599       (setq group (car (car xrefs)))
6600       (setq idlist (cdr (car xrefs)))
6601       (setq unread (gnus-uncompress-sequence
6602                     (nthcdr 2 (gnus-gethash group gnus-unread-hashtb))))
6603       (while idlist
6604         (setq unread (delq (car idlist) unread))
6605         (setq idlist (cdr idlist)))
6606       (gnus-update-unread-articles group unread 'ignore)
6607       (setq xrefs (cdr xrefs))
6608       )))
6609
6610 (defun gnus-update-unread-articles (group unread-list marked-list)
6611   "Update unread articles of GROUP using UNREAD-LIST and MARKED-LIST."
6612   (let ((active (nth 2 (gnus-gethash group gnus-active-hashtb)))
6613         (unread (gnus-gethash group gnus-unread-hashtb)))
6614     (if (or (null active) (null unread))
6615         ;; Ignore unknown newsgroup.
6616         nil
6617       ;; Update gnus-unread-hashtb.
6618       (if unread-list
6619           (setcdr (cdr unread)
6620                   (gnus-compress-sequence unread-list))
6621         ;; All of the articles are read.
6622         (setcdr (cdr unread) '((0 . 0))))
6623       ;; Number of unread articles.
6624       (setcar (cdr unread)
6625               (gnus-number-of-articles (nthcdr 2 unread)))
6626       ;; Update gnus-newsrc-assoc.
6627       (if (> (car active) 0)
6628           ;; Articles from 1 to N are not active.
6629           (setq active (cons 1 (cdr active))))
6630       (setcdr (cdr (gnus-gethash group gnus-newsrc-hashtb))
6631               (gnus-difference-of-range active (nthcdr 2 unread)))
6632       ;; Update .newsrc buffer.
6633       (gnus-update-newsrc-buffer group)
6634       ;; Update gnus-marked-assoc.
6635       (if (listp marked-list)           ;Includes NIL.
6636           (let ((marked (gnus-gethash group gnus-marked-hashtb)))
6637             (cond (marked               ;There is an entry.
6638                    (setcdr marked marked-list))
6639                   (marked-list          ;Non-NIL.
6640                    (let ((info (cons group marked-list)))
6641                      ;; hashtb must share the same cons cell.
6642                      (setq gnus-marked-assoc
6643                            (cons info gnus-marked-assoc))
6644                      (gnus-sethash group info gnus-marked-hashtb)
6645                      ))
6646                   )))
6647       )))
6648
6649 (defun gnus-read-active-file ()
6650   "Get active file from NNTP server."
6651   ;; Make sure a connection to NNTP server is alive.
6652   (gnus-start-news-server)
6653   (message "Reading active file...")
6654   (if (gnus-request-list)               ;Get active file from server
6655       (save-excursion
6656         (set-buffer nntp-server-buffer)
6657         (gnus-active-to-gnus-format)
6658         (message "Reading active file... done"))
6659     (error "Cannot read active file from NNTP server.")))
6660
6661 (defun gnus-active-to-gnus-format ()
6662   "Convert active file format to internal format.
6663 Lines matching gnus-ignored-newsgroups are ignored."
6664   ;; Delete unnecessary lines.
6665   (goto-char (point-min))
6666   ;;(delete-matching-lines "^to\\..*$")
6667   (delete-matching-lines gnus-ignored-newsgroups)
6668   ;; Save OLD active info.
6669   (setq gnus-octive-hashtb gnus-active-hashtb)
6670   ;; Make large enough hash table.
6671   (setq gnus-active-hashtb
6672         (gnus-make-hashtable (count-lines (point-min) (point-max))))
6673   ;; Store active file in hashtable.
6674   (goto-char (point-min))
6675   (while
6676       (re-search-forward
6677        "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([ymn]\\).*$"
6678        nil t)
6679     (gnus-sethash
6680      (buffer-substring (match-beginning 1) (match-end 1))
6681      (list (buffer-substring (match-beginning 1) (match-end 1))
6682            (string-equal
6683             "y" (buffer-substring (match-beginning 4) (match-end 4)))
6684            (cons (string-to-int
6685                   (buffer-substring (match-beginning 3) (match-end 3)))
6686                  (string-to-int
6687                   (buffer-substring (match-beginning 2) (match-end 2)))))
6688      gnus-active-hashtb)
6689     ))
6690
6691 (defun gnus-read-newsrc-file (&optional rawfile)
6692   "Read startup FILE.
6693 If optional argument RAWFILE is non-nil, the raw startup file is read."
6694   (setq gnus-current-startup-file (gnus-make-newsrc-file gnus-startup-file))
6695   ;; Reset variables which may be included in the quick startup file.
6696   (let ((variables gnus-variable-list))
6697     (while variables
6698       (set (car variables) nil)
6699       (setq variables (cdr variables))))
6700   (let* ((newsrc-file gnus-current-startup-file)
6701          (quick-file (concat newsrc-file ".el"))
6702          (quick-loaded nil))
6703     (save-excursion
6704       ;; Prepare .newsrc buffer.
6705       (set-buffer (find-file-noselect newsrc-file))
6706       ;; It is not so good idea turning off undo.
6707       ;;(buffer-flush-undo (current-buffer))
6708       ;; Load quick .newsrc to restore gnus-marked-assoc and
6709       ;; gnus-killed-assoc even if gnus-newsrc-assoc is out of date.
6710       (condition-case nil
6711           (progn
6712             (setq quick-loaded (load quick-file t t t))
6713             ;; Recreate hashtables.
6714             (setq gnus-killed-hashtb
6715                   (gnus-make-hashtable-from-alist gnus-killed-assoc))
6716             (setq gnus-marked-hashtb
6717                   (gnus-make-hashtable-from-alist gnus-marked-assoc))
6718             )
6719         (error nil))
6720       (cond ((and (not rawfile)         ;Not forced to read the raw file.
6721                   ;; .newsrc.el is newer than .newsrc.
6722                   ;; Do it this way in case timestamps are identical
6723                   ;; (on fast machines/disks).
6724                   (not (file-newer-than-file-p newsrc-file quick-file))
6725                   quick-loaded
6726                   gnus-newsrc-assoc     ;Really loaded?
6727                   )
6728              ;; We don't have to read the raw startup file.
6729              ;; gnus-newsrc-assoc may be defined in the quick startup file.
6730              ;; So, we have to define the hashtable here.
6731              (setq gnus-newsrc-hashtb
6732                    (gnus-make-hashtable-from-alist gnus-newsrc-assoc)))
6733             (t
6734              ;; Since .newsrc file is newer than quick file, read it.
6735              (message "Reading %s..." newsrc-file)
6736              (gnus-newsrc-to-gnus-format)
6737              (gnus-check-killed-newsgroups)
6738              (message "Reading %s... Done" newsrc-file)))
6739       )))
6740
6741 (defun gnus-make-newsrc-file (file)
6742   "Make server dependent file name by catenating FILE and server host name."
6743   (let* ((file (expand-file-name file nil))
6744          (real-file (concat file "-" gnus-nntp-server)))
6745     (if (file-exists-p real-file)
6746         real-file file)
6747     ))
6748
6749 (defun gnus-newsrc-to-gnus-format ()
6750   "Parse current buffer as .newsrc file."
6751   (let ((newsgroup nil)
6752         (subscribe nil)
6753         (ranges nil)
6754         (subrange nil)
6755         (read-list nil))
6756     ;; We have to re-initialize these variable (except for
6757     ;; gnus-marked-assoc and gnus-killed-assoc) because quick startup
6758     ;; file may contain bogus values.
6759     (setq gnus-newsrc-options nil)
6760     (setq gnus-newsrc-options-n-yes nil)
6761     (setq gnus-newsrc-options-n-no nil)
6762     (setq gnus-newsrc-assoc nil)
6763     ;; Make large enough hash table.
6764     (setq gnus-newsrc-hashtb
6765           (gnus-make-hashtable
6766            (max (length gnus-active-hashtb)
6767                 (count-lines (point-min) (point-max)))))
6768     ;; Save options line to variable.
6769     ;; Lines beginning with white spaces are treated as continuation
6770     ;; line.  Refer man page of newsrc(5).
6771     (goto-char (point-min))
6772     (if (re-search-forward
6773          "^[ \t]*options[ \t]*\\(.*\\(\n[ \t]+.*\\)*\\)[ \t]*$" nil t)
6774         (progn
6775           ;; Save entire options line.
6776           (setq gnus-newsrc-options
6777                 (buffer-substring (match-beginning 1) (match-end 1)))
6778           ;; Compile "-n" option.
6779           (if (string-match "\\(^\\|[ \t\n]\\)-n" gnus-newsrc-options)
6780               (let ((yes-and-no
6781                      (gnus-parse-n-options
6782                       (substring gnus-newsrc-options (match-end 0)))))
6783                 (setq gnus-newsrc-options-n-yes (car yes-and-no))
6784                 (setq gnus-newsrc-options-n-no  (cdr yes-and-no))
6785                 ))
6786           ))
6787     ;; Parse body of .newsrc file
6788     ;; Options line continuation lines must be also considered here.
6789     ;; Before supporting continuation lines, " newsgroup ! 1-5" was
6790     ;; okay, but now it is invalid.  It should be "newsgroup! 1-5".
6791     (goto-char (point-min))
6792     ;; We used this regexp, but it caused overflows.
6793     ;; "^\\([^:! \t\n]+\\)\\([:!]\\)[ \t]*\\(.*\\)$"
6794     ;; Suggested by composer@bucsf.bu.edu (Jeff Kellem)
6795     ;; but no longer viable because of extensive backtracking in Emacs 19:
6796     ;; "^\\([^:! \t\n]+\\)\\([:!]\\)[ \t]*\\(\\(...\\)*.*\\)$"
6797     ;; but, the following causes trouble on some case:
6798     ;; "^\\([^:! \t\n]+\\)\\([:!]\\)[ \t]*\\(\\|[^ \t\n].*\\)$"
6799     ;; So now we don't try to match the tail of the line at all.
6800     ;; It's just as easy to extract it later.
6801     (while (re-search-forward "^\\([^:! \t\n]+\\)\\([:!]\\)"
6802                               nil t)
6803       (setq newsgroup (buffer-substring (match-beginning 1) (match-end 1)))
6804       ;; Check duplications of newsgroups.
6805       ;; Note: Checking the duplications takes very long time.
6806       (if (gnus-gethash newsgroup gnus-newsrc-hashtb)
6807           (message "Ignore duplicated newsgroup: %s" newsgroup)
6808         (setq subscribe
6809               (string-equal
6810                ":" (buffer-substring (match-beginning 2) (match-end 2))))
6811         (skip-chars-forward " \t")
6812         (setq ranges (buffer-substring (point) (save-excursion
6813                                                  (end-of-line) (point))))
6814         (setq read-list nil)
6815         (while (string-match "^[, \t]*\\([0-9-]+\\)" ranges)
6816           (setq subrange (substring ranges (match-beginning 1) (match-end 1)))
6817           (setq ranges (substring ranges (match-end 1)))
6818           (cond ((string-match "^\\([0-9]+\\)-\\([0-9]+\\)$" subrange)
6819                  (setq read-list
6820                        (cons
6821                         (cons (string-to-int
6822                                (substring subrange
6823                                           (match-beginning 1) (match-end 1)))
6824                               (string-to-int
6825                                (substring subrange
6826                                           (match-beginning 2) (match-end 2))))
6827                         read-list)))
6828                 ((string-match "^[0-9]+$" subrange)
6829                  (setq read-list
6830                        (cons (cons (string-to-int subrange)
6831                                    (string-to-int subrange))
6832                              read-list)))
6833                 (t
6834                  (ding) (message "Ignoring bogus lines of %s" newsgroup)
6835                  (sit-for 0))
6836                 ))
6837         (setq gnus-newsrc-assoc
6838               (cons (cons newsgroup (cons subscribe (nreverse read-list)))
6839                     gnus-newsrc-assoc))
6840         ;; Update gnus-newsrc-hashtb one by one.
6841         (gnus-sethash newsgroup (car gnus-newsrc-assoc) gnus-newsrc-hashtb)
6842         ))
6843     (setq gnus-newsrc-assoc (nreverse gnus-newsrc-assoc))
6844     ))
6845
6846 (defun gnus-parse-n-options (options)
6847   "Parse -n NEWSGROUPS options and return a cons of YES and NO regexps."
6848   (let ((yes nil)
6849         (no nil)
6850         (yes-or-no nil)                 ;`!' or not.
6851         (newsgroup nil))
6852     ;; Parse each newsgroup description such as "comp.all".  Commas
6853     ;; and white spaces can be a newsgroup separator.
6854     (while
6855         (string-match "^[ \t\n,]*\\(!?\\)\\([^- \t\n,][^ \t\n,]*\\)" options)
6856       (setq yes-or-no
6857             (substring options (match-beginning 1) (match-end 1)))
6858       (setq newsgroup
6859             (regexp-quote
6860              (substring options
6861                         (match-beginning 2) (match-end 2))))
6862       (setq options (substring options (match-end 2)))
6863       ;; Rewrite "all" to ".+" not ".*".  ".+" requires at least one
6864       ;; character.
6865       (while (string-match "\\(^\\|\\\\[.]\\)all\\(\\\\[.]\\|$\\)" newsgroup)
6866         (setq newsgroup
6867               (concat (substring newsgroup 0 (match-end 1))
6868                       ".+"
6869                       (substring newsgroup (match-beginning 2)))))
6870       ;; It is yes or no.
6871       (cond ((string-equal yes-or-no "!")
6872              (setq no (cons newsgroup no)))
6873             ((string-equal newsgroup ".+")) ;Ignore `all'.
6874             (t
6875              (setq yes (cons newsgroup yes))))
6876       )
6877     ;; Make a cons of regexps from parsing result.
6878     ;; We have to append \(\.\|$\) to prevent matching substring of
6879     ;; newsgroup.  For example, "jp.net" should not match with
6880     ;; "jp.network".
6881     ;; Fixes for large regexp problems are from yonezu@nak.math.keio.ac.jp.
6882     (cons (if yes
6883               (concat "^\\("
6884                       (apply (function concat)
6885                              (mapcar
6886                               (function
6887                                (lambda (newsgroup)
6888                                  (concat newsgroup "\\|")))
6889                               (cdr yes)))
6890                       (car yes) "\\)\\(\\.\\|$\\)"))
6891           (if no
6892               (concat "^\\("
6893                       (apply (function concat)
6894                              (mapcar
6895                               (function
6896                                (lambda (newsgroup)
6897                                  (concat newsgroup "\\|")))
6898                               (cdr no)))
6899                       (car no) "\\)\\(\\.\\|$\\)")))
6900     ))
6901
6902 (defun gnus-save-newsrc-file ()
6903   "Save to .newsrc FILE."
6904   ;; Note: We cannot save .newsrc file if all newsgroups are removed
6905   ;; from the variable gnus-newsrc-assoc.
6906   (and (or gnus-newsrc-assoc gnus-killed-assoc)
6907        gnus-current-startup-file
6908        (save-excursion
6909          ;; A buffer containing .newsrc file may be deleted.
6910          (set-buffer (find-file-noselect gnus-current-startup-file))
6911          (if (not (buffer-modified-p))
6912              (message "(No changes need to be saved)")
6913            (message "Saving %s..." gnus-current-startup-file)
6914            (let ((make-backup-files t)
6915                  (version-control nil)
6916                  (require-final-newline t)) ;Don't ask even if requested.
6917              ;; Make backup file of master newsrc.
6918              ;; You can stop or change version control of backup file.
6919              ;; Suggested by jason@violet.berkeley.edu.
6920              (run-hooks 'gnus-save-newsrc-hook)
6921              (save-buffer))
6922            ;; Quickly loadable .newsrc.
6923            (set-buffer (get-buffer-create " *GNUS-newsrc*"))
6924            (buffer-flush-undo (current-buffer))
6925            (erase-buffer)
6926            (gnus-gnus-to-quick-newsrc-format)
6927            (let ((make-backup-files nil)
6928                  (version-control nil)
6929                  (require-final-newline t)) ;Don't ask even if requested.
6930              (write-file (concat gnus-current-startup-file ".el")))
6931            (kill-buffer (current-buffer))
6932            (message "Saving %s... Done" gnus-current-startup-file)
6933            ))
6934     ))
6935
6936 (defun gnus-update-newsrc-buffer (group &optional delete next)
6937   "Incrementally update .newsrc buffer about GROUP.
6938 If optional 1st argument DELETE is non-nil, delete the group.
6939 If optional 2nd argument NEXT is non-nil, inserted before it."
6940   (save-excursion
6941     ;; Taking account of the killed startup file.
6942     ;; Suggested by tale@pawl.rpi.edu.
6943     (set-buffer (or (get-file-buffer gnus-current-startup-file)
6944                     (find-file-noselect gnus-current-startup-file)))
6945     ;; Options line continuation lines must be also considered here.
6946     ;; Before supporting continuation lines, " newsgroup ! 1-5" was
6947     ;; okay, but now it is invalid.  It should be "newsgroup! 1-5".
6948     (let ((deleted nil)
6949           (case-fold-search nil)        ;Should NOT ignore case.
6950           (buffer-read-only nil))       ;May be not modifiable.
6951       ;; Delete ALL entries which match for GROUP.
6952       (goto-char (point-min))
6953       (while (re-search-forward
6954               (concat "^" (regexp-quote group) "[:!]") nil t)
6955         (beginning-of-line)
6956         (delete-region (point) (progn (forward-line 1) (point)))
6957         (setq deleted t)                ;Old entry is deleted.
6958         )
6959       (if delete
6960           nil
6961         ;; Insert group entry.
6962         (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
6963           (if (null newsrc)
6964               nil
6965             ;; Find insertion point.
6966             (cond (deleted nil)         ;Insert here.
6967                   ((and (stringp next)
6968                         (progn
6969                           (goto-char (point-min))
6970                           (re-search-forward
6971                            (concat "^" (regexp-quote next) "[:!]") nil t)))
6972                    (beginning-of-line))
6973                   (t
6974                    (goto-char (point-max))
6975                    (or (bolp)
6976                        (insert "\n"))))
6977             ;; Insert after options line.
6978             (if (looking-at "^[ \t]*options\\([ \t]\\|$\\)")
6979                 (progn
6980                   (forward-line 1)
6981                   ;; Skip continuation lines.
6982                   (while (and (not (eobp))
6983                               (looking-at "^[ \t]+"))
6984                     (forward-line 1))))
6985             (insert group               ;Group name
6986                     (if (nth 1 newsrc) ": " "! ")) ;Subscribed?
6987             (gnus-ranges-to-newsrc-format (nthcdr 2 newsrc)) ;Read articles
6988             (insert "\n")
6989             )))
6990       )))
6991
6992 (defun gnus-gnus-to-quick-newsrc-format ()
6993   "Insert GNUS variables such as gnus-newsrc-assoc in lisp format."
6994   (insert ";; GNUS internal format of .newsrc.\n")
6995   (insert ";; Touch .newsrc instead if you think to remove this file.\n")
6996   (let ((variable nil)
6997         (variables gnus-variable-list)
6998         ;; Temporary rebind to make changes
6999         ;; gnus-check-killed-newsgroups in invisible.
7000         (gnus-killed-assoc gnus-killed-assoc)
7001         (gnus-killed-hashtb gnus-killed-hashtb))
7002     ;; Remove duplicated or unsubscribed newsgroups in
7003     ;; gnus-killed-assoc (and gnus-killed-hashtb).
7004     (gnus-check-killed-newsgroups)
7005     ;; Then, insert lisp expressions.
7006     (while variables
7007       (setq variable (car variables))
7008       (and (boundp variable)
7009            (symbol-value variable)
7010            (insert "(setq " (symbol-name variable) " '"
7011                    (prin1-to-string (symbol-value variable))
7012                    ")\n"))
7013       (setq variables (cdr variables)))
7014     ))
7015
7016 (defun gnus-ranges-to-newsrc-format (ranges)
7017   "Insert ranges of read articles."
7018   (let ((range nil))                    ;Range is a pair of BEGIN and END.
7019     (while ranges
7020       (setq range (car ranges))
7021       (setq ranges (cdr ranges))
7022       (cond ((= (car range) (cdr range))
7023              (if (= (car range) 0)
7024                  (setq ranges nil)      ;No unread articles.
7025                (insert (int-to-string (car range)))
7026                (if ranges (insert ","))
7027                ))
7028             (t
7029              (insert (int-to-string (car range))
7030                      "-"
7031                      (int-to-string (cdr range)))
7032              (if ranges (insert ","))
7033              ))
7034       )))
7035
7036 (defun gnus-compress-sequence (numbers)
7037   "Convert list of sorted numbers to ranges."
7038   (let* ((numbers (sort (copy-sequence numbers) (function <)))
7039          (first (car numbers))
7040          (last (car numbers))
7041          (result nil))
7042     (while numbers
7043       (cond ((= last (car numbers)) nil) ;Omit duplicated number
7044             ((= (1+ last) (car numbers)) ;Still in sequence
7045              (setq last (car numbers)))
7046             (t                          ;End of one sequence
7047              (setq result (cons (cons first last) result))
7048              (setq first (car numbers))
7049              (setq last  (car numbers)))
7050             )
7051       (setq numbers (cdr numbers))
7052       )
7053     (nreverse (cons (cons first last) result))
7054     ))
7055
7056 (defun gnus-uncompress-sequence (ranges)
7057   "Expand compressed format of sequence."
7058   (let ((first nil)
7059         (last  nil)
7060         (result nil))
7061     (while ranges
7062       (setq first (car (car ranges)))
7063       (setq last  (cdr (car ranges)))
7064       (while (< first last)
7065         (setq result (cons first result))
7066         (setq first (1+ first)))
7067       (setq result (cons first result))
7068       (setq ranges (cdr ranges))
7069       )
7070     (nreverse result)
7071     ))
7072
7073 (defun gnus-number-of-articles (range)
7074   "Compute number of articles from RANGE `((beg1 . end1) (beg2 . end2) ...)'."
7075   (let ((count 0))
7076     (while range
7077       (if (/= (cdr (car range)) 0)
7078           ;; If end1 is 0, it must be skipped. Usually no articles in
7079           ;;  this group.
7080           (setq count (+ count 1 (- (cdr (car range)) (car (car range))))))
7081       (setq range (cdr range))
7082       )
7083     count                               ;Result
7084     ))
7085
7086 (defun gnus-difference-of-range (src obj)
7087   "Compute (SRC - OBJ) on range.
7088 Range of SRC is expressed as `(beg . end)'.
7089 Range of OBJ is expressed as `((beg1 . end1) (beg2 . end2) ...)."
7090   (let ((beg (car src))
7091         (end (cdr src))
7092         (range nil))                    ;This is result.
7093     ;; Src may be nil.
7094     (while (and src obj)
7095       (let ((beg1 (car (car obj)))
7096             (end1 (cdr (car obj))))
7097         (cond ((> beg end)
7098                (setq obj nil))          ;Terminate loop
7099               ((< beg beg1)
7100                (setq range (cons (cons beg (min (1- beg1) end)) range))
7101                (setq beg (1+ end1)))
7102               ((>= beg beg1)
7103                (setq beg (max beg (1+ end1))))
7104               )
7105         (setq obj (cdr obj))            ;Next OBJ
7106         ))
7107     ;; Src may be nil.
7108     (if (and src (<= beg end))
7109         (setq range (cons (cons beg end) range)))
7110     ;; Result
7111     (if range
7112         (nreverse range)
7113       (list (cons 0 0)))
7114     ))
7115
7116 (defun gnus-read-distributions-file ()
7117   "Get distributions file from NNTP server (NNTP2 functionality)."
7118   ;; Make sure a connection to NNTP server is alive.
7119   (gnus-start-news-server)
7120   (message "Reading distributions file...")
7121   (setq gnus-distribution-list nil)
7122   (if (gnus-request-list-distributions)
7123       (save-excursion
7124         (set-buffer nntp-server-buffer)
7125         (gnus-distributions-to-gnus-format)
7126         (message "Reading distributions file... done"))
7127     ;; It's not a fatal error.
7128     ;;(error "Cannot read distributions file from NNTP server.")
7129     )
7130   ;; Merge with user supplied default distributions.
7131   (let ((defaults (reverse gnus-local-distributions))
7132         (dist nil))
7133     (while defaults
7134       (setq dist (assoc (car defaults) gnus-distribution-list))
7135       (if dist
7136           (setq gnus-distribution-list
7137                 (delq dist gnus-distribution-list)))
7138       (setq gnus-distribution-list
7139             (cons (list (car defaults)) gnus-distribution-list))
7140       (setq defaults (cdr defaults))
7141       )))
7142
7143 (defun gnus-distributions-to-gnus-format ()
7144   "Convert distributions file format to internal format."
7145   (setq gnus-distribution-list nil)
7146   (goto-char (point-min))
7147   (while (re-search-forward "^\\([^ \t\n]+\\).*$" nil t)
7148     (setq gnus-distribution-list
7149           (cons (list (buffer-substring (match-beginning 1) (match-end 1)))
7150                 gnus-distribution-list)))
7151   (setq gnus-distribution-list
7152         (nreverse gnus-distribution-list)))
7153
7154 ;; Some older version of GNU Emacs does not support function
7155 ;; `file-newer-than-file-p'.
7156
7157 (or (fboundp 'file-newer-than-file-p)
7158     (defun file-newer-than-file-p (file1 file2)
7159       "Return t if file FILE1 is newer than file FILE2.
7160 If FILE1 does not exist, the answer is nil;
7161 otherwise, if FILE2 does not exist, the answer is t."
7162       (let ((mod1 (nth 5 (file-attributes file1)))
7163             (mod2 (nth 5 (file-attributes file2))))
7164         (cond ((not (file-exists-p file1)) nil)
7165               ((not (file-exists-p file2)) t)
7166               ((and mod2 mod1)
7167                (or (< (car mod2) (car mod1))
7168                    (and (= (car mod2) (car mod1))
7169                         (<= (nth 1 mod2) (nth 1 mod1)))))
7170               ))))
7171
7172 \f
7173 (provide 'gnus)
7174
7175 ;;Local variables:
7176 ;;eval: (put 'gnus-eval-in-buffer-window 'lisp-indent-hook 1)
7177 ;;end:
7178
7179 ;;; gnus.el ends here