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