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