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