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