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

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