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