1 ;;; GNUS: an NNTP-based News Reader for GNU Emacs
2 ;; Copyright (C) 1987, 1988, 1989, 1990, 1993 Free Software Foundation, Inc.
4 ;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
5 ;; Version: $Header: /home/fsf/rms/e19/lisp/RCS/gnus.el,v 1.34 1994/03/12 00:22:13 kwzh Exp rms $
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
26 ;; How to Install GNUS:
27 ;; (0) First of all, remove GNUS related OLD *.elc files (at least
29 ;; (1) Unshar gnus.el, gnuspost.el, gnusmail.el, gnusmisc.el, and
31 ;; (2) byte-compile-file nntp.el, gnus.el, gnuspost.el, gnusmail.el,
32 ;; and gnusmisc.el. If you have a local news spool,
33 ;; byte-compile-file nnspool.el, too.
34 ;; (3) Define three environment variables in .login file as follows:
36 ;; setenv NNTPSERVER flab
37 ;; setenv DOMAINNAME "stars.flab.Fujitsu.CO.JP"
38 ;; setenv ORGANIZATION "Fujitsu Laboratories Ltd., Kawasaki, Japan."
40 ;; Or instead, define lisp variables in your .emacs, site-init.el,
41 ;; or default.el as follows:
43 ;; (setq gnus-nntp-server "flab")
44 ;; (setq gnus-local-domain "stars.flab.Fujitsu.CO.JP")
45 ;; (setq gnus-local-organization "Fujitsu Laboratories Ltd., ...")
47 ;; If the function (system-name) returns the full internet name,
48 ;; you don't have to define the domain.
50 ;; (4) You may have to define NNTP service name as number 119.
52 ;; (setq gnus-nntp-service 119)
54 ;; Or, if you'd like to use a local news spool directly in stead
55 ;; of NNTP, install nnspool.el and set the variable to nil as
58 ;; (setq gnus-nntp-service nil)
60 ;; (5) If you'd like to use the GENERICFROM feature like the Bnews,
61 ;; define the variable as follows:
63 ;; (setq gnus-use-generic-from t)
65 ;; (6) Define autoload entries in .emacs file as follows:
67 ;; (autoload 'gnus "gnus" "Read network news." t)
68 ;; (autoload 'gnus-post-news "gnuspost" "Post a news." t)
70 ;; (7) Read nntp.el if you have problems with NNTP or kanji handling.
72 ;; (8) Install mhspool.el, tcp.el, and tcp.c if it is necessary.
74 ;; mhspool.el is a package for reading articles or mail in your
75 ;; private directory using GNUS.
77 ;; tcp.el and tcp.c are necessary if and only if your Emacs does
78 ;; not have the function `open-network-stream' which is used for
79 ;; communicating with NNTP server inside Emacs.
81 ;; (9) Install an Info file generated from the texinfo manual gnus.texinfo.
83 ;; If you are not allowed to create the Info file to the standard
84 ;; Info-directory, create it in your private directory and set the
85 ;; variable gnus-info-directory to that directory.
87 ;; For getting more information about GNUS, consult USENET newsgorup
91 ;; (1) Incremental update of active info.
92 ;; (2) Asynchronous transmission of large messages.
100 (defvar gnus-default-nntp-server nil
101 "*Specify default NNTP server.
102 This variable should be defined in paths.el.")
104 (defvar gnus-nntp-server (or (getenv "NNTPSERVER") gnus-default-nntp-server)
105 "*The name of the host running NNTP server.
106 If it is a string such as `:DIRECTORY', the user's private DIRECTORY
107 is used as a news spool.
108 Initialized from the NNTPSERVER environment variable.")
110 (defvar gnus-nntp-service "nntp"
111 "*NNTP service name (\"nntp\" or 119).
112 Go to a local news spool if its value is nil.")
114 (defvar gnus-startup-file "~/.newsrc"
115 "*Your `.newsrc' file. Use `.newsrc-SERVER' instead if exists.")
117 (defvar gnus-signature-file "~/.signature"
118 "*Your `.signature' file. Use `.signature-DISTRIBUTION' instead if exists.")
120 (defvar gnus-use-cross-reference t
121 "*Specifies what to do with cross references (Xref: field).
122 If nil, ignore cross references. If t, mark articles as read in
123 subscribed newsgroups. Otherwise, if not nil nor t, mark articles as
124 read in all newsgroups.")
126 (defvar gnus-use-followup-to t
127 "*Specifies what to do with Followup-To: field.
128 If nil, ignore followup-to: field. If t, use its value except for
129 `poster'. Otherwise, if not nil nor t, always use its value.")
131 (defvar gnus-large-newsgroup 50
132 "*The number of articles which indicates a large newsgroup.
133 If the number of articles in a newsgroup is greater than the value,
134 confirmation is required for selecting the newsgroup.")
136 (defvar gnus-author-copy (getenv "AUTHORCOPY")
137 "*File name saving a copy of an article posted using FCC: field.
138 Initialized from the AUTHORCOPY environment variable.
140 Articles are saved using a function specified by the the variable
141 `gnus-author-copy-saver' (`rmail-output' is default) if a file name is
142 given. Instead, if the first character of the name is `|', the
143 contents of the article is piped out to the named program. It is
144 possible to save an article in an MH folder as follows:
146 (setq gnus-author-copy \"|/usr/local/lib/mh/rcvstore +Article\")")
148 (defvar gnus-author-copy-saver (function rmail-output)
149 "*A function called with a file name to save an author copy to.
150 The default function is `rmail-output' which saves in Unix mailbox format.")
152 (defvar gnus-use-long-file-name
153 (not (memq system-type '(usg-unix-v xenix)))
154 "*Non-nil means that a newsgroup name is used as a default file name
155 to save articles to. If it's nil, the directory form of a newsgroup is
158 (defvar gnus-article-save-directory (getenv "SAVEDIR")
159 "*A directory name to save articles to (default to ~/News).
160 Initialized from the SAVEDIR environment variable.")
162 (defvar gnus-default-article-saver (function gnus-summary-save-in-rmail)
163 "*A function to save articles in your favorite format.
164 The function must be interactively callable (in other words, it must
165 be an Emacs command).
167 GNUS provides the following functions:
168 gnus-summary-save-in-rmail (in Rmail format)
169 gnus-summary-save-in-mail (in Unix mail format)
170 gnus-summary-save-in-folder (in an MH folder)
171 gnus-summary-save-in-file (in article format).")
173 (defvar gnus-rmail-save-name (function gnus-plain-save-name)
174 "*A function generating a file name to save articles in Rmail format.
175 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
177 (defvar gnus-mail-save-name (function gnus-plain-save-name)
178 "*A function generating a file name to save articles in Unix mail format.
179 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
181 (defvar gnus-folder-save-name (function gnus-folder-save-name)
182 "*A function generating a file name to save articles in MH folder.
183 The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER.")
185 (defvar gnus-file-save-name (function gnus-numeric-save-name)
186 "*A function generating a file name to save articles in article format.
187 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
189 (defvar gnus-kill-file-name "KILL"
190 "*File name of a KILL file.")
192 (defvar gnus-novice-user t
193 "*Non-nil means that you are a novice to USENET.
194 If non-nil, verbose messages may be displayed
195 or your confirmations may be required.")
197 (defvar gnus-interactive-catchup t
198 "*Require your confirmation when catching up a newsgroup if non-nil.")
200 (defvar gnus-interactive-post t
201 "*Newsgroup, subject, and distribution will be asked for if non-nil.")
203 (defvar gnus-interactive-exit t
204 "*Require your confirmation when exiting GNUS if non-nil.")
206 (defvar gnus-user-login-name nil
207 "*The login name of the user.
208 Got from the function `user-login-name' if undefined.")
210 (defvar gnus-user-full-name nil
211 "*The full name of the user.
212 Got from the NAME environment variable if undefined.")
214 (defvar gnus-show-mime nil
215 "*Show MIME message if non-nil.")
217 (defvar gnus-show-threads t
218 "*Show conversation threads in Summary Mode if non-nil.")
220 (defvar gnus-thread-hide-subject t
221 "*Non-nil means hide subjects for thread subtrees.")
223 (defvar gnus-thread-hide-subtree nil
224 "*Non-nil means hide thread subtrees initially.
225 If non-nil, you have to run the command `gnus-summary-show-thread' by
226 hand or by using `gnus-select-article-hook' to show hidden threads.")
228 (defvar gnus-thread-hide-killed t
229 "*Non-nil means hide killed thread subtrees automatically.")
231 (defvar gnus-thread-ignore-subject nil
232 "*Don't take care of subject differences, but only references if non-nil.
233 If it is non-nil, some commands work with subjects do not work properly.")
235 (defvar gnus-thread-indent-level 4
236 "*Indentation of thread subtrees.")
238 (defvar gnus-ignored-newsgroups "^to\\..*$"
239 "*A regexp to match uninteresting newsgroups in the active file.
240 Any lines in the active file matching this regular expression are
241 removed from the newsgroup list before anything else is done to it,
242 thus making them effectively invisible.")
244 (defvar gnus-ignored-headers
245 "^Path:\\|^Posting-Version:\\|^Article-I.D.:\\|^Expires:\\|^Date-Received:\\|^References:\\|^Control:\\|^Xref:\\|^Lines:\\|^Posted:\\|^Relay-Version:\\|^Message-ID:\\|^Nf-ID:\\|^Nf-From:\\|^Approved:\\|^Sender:"
246 "*All random fields within the header of a message.")
248 (defvar gnus-required-headers
249 '(From Date Newsgroups Subject Message-ID Path Organization Distribution)
250 "*All required fields for articles you post.
251 RFC977 and RFC1036 require From, Date, Newsgroups, Subject, Message-ID
252 and Path fields. Organization, Distribution and Lines are optional.
253 If you want GNUS not to insert some field, remove it from the
256 (defvar gnus-show-all-headers nil
257 "*Show all headers of an article if non-nil.")
259 (defvar gnus-save-all-headers t
260 "*Save all headers of an article if non-nil.")
262 (defvar gnus-optional-headers (function gnus-optional-lines-and-from)
263 "*A function generating a optional string displayed in GNUS Summary
264 mode buffer. The function is called with an article HEADER. The
265 result must be a string excluding `[' and `]'.")
267 (defvar gnus-auto-extend-newsgroup t
268 "*Extend visible articles to forward and backward if non-nil.")
270 (defvar gnus-auto-select-first t
271 "*Select the first unread article automagically if non-nil.
272 If you want to prevent automatic selection of the first unread article
273 in some newsgroups, set the variable to nil in `gnus-select-group-hook'
274 or `gnus-apply-kill-hook'.")
276 (defvar gnus-auto-select-next t
277 "*Select the next newsgroup automagically if non-nil.
278 If the value is t and the next newsgroup is empty, GNUS will exit
279 Summary mode and go back to Group mode. If the value is neither nil
280 nor t, GNUS will select the following unread newsgroup. Especially, if
281 the value is the symbol `quietly', the next unread newsgroup will be
282 selected without any confirmations.")
284 (defvar gnus-auto-select-same nil
285 "*Select the next article with the same subject automagically if non-nil.")
287 (defvar gnus-auto-center-summary t
288 "*Always center the current summary in GNUS Summary window if non-nil.")
290 (defvar gnus-auto-mail-to-author nil
291 "*Insert `To: author' of the article when following up if non-nil.
292 Mail is sent using the function specified by the variable
293 `gnus-mail-send-method'.")
295 (defvar gnus-break-pages t
296 "*Break an article into pages if non-nil.
297 Page delimiter is specified by the variable `gnus-page-delimiter'.")
299 (defvar gnus-page-delimiter "^\^L"
300 "*Regexp describing line-beginnings that separate pages of news article.")
302 (defvar gnus-digest-show-summary t
303 "*Show a summary of undigestified messages if non-nil.")
305 (defvar gnus-digest-separator "^Subject:[ \t]"
306 "*Regexp that separates messages in a digest article.")
308 (defvar gnus-use-full-window t
309 "*Non-nil means to take up the entire screen of Emacs.")
311 (defvar gnus-window-configuration
315 "*Specify window configurations for each action.
316 The format of the variable is a list of (ACTION (G S A)), where G, S,
317 and A are the relative height of Group, Summary, and Article windows,
318 respectively. ACTION is `summary', `newsgroups', or `article'.")
320 (defvar gnus-show-mime-method (function metamail-buffer)
321 "*Function to process a MIME message.
322 The function is expected to process current buffer as a MIME message.")
324 (defvar gnus-mail-reply-method
325 (function gnus-mail-reply-using-mail)
326 "*Function to compose reply mail.
327 The function `gnus-mail-reply-using-mail' uses usual sendmail mail
328 program. The function `gnus-mail-reply-using-mhe' uses the MH-E mail
329 program. You can use yet another program by customizing this variable.")
331 (defvar gnus-mail-forward-method
332 (function gnus-mail-forward-using-mail)
333 "*Function to forward current message to another user.
334 The function `gnus-mail-reply-using-mail' uses usual sendmail mail
335 program. You can use yet another program by customizing this variable.")
337 (defvar gnus-mail-other-window-method
338 (function gnus-mail-other-window-using-mail)
339 "*Function to compose mail in other window.
340 The function `gnus-mail-other-window-using-mail' uses the usual sendmail
341 mail program. The function `gnus-mail-other-window-using-mhe' uses the MH-E
342 mail program. You can use yet another program by customizing this variable.")
344 (defvar gnus-mail-send-method send-mail-function
345 "*Function to mail a message too which is being posted as an article.
346 The message must have To: or Cc: field. The default is copied from
347 the variable `send-mail-function'.")
349 (defvar gnus-subscribe-newsgroup-method
350 (function gnus-subscribe-alphabetically)
351 "*Function called with a newsgroup name when new newsgroup is found.
352 The function `gnus-subscribe-randomly' inserts a new newsgroup a the
353 beginning of newsgroups. The function `gnus-subscribe-alphabetically'
354 inserts it in strict alphabetic order. The function
355 `gnus-subscribe-hierarchically' inserts it in hierarchical newsgroup
356 order. The function `gnus-subscribe-interactively' asks for your decision.")
358 (defvar gnus-group-mode-hook nil
359 "*A hook for GNUS Group Mode.")
361 (defvar gnus-summary-mode-hook nil
362 "*A hook for GNUS Summary Mode.")
364 (defvar gnus-article-mode-hook nil
365 "*A hook for GNUS Article Mode.")
367 (defvar gnus-kill-file-mode-hook nil
368 "*A hook for GNUS KILL File Mode.")
370 (defvar gnus-open-server-hook nil
371 "*A hook called just before opening connection to news server.")
373 (defvar gnus-startup-hook nil
374 "*A hook called at start up time.
375 This hook is called after GNUS is connected to the NNTP server. So, it
376 is possible to change the behavior of GNUS according to the selected
379 (defvar gnus-group-prepare-hook nil
380 "*A hook called after newsgroup list is created in the Newsgroup buffer.
381 If you want to modify the Newsgroup buffer, you can use this hook.")
383 (defvar gnus-summary-prepare-hook nil
384 "*A hook called after summary list is created in the Summary buffer.
385 If you want to modify the Summary buffer, you can use this hook.")
387 (defvar gnus-article-prepare-hook nil
388 "*A hook called after an article is prepared in the Article buffer.
389 If you want to run a special decoding program like nkf, use this hook.")
391 (defvar gnus-select-group-hook nil
392 "*A hook called when a newsgroup is selected.
393 If you want to sort Summary buffer by date and then by subject, you
394 can use the following hook:
396 \(setq gnus-select-group-hook
400 ;; First of all, sort by date.
401 (gnus-keysort-headers
402 (function string-lessp)
405 (gnus-sortable-date (gnus-header-date a)))))
406 ;; Then sort by subject string ignoring `Re:'.
407 ;; If case-fold-search is non-nil, case of letters is ignored.
408 (gnus-keysort-headers
409 (function string-lessp)
413 (downcase (gnus-simplify-subject (gnus-header-subject a) t))
414 (gnus-simplify-subject (gnus-header-subject a) t)))))
417 If you'd like to simplify subjects like the
418 `gnus-summary-next-same-subject' command does, you can use the
421 \(setq gnus-select-group-hook
427 (nntp-set-header-subject
429 (gnus-simplify-subject
430 (gnus-header-subject header) 're-only))))
431 gnus-newsgroup-headers)))))
433 In some newsgroups author name is meaningless. It is possible to
434 prevent listing author names in GNUS Summary buffer as follows:
436 \(setq gnus-select-group-hook
440 (cond ((string-equal \"comp.sources.unix\" gnus-newsgroup-name)
441 (setq gnus-optional-headers
442 (function gnus-optional-lines)))
444 (setq gnus-optional-headers
445 (function gnus-optional-lines-and-from))))))))")
447 (defvar gnus-select-article-hook
448 '(gnus-summary-show-thread)
449 "*A hook called when an article is selected.
450 The default hook shows conversation thread subtrees of the selected
451 article automatically using `gnus-summary-show-thread'.
453 If you'd like to run RMAIL on a digest article automagically, you can
454 use the following hook:
456 \(setq gnus-select-article-hook
460 (gnus-summary-show-thread)
461 (cond ((string-equal \"comp.sys.sun\" gnus-newsgroup-name)
462 (gnus-summary-rmail-digest))
463 ((and (string-equal \"comp.text\" gnus-newsgroup-name)
464 (string-match \"^TeXhax Digest\"
465 (gnus-header-subject gnus-current-headers)))
466 (gnus-summary-rmail-digest)
469 (defvar gnus-select-digest-hook
473 ;; Reply-To: is required by `undigestify-rmail-message'.
474 (or (mail-position-on-field "Reply-to" t)
476 (mail-position-on-field "Reply-to")
477 (insert (gnus-fetch-field "From")))))))
478 "*A hook called when reading digest messages using Rmail.
479 This hook can be used to modify incomplete digest articles as follows
480 \(this is the default):
482 \(setq gnus-select-digest-hook
486 ;; Reply-To: is required by `undigestify-rmail-message'.
487 (or (mail-position-on-field \"Reply-to\" t)
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
507 \(setq gnus-apply-kill-hook
511 (cond ((string-match \"control\" gnus-newsgroup-name)
512 (gnus-kill \"Subject\" \"rmgroup\")
513 (gnus-expunge \"X\")))))))")
515 (defvar gnus-mark-article-hook
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
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
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
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 stringp, 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 ;; Internal variables.
600 (defconst gnus-version "GNUS 4.1"
601 "Version numbers of this version of GNUS.")
603 (defconst gnus-emacs-version
605 (string-match "[0-9]*" emacs-version)
606 (string-to-int (substring emacs-version
607 (match-beginning 0) (match-end 0))))
608 "Major version number of this emacs.")
610 (defvar gnus-info-nodes
611 '((gnus-group-mode "(gnus)Newsgroup Commands")
612 (gnus-summary-mode "(gnus)Summary Commands")
613 (gnus-article-mode "(gnus)Article Commands")
614 (gnus-kill-file-mode "(gnus)Kill File")
615 (gnus-browse-killed-mode "(gnus)Maintaining Subscriptions"))
616 "Assoc list of major modes and related Info nodes.")
618 ;; Alist syntax is different from that of 3.14.3.
619 (defvar gnus-access-methods
621 (gnus-retrieve-headers nntp-retrieve-headers)
622 (gnus-open-server nntp-open-server)
623 (gnus-close-server nntp-close-server)
624 (gnus-server-opened nntp-server-opened)
625 (gnus-status-message nntp-status-message)
626 (gnus-request-article nntp-request-article)
627 (gnus-request-group nntp-request-group)
628 (gnus-request-list nntp-request-list)
629 (gnus-request-list-newsgroups nntp-request-list-newsgroups)
630 (gnus-request-list-distributions nntp-request-list-distributions)
631 (gnus-request-post nntp-request-post))
633 (gnus-retrieve-headers nnspool-retrieve-headers)
634 (gnus-open-server nnspool-open-server)
635 (gnus-close-server nnspool-close-server)
636 (gnus-server-opened nnspool-server-opened)
637 (gnus-status-message nnspool-status-message)
638 (gnus-request-article nnspool-request-article)
639 (gnus-request-group nnspool-request-group)
640 (gnus-request-list nnspool-request-list)
641 (gnus-request-list-newsgroups nnspool-request-list-newsgroups)
642 (gnus-request-list-distributions nnspool-request-list-distributions)
643 (gnus-request-post nnspool-request-post))
645 (gnus-retrieve-headers mhspool-retrieve-headers)
646 (gnus-open-server mhspool-open-server)
647 (gnus-close-server mhspool-close-server)
648 (gnus-server-opened mhspool-server-opened)
649 (gnus-status-message mhspool-status-message)
650 (gnus-request-article mhspool-request-article)
651 (gnus-request-group mhspool-request-group)
652 (gnus-request-list mhspool-request-list)
653 (gnus-request-list-newsgroups mhspool-request-list-newsgroups)
654 (gnus-request-list-distributions mhspool-request-list-distributions)
655 (gnus-request-post mhspool-request-post)))
656 "Access method for NNTP, nnspool, and mhspool.")
658 (defvar gnus-group-buffer "*Newsgroup*")
659 (defvar gnus-summary-buffer "*Summary*")
660 (defvar gnus-article-buffer "*Article*")
661 (defvar gnus-digest-buffer "GNUS Digest")
662 (defvar gnus-digest-summary-buffer "GNUS Digest-summary")
664 (defvar gnus-buffer-list
665 (list gnus-group-buffer gnus-summary-buffer gnus-article-buffer
666 gnus-digest-buffer gnus-digest-summary-buffer)
667 "GNUS buffer names which should be killed when exiting.")
669 (defvar gnus-variable-list
670 '(gnus-newsrc-options
671 gnus-newsrc-options-n-yes gnus-newsrc-options-n-no
672 gnus-newsrc-assoc gnus-killed-assoc gnus-marked-assoc)
673 "GNUS variables saved in the quick startup file.")
675 (defvar gnus-overload-functions
676 '((news-inews gnus-inews-news "rnewspost")
677 (caesar-region gnus-caesar-region "rnews"))
678 "Functions overloaded by gnus.
679 It is a list of `(original overload &optional file)'.")
681 (defvar gnus-distribution-list nil)
683 (defvar gnus-newsrc-options nil
684 "Options line in the .newsrc file.")
686 (defvar gnus-newsrc-options-n-yes nil
687 "Regexp representing subscribed newsgroups.")
689 (defvar gnus-newsrc-options-n-no nil
690 "Regexp representing unsubscribed newsgroups.")
692 (defvar gnus-newsrc-assoc nil
693 "Assoc list of read articles.
694 gnus-newsrc-hashtb should be kept so that both hold the same information.")
696 (defvar gnus-newsrc-hashtb nil
697 "Hashtable of gnus-newsrc-assoc.")
699 (defvar gnus-killed-assoc nil
700 "Assoc list of newsgroups removed from gnus-newsrc-assoc.
701 gnus-killed-hashtb should be kept so that both hold the same information.")
703 (defvar gnus-killed-hashtb nil
704 "Hashtable of gnus-killed-assoc.")
706 (defvar gnus-marked-assoc nil
707 "Assoc list of articles marked as unread.
708 gnus-marked-hashtb should be kept so that both hold the same information.")
710 (defvar gnus-marked-hashtb nil
711 "Hashtable of gnus-marked-assoc.")
713 (defvar gnus-unread-hashtb nil
714 "Hashtable of unread articles.")
716 (defvar gnus-active-hashtb nil
717 "Hashtable of active articles.")
719 (defvar gnus-octive-hashtb nil
720 "Hashtable of OLD active articles.")
722 (defvar gnus-current-startup-file nil
723 "Startup file for the current host.")
725 (defvar gnus-last-search-regexp nil
726 "Default regexp for article search command.")
728 (defvar gnus-last-shell-command nil
729 "Default shell command on article.")
731 (defvar gnus-have-all-newsgroups nil)
733 (defvar gnus-newsgroup-name nil)
734 (defvar gnus-newsgroup-begin nil)
735 (defvar gnus-newsgroup-end nil)
736 (defvar gnus-newsgroup-last-rmail nil)
737 (defvar gnus-newsgroup-last-mail nil)
738 (defvar gnus-newsgroup-last-folder nil)
739 (defvar gnus-newsgroup-last-file nil)
741 (defvar gnus-newsgroup-unreads nil
742 "List of unread articles in the current newsgroup.")
744 (defvar gnus-newsgroup-unselected nil
745 "List of unselected unread articles in the current newsgroup.")
747 (defvar gnus-newsgroup-marked nil
748 "List of marked articles in the current newsgroup (a subset of unread art).")
750 (defvar gnus-newsgroup-headers nil
751 "List of article headers in the current newsgroup.
752 If the variable is modified (added or deleted), the function
753 gnus-clear-hashtables-for-newsgroup-headers must be called to clear
755 (defvar gnus-newsgroup-headers-hashtb-by-id nil)
756 (defvar gnus-newsgroup-headers-hashtb-by-number nil)
758 (defvar gnus-current-article nil)
759 (defvar gnus-current-headers nil)
760 (defvar gnus-current-history nil)
761 (defvar gnus-have-all-headers nil "Must be either T or NIL.")
762 (defvar gnus-last-article nil)
763 (defvar gnus-current-kill-article nil)
765 ;; Save window configuration.
766 (defvar gnus-winconf-kill-file nil)
768 (defvar gnus-group-mode-map nil)
769 (defvar gnus-summary-mode-map nil)
770 (defvar gnus-article-mode-map nil)
771 (defvar gnus-kill-file-mode-map nil)
773 (defvar rmail-last-file (expand-file-name "~/XMBOX"))
774 (defvar rmail-last-rmail-file (expand-file-name "~/XNEWS"))
776 ;; Define GNUS Subsystems.
777 (autoload 'gnus-group-post-news "gnuspost"
778 "Post an article." t)
779 (autoload 'gnus-summary-post-news "gnuspost"
780 "Post an article." t)
781 (autoload 'gnus-summary-followup "gnuspost"
782 "Post a reply article." t)
783 (autoload 'gnus-summary-followup-with-original "gnuspost"
784 "Post a reply article with original article." t)
785 (autoload 'gnus-summary-cancel-article "gnuspost"
786 "Cancel an article you posted." t)
788 (autoload 'gnus-summary-reply "gnusmail"
789 "Reply mail to news author." t)
790 (autoload 'gnus-summary-reply-with-original "gnusmail"
791 "Reply mail to news author with original article." t)
792 (autoload 'gnus-summary-mail-forward "gnusmail"
793 "Forward the current message to another user." t)
794 (autoload 'gnus-summary-mail-other-window "gnusmail"
795 "Compose mail in other window." t)
797 (autoload 'gnus-group-kill-group "gnusmisc"
798 "Kill newsgroup on current line." t)
799 (autoload 'gnus-group-yank-group "gnusmisc"
800 "Yank the last killed newsgroup on current line." t)
801 (autoload 'gnus-group-kill-region "gnusmisc"
802 "Kill newsgroups in current region." t)
803 (autoload 'gnus-group-transpose-groups "gnusmisc"
804 "Exchange current newsgroup and previous newsgroup." t)
805 (autoload 'gnus-list-killed-groups "gnusmisc"
806 "List the killed newsgroups." t)
807 (autoload 'gnus-gmt-to-local "gnusmisc"
808 "Rewrite Date field in GMT to local in current buffer.")
810 (autoload 'metamail-buffer "metamail"
811 "Process current buffer through 'metamail'." t)
813 (autoload 'timezone-make-sortable-date "timezone")
814 (autoload 'timezone-parse-date "timezone")
816 (autoload 'rmail-output "rmailout"
817 "Append this message to Unix mail file named FILE-NAME." t)
818 (autoload 'mail-position-on-field "sendmail")
819 (autoload 'mh-find-path "mh-e")
820 (autoload 'mh-prompt-for-folder "mh-e")
822 (put 'gnus-group-mode 'mode-class 'special)
823 (put 'gnus-summary-mode 'mode-class 'special)
824 (put 'gnus-article-mode 'mode-class 'special)
826 (autoload 'gnus-uu-ctl-map "gnus-uu" nil nil 'keymap)
828 ;;(put 'gnus-eval-in-buffer-window 'lisp-indent-hook 1)
830 (defmacro gnus-eval-in-buffer-window (buffer &rest forms)
831 "Pop to BUFFER, evaluate FORMS, and then returns to original window."
832 (` (let ((GNUSStartBufferWindow (selected-window)))
835 (pop-to-buffer (, buffer))
837 (select-window GNUSStartBufferWindow)))))
839 (defmacro gnus-make-hashtable (&optional hashsize)
840 "Make a hash table (default and minimum size is 200).
841 Optional argument HASHSIZE specifies the table size."
842 (` (make-vector (, (if hashsize (` (max (, hashsize) 200)) 200)) 0)))
844 (defmacro gnus-gethash (string hashtable)
845 "Get hash value of STRING in HASHTABLE."
846 ;;(` (symbol-value (abbrev-symbol (, string) (, hashtable))))
847 ;;(` (abbrev-expansion (, string) (, hashtable)))
848 (` (symbol-value (intern-soft (, string) (, hashtable)))))
850 (defmacro gnus-sethash (string value hashtable)
851 "Set hash value. Arguments are STRING, VALUE, and HASHTABLE."
852 ;; We cannot use define-abbrev since it only accepts string as value.
853 (` (set (intern (, string) (, hashtable)) (, value))))
855 ;; Note: Macros defined here are also defined in nntp.el. I don't like
856 ;; to put them here, but many users got troubled with the old
857 ;; definitions in nntp.elc. These codes are NNTP 3.10 version.
859 (defmacro nntp-header-number (header)
860 "Return article number in HEADER."
861 (` (aref (, header) 0)))
863 (defmacro nntp-set-header-number (header number)
864 "Set article number of HEADER to NUMBER."
865 (` (aset (, header) 0 (, number))))
867 (defmacro nntp-header-subject (header)
868 "Return subject string in HEADER."
869 (` (aref (, header) 1)))
871 (defmacro nntp-set-header-subject (header subject)
872 "Set article subject of HEADER to SUBJECT."
873 (` (aset (, header) 1 (, subject))))
875 (defmacro nntp-header-from (header)
876 "Return author string in HEADER."
877 (` (aref (, header) 2)))
879 (defmacro nntp-set-header-from (header from)
880 "Set article author of HEADER to FROM."
881 (` (aset (, header) 2 (, from))))
883 (defmacro nntp-header-xref (header)
884 "Return xref string in HEADER."
885 (` (aref (, header) 3)))
887 (defmacro nntp-set-header-xref (header xref)
888 "Set article xref of HEADER to xref."
889 (` (aset (, header) 3 (, xref))))
891 (defmacro nntp-header-lines (header)
892 "Return lines in HEADER."
893 (` (aref (, header) 4)))
895 (defmacro nntp-set-header-lines (header lines)
896 "Set article lines of HEADER to LINES."
897 (` (aset (, header) 4 (, lines))))
899 (defmacro nntp-header-date (header)
900 "Return date in HEADER."
901 (` (aref (, header) 5)))
903 (defmacro nntp-set-header-date (header date)
904 "Set article date of HEADER to DATE."
905 (` (aset (, header) 5 (, date))))
907 (defmacro nntp-header-id (header)
908 "Return Id in HEADER."
909 (` (aref (, header) 6)))
911 (defmacro nntp-set-header-id (header id)
912 "Set article Id of HEADER to ID."
913 (` (aset (, header) 6 (, id))))
915 (defmacro nntp-header-references (header)
916 "Return references in HEADER."
917 (` (aref (, header) 7)))
919 (defmacro nntp-set-header-references (header ref)
920 "Set article references of HEADER to REF."
921 (` (aset (, header) 7 (, ref))))
928 (if gnus-group-mode-map
930 (setq gnus-group-mode-map (make-keymap))
931 (suppress-keymap gnus-group-mode-map)
932 (define-key gnus-group-mode-map " " 'gnus-group-read-group)
933 (define-key gnus-group-mode-map "=" 'gnus-group-select-group)
934 (define-key gnus-group-mode-map "j" 'gnus-group-jump-to-group)
935 (define-key gnus-group-mode-map "n" 'gnus-group-next-unread-group)
936 (define-key gnus-group-mode-map "p" 'gnus-group-prev-unread-group)
937 (define-key gnus-group-mode-map "\177" 'gnus-group-prev-unread-group)
938 (define-key gnus-group-mode-map "N" 'gnus-group-next-group)
939 (define-key gnus-group-mode-map "P" 'gnus-group-prev-group)
940 (define-key gnus-group-mode-map "\C-n" 'gnus-group-next-group)
941 (define-key gnus-group-mode-map "\C-p" 'gnus-group-prev-group)
942 (define-key gnus-group-mode-map "\r" 'next-line)
943 ;;(define-key gnus-group-mode-map "/" 'isearch-forward)
944 (define-key gnus-group-mode-map "<" 'beginning-of-buffer)
945 (define-key gnus-group-mode-map ">" 'end-of-buffer)
946 (define-key gnus-group-mode-map "u" 'gnus-group-unsubscribe-current-group)
947 (define-key gnus-group-mode-map "U" 'gnus-group-unsubscribe-group)
948 (define-key gnus-group-mode-map "c" 'gnus-group-catchup)
949 (define-key gnus-group-mode-map "C" 'gnus-group-catchup-all)
950 (define-key gnus-group-mode-map "l" 'gnus-group-list-groups)
951 (define-key gnus-group-mode-map "L" 'gnus-group-list-all-groups)
952 (define-key gnus-group-mode-map "g" 'gnus-group-get-new-news)
953 (define-key gnus-group-mode-map "R" 'gnus-group-restart)
954 (define-key gnus-group-mode-map "b" 'gnus-group-check-bogus-groups)
955 (define-key gnus-group-mode-map "r" 'gnus-group-restrict-groups)
956 (define-key gnus-group-mode-map "a" 'gnus-group-post-news)
957 (define-key gnus-group-mode-map "\ek" 'gnus-group-edit-local-kill)
958 (define-key gnus-group-mode-map "\eK" 'gnus-group-edit-global-kill)
959 (define-key gnus-group-mode-map "\C-k" 'gnus-group-kill-group)
960 (define-key gnus-group-mode-map "\C-y" 'gnus-group-yank-group)
961 (define-key gnus-group-mode-map "\C-w" 'gnus-group-kill-region)
962 (define-key gnus-group-mode-map "\C-x\C-t" 'gnus-group-transpose-groups)
963 (define-key gnus-group-mode-map "\C-c\C-l" 'gnus-list-killed-groups)
964 (define-key gnus-group-mode-map "V" 'gnus-version)
965 ;;(define-key gnus-group-mode-map "x" 'gnus-group-force-update)
966 (define-key gnus-group-mode-map "s" 'gnus-group-force-update)
967 (define-key gnus-group-mode-map "z" 'gnus-group-suspend)
968 (define-key gnus-group-mode-map "q" 'gnus-group-exit)
969 (define-key gnus-group-mode-map "Q" 'gnus-group-quit)
970 (define-key gnus-group-mode-map "?" 'gnus-group-describe-briefly)
971 (define-key gnus-group-mode-map "\C-c\C-i" 'gnus-info-find-node))
973 (defun gnus-group-mode ()
974 "Major mode for reading network news.
975 All normal editing commands are turned off.
976 Instead, these commands are available:
978 SPC Read articles in this newsgroup.
979 = Select this newsgroup.
980 j Move to the specified newsgroup.
981 n Move to the next unread newsgroup.
982 p Move to the previous unread newsgroup.
983 C-n Move to the next newsgroup.
984 C-p Move to the previous newsgroup.
985 < Move point to the beginning of this buffer.
986 > Move point to the end of this buffer.
987 u Unsubscribe from (subscribe to) this newsgroup.
988 U Unsubscribe from (subscribe to) the specified newsgroup.
989 c Mark all articles as read, preserving marked articles.
990 C Mark all articles in this newsgroup as read.
991 l Revert this buffer.
992 L List all newsgroups.
994 R Force to read the raw .newsrc file and get new news.
995 b Check bogus newsgroups.
996 r Restrict visible newsgroups to the current region.
997 a Post a new article.
998 ESC k Edit a local KILL file applied to this newsgroup.
999 ESC K Edit a global KILL file applied to all newsgroups.
1000 C-k Kill this newsgroup.
1001 C-y Yank killed newsgroup here.
1002 C-w Kill newsgroups in current region (excluding current point).
1003 C-x C-t Exchange this newsgroup and previous newsgroup.
1004 C-c C-l list killed newsgroups.
1005 s Save .newsrc file.
1006 z Suspend reading news.
1007 q Quit reading news.
1008 Q Quit reading news without saving .newsrc file.
1009 V Show the version number of this GNUS.
1010 ? Describe Group Mode commands briefly.
1011 C-h m Describe Group Mode.
1012 C-c C-i Read Info about Group Mode.
1014 The name of the host running NNTP server is asked for if no default
1015 host is specified. It is also possible to choose another NNTP server
1016 even when the default server is defined by giving a prefix argument to
1017 the command `\\[gnus]'.
1019 If an NNTP server is preceded by a colon such as `:Mail', the user's
1020 private directory `~/Mail' is used as a news spool. This makes it
1021 possible to read mail stored in MH folders or articles saved by GNUS.
1022 File names of mail or articles must consist of only numeric
1023 characters. Otherwise, they are ignored.
1025 If there is a file named `~/.newsrc-SERVER', it is used as the
1026 startup file instead of standard one when talking to SERVER. It is
1027 possible to talk to many hosts by using different startup files for
1030 Option `-n' of the options line in the startup file is recognized
1031 properly the same as the Bnews system. For example, if the options
1032 line is `options -n !talk talk.rumors', newsgroups under the `talk'
1033 hierarchy except for `talk.rumors' are ignored while checking new
1036 If there is a file named `~/.signature-DISTRIBUTION', it is used as
1037 signature file instead of standard one when posting a news in
1040 If an Info file generated from `gnus.texinfo' is installed, you can
1041 read an appropriate Info node of the Info file according to the
1042 current major mode of GNUS by \\[gnus-info-find-node].
1044 The variable `gnus-version', `nntp-version', `nnspool-version', and
1045 `mhspool-version' have the version numbers of this version of gnus.el,
1046 nntp.el, nnspool.el, and mhspoo.el, respectively.
1048 User customizable variables:
1050 Specifies the name of the host running the NNTP server. If its
1051 value is a string such as `:DIRECTORY', the user's private
1052 DIRECTORY is used as a news spool. The variable is initialized
1053 from the NNTPSERVER environment variable.
1056 Specifies a NNTP service name. It is usually \"nntp\" or 119.
1057 Nil forces GNUS to use a local news spool if the variable
1058 `gnus-nntp-server' is set to the local host name.
1061 Specifies a startup file (.newsrc). If there is a file named
1062 `.newsrc-SERVER', it's used instead when talking to SERVER. I
1063 recommend you to use the server specific file, if you'd like to
1064 talk to many servers. Especially if you'd like to read your
1065 private directory, the name of the file must be
1066 `.newsrc-:DIRECTORY'.
1069 Specifies a signature file (.signature). If there is a file named
1070 `.signature-DISTRIBUTION', it's used instead when posting an
1071 article in DISTRIBUTION. Set the variable to nil to prevent
1072 appending the file automatically. If you use an NNTP inews which
1073 comes with the NNTP package, you may have to set the variable to
1076 gnus-use-cross-reference
1077 Specifies what to do with cross references (Xref: field). If it
1078 is nil, cross references are ignored. If it is t, articles in
1079 subscribed newsgroups are only marked as read. Otherwise, if it
1080 is not nil nor t, articles in all newsgroups are marked as read.
1082 gnus-use-followup-to
1083 Specifies what to do with followup-to: field. If it is nil, its
1084 value is ignored. If it is non-nil, its value is used as followup
1085 newsgroups. Especially, if it is t and field value is `poster',
1086 your confirmation is required.
1089 Specifies a file name to save a copy of article you posted using
1090 FCC: field. If the first character of the value is `|', the
1091 contents of the article is piped out to a program specified by the
1092 rest of the value. The variable is initialized from the
1093 AUTHORCOPY environment variable.
1095 gnus-author-copy-saver
1096 Specifies a function to save an author copy. The function is
1097 called with a file name. The default function `rmail-output'
1098 saves in Unix mail format.
1101 Use specified file name as a KILL file (default to `KILL').
1104 Non-nil means that you are a novice to USENET. If non-nil,
1105 verbose messages may be displayed or your confirmations may be
1108 gnus-interactive-post
1109 Non-nil means that newsgroup, subject and distribution are asked
1110 for interactively when posting a new article.
1112 gnus-use-full-window
1113 Non-nil means to take up the entire screen of Emacs.
1115 gnus-window-configuration
1116 Specifies the configuration of Group, Summary, and Article
1117 windows. It is a list of (ACTION (G S A)), where G, S, and A are
1118 the relative height of Group, Summary, and Article windows,
1119 respectively. ACTION is `summary', `newsgroups', or `article'.
1121 gnus-subscribe-newsgroup-method
1122 Specifies a function called with a newsgroup name when new
1123 newsgroup is found. The default definition adds new newsgroup at
1124 the beginning of other newsgroups.
1126 And more and more. Please refer to texinfo documentation.
1128 Various hooks for customization:
1129 gnus-group-mode-hook
1130 Entry to this mode calls the value with no arguments, if that
1131 value is non-nil. This hook is called before GNUS is connected to
1132 the NNTP server. So, you can change or define the NNTP server in
1136 Called with no arguments after the NNTP server is selected. It is
1137 possible to change the behavior of GNUS or initialize the
1138 variables according to the selected NNTP server.
1140 gnus-group-prepare-hook
1141 Called with no arguments after a newsgroup list is created in the
1142 Newsgroup buffer, if that value is non-nil.
1144 gnus-save-newsrc-hook
1145 Called with no arguments when saving newsrc file if that value is
1148 gnus-prepare-article-hook
1149 Called with no arguments after preparing message body, but before
1150 preparing header fields which is automatically generated if that
1151 value is non-nil. The default hook (gnus-inews-insert-signature)
1152 inserts a signature file.
1154 gnus-inews-article-hook
1155 Called with no arguments when posting an article if that value is
1156 non-nil. This hook is called just before posting an article. The
1157 default hook does FCC (save an article to the specified file).
1159 gnus-suspend-gnus-hook
1160 Called with no arguments when suspending (not exiting) GNUS, if
1161 that value is non-nil.
1164 Called with no arguments when exiting (not suspending) GNUS, if
1165 that value is non-nil."
1167 (kill-all-local-variables)
1168 ;; Gee. Why don't you upgrade?
1169 (cond ((boundp 'mode-line-modified)
1170 (setq mode-line-modified "--- "))
1171 ((listp (default-value 'mode-line-format))
1172 (setq mode-line-format
1173 (cons "--- " (cdr (default-value 'mode-line-format)))))
1175 (setq mode-line-format
1176 "--- GNUS: List of Newsgroups %[(%m)%]----%3p-%-")))
1177 (setq major-mode 'gnus-group-mode)
1178 (setq mode-name "Newsgroup")
1179 (setq mode-line-buffer-identification "GNUS: List of Newsgroups")
1180 (setq mode-line-process nil)
1181 (use-local-map gnus-group-mode-map)
1182 (buffer-flush-undo (current-buffer))
1183 (setq buffer-read-only t) ;Disable modification
1184 (run-hooks 'gnus-group-mode-hook))
1187 (defun gnus (&optional confirm)
1189 If optional argument CONFIRM is non-nil, ask NNTP server."
1193 (switch-to-buffer (get-buffer-create gnus-group-buffer))
1195 (gnus-start-news-server confirm))
1196 (if (not (gnus-server-opened))
1198 ;; NNTP server is successfully open.
1199 (setq mode-line-process (format " {%s}" gnus-nntp-server))
1200 (let ((buffer-read-only nil))
1202 (gnus-group-startup-message)
1204 (run-hooks 'gnus-startup-hook)
1206 (if gnus-novice-user
1207 (gnus-group-describe-briefly)) ;Show brief help message.
1208 (gnus-group-list-groups nil)
1211 (defun gnus-group-startup-message ()
1212 "Insert startup message in current buffer."
1213 ;; Insert the message.
1218 NNTP-based News Reader for GNU Emacs
1221 If you have any trouble with this software, please let me
1222 know. I will fix your problems in the next release.
1224 Comments, suggestions, and bug fixes are welcome.
1227 umerin@mse.kyutech.ac.jp" gnus-version))
1228 ;; And then hack it.
1229 ;; 57 is the longest line.
1230 (indent-rigidly (point-min) (point-max) (/ (max (- (window-width) 57) 0) 2))
1231 (goto-char (point-min))
1232 ;; +4 is fuzzy factor.
1233 (insert-char ?\n (/ (max (- (window-height) 18) 0) 2)))
1235 (defun gnus-group-list-groups (show-all)
1236 "List newsgroups in the Newsgroup buffer.
1237 If argument SHOW-ALL is non-nil, unsubscribed groups are also listed."
1239 (let ((case-fold-search nil)
1240 (last-group ;Current newsgroup.
1241 (gnus-group-group-name))
1242 (next-group ;Next possible newsgroup.
1244 (gnus-group-search-forward nil nil)
1245 (gnus-group-group-name)))
1246 (prev-group ;Previous possible newsgroup.
1248 (gnus-group-search-forward t nil)
1249 (gnus-group-group-name))))
1250 (set-buffer gnus-group-buffer) ;May call from out of Group buffer
1251 (gnus-group-prepare show-all)
1252 (if (zerop (buffer-size))
1253 (message "No news is good news")
1254 ;; Go to last newsgroup if possible. If cannot, try next and
1255 ;; previous. If all fail, go to first unread newsgroup.
1256 (goto-char (point-min))
1258 (re-search-forward (gnus-group-make-regexp last-group) nil t))
1260 (re-search-forward (gnus-group-make-regexp next-group) nil t))
1262 (re-search-forward (gnus-group-make-regexp prev-group) nil t))
1263 (gnus-group-search-forward nil nil t))
1264 ;; Adjust cursor point.
1266 (search-forward ":" nil t)
1269 (defun gnus-group-prepare (&optional all)
1270 "Prepare list of newsgroups in current buffer.
1271 If optional argument ALL is non-nil, unsubscribed groups are also listed."
1272 (let ((buffer-read-only nil)
1273 (newsrc gnus-newsrc-assoc)
1277 ;; This specifies the format of Group buffer.
1278 (cntl "%s%s%5d: %s\n"))
1282 (setq group-info (car newsrc))
1283 (setq group-name (car group-info))
1284 (setq unread-count (nth 1 (gnus-gethash group-name gnus-unread-hashtb)))
1286 (and (nth 1 group-info) ;Subscribed.
1287 (> unread-count 0))) ;There are unread articles.
1288 ;; Yes, I can use gnus-group-prepare-line, but this is faster.
1291 ;; Subscribed or not.
1292 (if (nth 1 group-info) " " "U")
1294 (if (and (> unread-count 0)
1298 (cdr (gnus-gethash group-name
1299 gnus-marked-hashtb))))))
1301 ;; Number of unread articles.
1306 (setq newsrc (cdr newsrc))
1308 (setq gnus-have-all-newsgroups all)
1309 (goto-char (point-min))
1310 (run-hooks 'gnus-group-prepare-hook)
1313 (defun gnus-group-prepare-line (info)
1314 "Return a string for the Newsgroup buffer from INFO.
1315 INFO is an element of gnus-newsrc-assoc or gnus-killed-assoc."
1316 (let* ((group-name (car info))
1318 (or (nth 1 (gnus-gethash group-name gnus-unread-hashtb))
1319 ;; Not in hash table, so compute it now.
1320 (gnus-number-of-articles
1321 (gnus-difference-of-range
1322 (nth 2 (gnus-gethash group-name gnus-active-hashtb))
1324 ;; This specifies the format of Group buffer.
1325 (cntl "%s%s%5d: %s\n"))
1327 ;; Subscribed or not.
1328 (if (nth 1 info) " " "U")
1330 (if (and (> unread-count 0)
1334 (cdr (gnus-gethash group-name
1335 gnus-marked-hashtb))))))
1337 ;; Number of unread articles.
1343 (defun gnus-group-update-group (group &optional visible-only)
1344 "Update newsgroup info of GROUP.
1345 If optional argument VISIBLE-ONLY is non-nil, non displayed group is ignored."
1346 (let ((buffer-read-only nil)
1347 (case-fold-search nil) ;appleIIgs vs. appleiigs
1348 (regexp (gnus-group-make-regexp group))
1350 ;; Buffer may be narrowed.
1353 ;; Search a line to modify. If the buffer is large, the search
1354 ;; takes long time. In most cases, current point is on the line
1355 ;; we are looking for. So, first of all, check current line.
1356 ;; And then if current point is in the first half, search from
1357 ;; the beginning. Otherwise, search from the end.
1360 (looking-at regexp)))
1361 ((and (> (/ (buffer-size) 2) (point)) ;In the first half.
1363 (goto-char (point-min))
1364 (re-search-forward regexp nil t))))
1366 (goto-char (point-max))
1367 (re-search-backward regexp nil t))))
1368 ;; GROUP is listed in current buffer. So, delete old line.
1372 (delete-region (point) (progn (forward-line 1) (point)))
1374 ;; No such line in the buffer, so insert it at the top.
1375 (goto-char (point-min)))
1376 (if (or visible (not visible-only))
1378 (insert (gnus-group-prepare-line
1379 (gnus-gethash group gnus-newsrc-hashtb)))
1380 (forward-line -1) ;Move point on that line.
1384 (defun gnus-group-group-name ()
1385 "Get newsgroup name around point."
1388 (if (looking-at "^.+:[ \t]+\\([^ \t\n]+\\)\\([ \t].*\\|$\\)")
1389 (buffer-substring (match-beginning 1) (match-end 1))
1392 (defun gnus-group-make-regexp (newsgroup)
1393 "Return regexp that matches for a line of NEWSGROUP."
1394 (concat "^.+: " (regexp-quote newsgroup) "\\([ \t].*\\|$\\)"))
1396 (defun gnus-group-search-forward (backward norest &optional heretoo)
1397 "Search for the next (or previous) newsgroup.
1398 If 1st argument BACKWARD is non-nil, search backward instead.
1399 If 2nd argument NOREST is non-nil, don't care about newsgroup property.
1400 If optional argument HERETOO is non-nil, current line is searched for, too."
1401 (let ((case-fold-search nil)
1404 (function re-search-backward) (function re-search-forward)))
1406 (format "^%s[ \t]*\\(%s\\):"
1407 (if norest ".." " [ \t]")
1408 (if norest "[0-9]+" "[1-9][0-9]*")))
1413 (beginning-of-line))
1417 (setq found (funcall func regexp nil t))
1418 ;; Adjust cursor point.
1420 (search-forward ":" nil t)
1421 ;; Return T if found.
1425 ;; GNUS Group mode command
1427 (defun gnus-group-read-group (all &optional no-article)
1428 "Read news in this newsgroup.
1429 If argument ALL is non-nil, already read articles become readable.
1430 If optional argument NO-ARTICLE is non-nil, no article body is displayed."
1432 (let ((group (gnus-group-group-name))) ;Newsgroup name to read.
1434 (gnus-summary-read-group
1437 ;;(not (nth 1 (gnus-gethash group gnus-newsrc-hashtb))) ;Unsubscribed
1439 (nth 1 (gnus-gethash group gnus-unread-hashtb)))) ;No unread
1444 (defun gnus-group-select-group (all)
1445 "Select this newsgroup.
1446 No article is selected automatically.
1447 If argument ALL is non-nil, already read articles become readable."
1449 (gnus-group-read-group all t))
1451 (defun gnus-group-jump-to-group (group)
1452 "Jump to newsgroup GROUP."
1454 (list (completing-read "Newsgroup: " gnus-newsrc-assoc nil 'require-match)))
1455 (let ((case-fold-search nil))
1456 (goto-char (point-min))
1457 (or (re-search-forward (gnus-group-make-regexp group) nil t)
1458 (if (gnus-gethash group gnus-newsrc-hashtb)
1459 ;; Add GROUP entry, then seach again.
1460 (gnus-group-update-group group)))
1461 ;; Adjust cursor point.
1463 (search-forward ":" nil t)
1466 (defun gnus-group-next-group (n)
1467 "Go to next N'th newsgroup."
1470 (gnus-group-search-forward nil t))
1472 (or (gnus-group-search-forward nil t)
1473 (message "No more newsgroups")))
1475 (defun gnus-group-next-unread-group (n)
1476 "Go to next N'th unread newsgroup."
1479 (gnus-group-search-forward nil nil))
1481 (or (gnus-group-search-forward nil nil)
1482 (message "No more unread newsgroups")))
1484 (defun gnus-group-prev-group (n)
1485 "Go to previous N'th newsgroup."
1488 (gnus-group-search-forward t t))
1490 (or (gnus-group-search-forward t t)
1491 (message "No more newsgroups")))
1493 (defun gnus-group-prev-unread-group (n)
1494 "Go to previous N'th unread newsgroup."
1497 (gnus-group-search-forward t nil))
1499 (or (gnus-group-search-forward t nil)
1500 (message "No more unread newsgroups")))
1502 (defun gnus-group-catchup (all)
1503 "Mark all articles not marked as unread in current newsgroup as read.
1504 If prefix argument ALL is non-nil, all articles are marked as read.
1505 Cross references (Xref: field) of articles are ignored."
1507 (let* ((group (gnus-group-group-name))
1508 (marked (if (not all)
1509 (cdr (gnus-gethash group gnus-marked-hashtb)))))
1511 (or (not gnus-interactive-catchup) ;Without confirmation?
1514 "Do you really want to mark everything as read? "
1515 "Delete all articles not marked as read? ")))
1517 (message "") ;Clear "Yes or No" question.
1518 ;; Any marked articles will be preserved.
1519 (gnus-update-unread-articles group marked marked)
1520 (gnus-group-update-group group)
1521 (gnus-group-next-group 1)))
1524 (defun gnus-group-catchup-all ()
1525 "Mark all articles in current newsgroup as read.
1526 Cross references (Xref: field) of articles are ignored."
1528 (gnus-group-catchup t))
1530 (defun gnus-group-unsubscribe-current-group ()
1531 "Toggle subscribe from/to unsubscribe current group."
1533 (gnus-group-unsubscribe-group (gnus-group-group-name))
1534 (gnus-group-next-group 1))
1536 (defun gnus-group-unsubscribe-group (group)
1537 "Toggle subscribe from/to unsubscribe GROUP.
1538 New newsgroup is added to .newsrc automatically."
1540 (list (completing-read "Newsgroup: "
1541 gnus-active-hashtb nil 'require-match)))
1542 (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
1543 (cond ((not (null newsrc))
1544 ;; Toggle subscription flag.
1545 (setcar (nthcdr 1 newsrc) (not (nth 1 newsrc)))
1546 (gnus-update-newsrc-buffer group)
1547 (gnus-group-update-group group)
1548 ;; Adjust cursor point.
1550 (search-forward ":" nil t))
1551 ((and (stringp group)
1552 (gnus-gethash group gnus-active-hashtb))
1553 ;; Add new newsgroup.
1554 (gnus-add-newsgroup group)
1555 (gnus-group-update-group group)
1556 ;; Adjust cursor point.
1558 (search-forward ":" nil t))
1559 (t (error "No such newsgroup: %s" group)))
1562 (defun gnus-group-list-all-groups ()
1563 "List all of newsgroups in the Newsgroup buffer."
1565 (message "Listing all groups...")
1566 (gnus-group-list-groups t)
1567 (message "Listing all groups...done"))
1569 (defun gnus-group-get-new-news ()
1570 "Get newly arrived articles. In fact, read the active file again."
1573 (gnus-group-list-groups gnus-have-all-newsgroups))
1575 (defun gnus-group-restart ()
1576 "Force GNUS to read the raw startup file."
1578 (gnus-save-newsrc-file)
1579 (gnus-setup-news t) ;Force to read the raw startup file.
1580 (gnus-group-list-groups gnus-have-all-newsgroups))
1582 (defun gnus-group-check-bogus-groups ()
1583 "Check bogus newsgroups."
1585 (gnus-check-bogus-newsgroups t) ;Require confirmation.
1586 (gnus-group-list-groups gnus-have-all-newsgroups))
1588 (defun gnus-group-restrict-groups (start end)
1589 "Restrict visible newsgroups to the current region (START and END).
1590 Type \\[widen] to remove restriction."
1593 (narrow-to-region (progn
1601 (message (substitute-command-keys "Type \\[widen] to remove restriction")))
1603 (defun gnus-group-edit-global-kill ()
1604 "Edit a global KILL file."
1606 (setq gnus-current-kill-article nil) ;No articles selected.
1607 (gnus-kill-file-edit-file nil) ;Nil stands for global KILL file.
1609 (substitute-command-keys
1610 "Editing a global KILL file (Type \\[gnus-kill-file-exit] to exit)")))
1612 (defun gnus-group-edit-local-kill ()
1613 "Edit a local KILL file."
1615 (setq gnus-current-kill-article nil) ;No articles selected.
1616 (gnus-kill-file-edit-file (gnus-group-group-name))
1618 (substitute-command-keys
1619 "Editing a local KILL file (Type \\[gnus-kill-file-exit] to exit)")))
1621 (defun gnus-group-force-update ()
1622 "Update .newsrc file."
1624 (gnus-save-newsrc-file))
1626 (defun gnus-group-suspend ()
1627 "Suspend the current GNUS session.
1628 In fact, cleanup buffers except for Group Mode buffer.
1629 The hook gnus-suspend-gnus-hook is called before actually suspending."
1631 (run-hooks 'gnus-suspend-gnus-hook)
1632 ;; Kill GNUS buffers except for Group Mode buffer.
1633 (let ((buffers gnus-buffer-list))
1635 (and (not (eq (car buffers) gnus-group-buffer))
1636 (get-buffer (car buffers))
1637 (kill-buffer (car buffers)))
1638 (setq buffers (cdr buffers))
1642 (defun gnus-group-exit ()
1643 "Quit reading news after updating .newsrc.
1644 The hook gnus-exit-gnus-hook is called before actually quitting."
1646 (if (or noninteractive ;For gnus-batch-kill
1647 (zerop (buffer-size)) ;No news is good news.
1648 (not (gnus-server-opened)) ;NNTP connection closed.
1649 (not gnus-interactive-exit) ;Without confirmation
1650 (y-or-n-p "Are you sure you want to quit reading news? "))
1652 (message "") ;Erase "Yes or No" question.
1653 (run-hooks 'gnus-exit-gnus-hook)
1654 (gnus-save-newsrc-file)
1656 (gnus-close-server))
1659 (defun gnus-group-quit ()
1660 "Quit reading news without updating .newsrc.
1661 The hook gnus-exit-gnus-hook is called before actually quitting."
1663 (if (or noninteractive ;For gnus-batch-kill
1664 (zerop (buffer-size))
1665 (not (gnus-server-opened))
1667 (format "Quit reading news without saving %s? "
1668 (file-name-nondirectory gnus-current-startup-file))))
1670 (message "") ;Erase "Yes or No" question.
1671 (run-hooks 'gnus-exit-gnus-hook)
1673 (gnus-close-server))
1676 (defun gnus-group-describe-briefly ()
1677 "Describe Group mode commands briefly."
1681 (substitute-command-keys "\\[gnus-group-read-group]:Select ")
1682 (substitute-command-keys "\\[gnus-group-next-unread-group]:Forward ")
1683 (substitute-command-keys "\\[gnus-group-prev-unread-group]:Backward ")
1684 (substitute-command-keys "\\[gnus-group-exit]:Exit ")
1685 (substitute-command-keys "\\[gnus-info-find-node]:Run Info ")
1686 (substitute-command-keys "\\[gnus-group-describe-briefly]:This help")
1691 ;;; GNUS Summary Mode
1694 (if gnus-summary-mode-map
1696 (setq gnus-summary-mode-map (make-keymap))
1697 (suppress-keymap gnus-summary-mode-map)
1698 (define-key gnus-summary-mode-map "\C-c\C-v" 'gnus-uu-ctl-map)
1699 (define-key gnus-summary-mode-map " " 'gnus-summary-next-page)
1700 (define-key gnus-summary-mode-map "\177" 'gnus-summary-prev-page)
1701 (define-key gnus-summary-mode-map "\r" 'gnus-summary-scroll-up)
1702 (define-key gnus-summary-mode-map "n" 'gnus-summary-next-unread-article)
1703 (define-key gnus-summary-mode-map "p" 'gnus-summary-prev-unread-article)
1704 (define-key gnus-summary-mode-map "N" 'gnus-summary-next-article)
1705 (define-key gnus-summary-mode-map "P" 'gnus-summary-prev-article)
1706 (define-key gnus-summary-mode-map "\e\C-n" 'gnus-summary-next-same-subject)
1707 (define-key gnus-summary-mode-map "\e\C-p" 'gnus-summary-prev-same-subject)
1708 ;;(define-key gnus-summary-mode-map "\e\C-n" 'gnus-summary-next-unread-same-subject)
1709 ;;(define-key gnus-summary-mode-map "\e\C-p" 'gnus-summary-prev-unread-same-subject)
1710 (define-key gnus-summary-mode-map "\C-c\C-n" 'gnus-summary-next-digest)
1711 (define-key gnus-summary-mode-map "\C-c\C-p" 'gnus-summary-prev-digest)
1712 (define-key gnus-summary-mode-map "\C-n" 'gnus-summary-next-subject)
1713 (define-key gnus-summary-mode-map "\C-p" 'gnus-summary-prev-subject)
1714 (define-key gnus-summary-mode-map "\en" 'gnus-summary-next-unread-subject)
1715 (define-key gnus-summary-mode-map "\ep" 'gnus-summary-prev-unread-subject)
1716 ;;(define-key gnus-summary-mode-map "\C-cn" 'gnus-summary-next-group)
1717 ;;(define-key gnus-summary-mode-map "\C-cp" 'gnus-summary-prev-group)
1718 (define-key gnus-summary-mode-map "." 'gnus-summary-first-unread-article)
1719 ;;(define-key gnus-summary-mode-map "/" 'isearch-forward)
1720 (define-key gnus-summary-mode-map "s" 'gnus-summary-isearch-article)
1721 (define-key gnus-summary-mode-map "\es" 'gnus-summary-search-article-forward)
1722 ;;(define-key gnus-summary-mode-map "\eS" 'gnus-summary-search-article-backward)
1723 (define-key gnus-summary-mode-map "\er" 'gnus-summary-search-article-backward)
1724 (define-key gnus-summary-mode-map "<" 'gnus-summary-beginning-of-article)
1725 (define-key gnus-summary-mode-map ">" 'gnus-summary-end-of-article)
1726 (define-key gnus-summary-mode-map "j" 'gnus-summary-goto-subject)
1727 ;;(define-key gnus-summary-mode-map "J" 'gnus-summary-goto-article)
1728 (define-key gnus-summary-mode-map "l" 'gnus-summary-goto-last-article)
1729 (define-key gnus-summary-mode-map "^" 'gnus-summary-refer-parent-article)
1730 ;;(define-key gnus-summary-mode-map "\er" 'gnus-summary-refer-article)
1731 (define-key gnus-summary-mode-map "\e^" 'gnus-summary-refer-article)
1732 (define-key gnus-summary-mode-map "u" 'gnus-summary-mark-as-unread-forward)
1733 (define-key gnus-summary-mode-map "U" 'gnus-summary-mark-as-unread-backward)
1734 (define-key gnus-summary-mode-map "d" 'gnus-summary-mark-as-read-forward)
1735 (define-key gnus-summary-mode-map "D" 'gnus-summary-mark-as-read-backward)
1736 (define-key gnus-summary-mode-map "\eu" 'gnus-summary-clear-mark-forward)
1737 (define-key gnus-summary-mode-map "\eU" 'gnus-summary-clear-mark-backward)
1738 (define-key gnus-summary-mode-map "k" 'gnus-summary-kill-same-subject-and-select)
1739 (define-key gnus-summary-mode-map "\C-k" 'gnus-summary-kill-same-subject)
1740 (define-key gnus-summary-mode-map "\e\C-t" 'gnus-summary-toggle-threads)
1741 (define-key gnus-summary-mode-map "\e\C-s" 'gnus-summary-show-thread)
1742 (define-key gnus-summary-mode-map "\e\C-h" 'gnus-summary-hide-thread)
1743 (define-key gnus-summary-mode-map "\e\C-f" 'gnus-summary-next-thread)
1744 (define-key gnus-summary-mode-map "\e\C-b" 'gnus-summary-prev-thread)
1745 (define-key gnus-summary-mode-map "\e\C-u" 'gnus-summary-up-thread)
1746 (define-key gnus-summary-mode-map "\e\C-d" 'gnus-summary-down-thread)
1747 (define-key gnus-summary-mode-map "\e\C-k" 'gnus-summary-kill-thread)
1748 (define-key gnus-summary-mode-map "&" 'gnus-summary-execute-command)
1749 ;;(define-key gnus-summary-mode-map "c" 'gnus-summary-catchup)
1750 ;;(define-key gnus-summary-mode-map "c" 'gnus-summary-catchup-all)
1751 (define-key gnus-summary-mode-map "c" 'gnus-summary-catchup-and-exit)
1752 ;;(define-key gnus-summary-mode-map "c" 'gnus-summary-catchup-all-and-exit)
1753 (define-key gnus-summary-mode-map "\C-t" 'gnus-summary-toggle-truncation)
1754 (define-key gnus-summary-mode-map "x" 'gnus-summary-delete-marked-as-read)
1755 (define-key gnus-summary-mode-map "X" 'gnus-summary-delete-marked-with)
1756 (define-key gnus-summary-mode-map "\C-c\C-sn" 'gnus-summary-sort-by-number)
1757 (define-key gnus-summary-mode-map "\C-c\C-sa" 'gnus-summary-sort-by-author)
1758 (define-key gnus-summary-mode-map "\C-c\C-ss" 'gnus-summary-sort-by-subject)
1759 (define-key gnus-summary-mode-map "\C-c\C-sd" 'gnus-summary-sort-by-date)
1760 (define-key gnus-summary-mode-map "\C-c\C-s\C-n" 'gnus-summary-sort-by-number)
1761 (define-key gnus-summary-mode-map "\C-c\C-s\C-a" 'gnus-summary-sort-by-author)
1762 (define-key gnus-summary-mode-map "\C-c\C-s\C-s" 'gnus-summary-sort-by-subject)
1763 (define-key gnus-summary-mode-map "\C-c\C-s\C-d" 'gnus-summary-sort-by-date)
1764 (define-key gnus-summary-mode-map "=" 'gnus-summary-expand-window)
1765 ;;(define-key gnus-summary-mode-map "G" 'gnus-summary-reselect-current-group)
1766 (define-key gnus-summary-mode-map "\C-x\C-s" 'gnus-summary-reselect-current-group)
1767 (define-key gnus-summary-mode-map "w" 'gnus-summary-stop-page-breaking)
1768 (define-key gnus-summary-mode-map "\C-c\C-r" 'gnus-summary-caesar-message)
1769 (define-key gnus-summary-mode-map "g" 'gnus-summary-show-article)
1770 (define-key gnus-summary-mode-map "t" 'gnus-summary-toggle-header)
1771 ;;(define-key gnus-summary-mode-map "v" 'gnus-summary-show-all-headers)
1772 (define-key gnus-summary-mode-map "\et" 'gnus-summary-toggle-mime)
1773 (define-key gnus-summary-mode-map "\C-d" 'gnus-summary-rmail-digest)
1774 (define-key gnus-summary-mode-map "a" 'gnus-summary-post-news)
1775 (define-key gnus-summary-mode-map "f" 'gnus-summary-followup)
1776 (define-key gnus-summary-mode-map "F" 'gnus-summary-followup-with-original)
1777 (define-key gnus-summary-mode-map "C" 'gnus-summary-cancel-article)
1778 (define-key gnus-summary-mode-map "r" 'gnus-summary-reply)
1779 (define-key gnus-summary-mode-map "R" 'gnus-summary-reply-with-original)
1780 (define-key gnus-summary-mode-map "\C-c\C-f" 'gnus-summary-mail-forward)
1781 (define-key gnus-summary-mode-map "m" 'gnus-summary-mail-other-window)
1782 (define-key gnus-summary-mode-map "o" 'gnus-summary-save-article)
1783 (define-key gnus-summary-mode-map "\C-o" 'gnus-summary-save-in-mail)
1784 (define-key gnus-summary-mode-map "|" 'gnus-summary-pipe-output)
1785 (define-key gnus-summary-mode-map "\ek" 'gnus-summary-edit-local-kill)
1786 (define-key gnus-summary-mode-map "\eK" 'gnus-summary-edit-global-kill)
1787 (define-key gnus-summary-mode-map "V" 'gnus-version)
1788 (define-key gnus-summary-mode-map "q" 'gnus-summary-exit)
1789 (define-key gnus-summary-mode-map "Q" 'gnus-summary-quit)
1790 (define-key gnus-summary-mode-map "?" 'gnus-summary-describe-briefly)
1791 (define-key gnus-summary-mode-map "\C-c\C-i" 'gnus-info-find-node))
1793 (defun gnus-summary-mode ()
1794 "Major mode for reading articles in this newsgroup.
1795 All normal editing commands are turned off.
1796 Instead, these commands are available:
1798 SPC Scroll to the next page of the current article. The next unread
1799 article is selected automatically at the end of the message.
1800 DEL Scroll to the previous page of the current article.
1801 RET Scroll up (or down) one line the current article.
1802 n Move to the next unread article.
1803 p Move to the previous unread article.
1804 N Move to the next article.
1805 P Move to the previous article.
1806 ESC C-n Move to the next article which has the same subject as the
1808 ESC C-p Move to the previous article which has the same subject as the
1810 \\[gnus-summary-next-unread-same-subject]
1811 Move to the next unread article which has the same subject as the
1813 \\[gnus-summary-prev-unread-same-subject]
1814 Move to the previous unread article which has the same subject as
1815 the current article.
1816 C-c C-n Scroll to the next digested message of the current article.
1817 C-c C-p Scroll to the previous digested message of the current article.
1818 C-n Move to the next subject.
1819 C-p Move to the previous subject.
1820 ESC n Move to the next unread subject.
1821 ESC p Move to the previous unread subject.
1822 \\[gnus-summary-next-group]
1823 Exit the current newsgroup and select the next unread newsgroup.
1824 \\[gnus-summary-prev-group]
1825 Exit the current newsgroup and select the previous unread newsgroup.
1826 . Jump to the first unread article in the current newsgroup.
1827 s Do an incremental search forward on the current article.
1828 ESC s Search for an article containing a regexp forward.
1829 ESC r Search for an article containing a regexp backward.
1830 < Move point to the beginning of the current article.
1831 > Move point to the end of the current article.
1832 j Jump to the article specified by the numeric article ID.
1833 l Jump to the article you read last.
1834 ^ Refer to parent of the current article.
1835 ESC ^ Refer to the article specified by the Message-ID.
1836 u Mark the current article as unread, and go forward.
1837 U Mark the current article as unread, and go backward.
1838 d Mark the current article as read, and go forward.
1839 D Mark the current article as read, and go backward.
1840 ESC u Clear the current article's mark, and go forward.
1841 ESC U Clear the current article's mark, and go backward.
1842 k Mark articles which has the same subject as the current article as
1843 read, and then select the next unread article.
1844 C-k Mark articles which has the same subject as the current article as
1846 ESC k Edit a local KILL file applied to the current newsgroup.
1847 ESC K Edit a global KILL file applied to all newsgroups.
1848 ESC C-t Toggle showing conversation threads.
1849 ESC C-s Show thread subtrees.
1850 ESC C-h Hide thread subtrees.
1851 \\[gnus-summary-show-all-threads] Show all thread subtrees.
1852 \\[gnus-summary-hide-all-threads] Hide all thread subtrees.
1853 ESC C-f Go to the same level next thread.
1854 ESC C-b Go to the same level previous thread.
1855 ESC C-d Go downward current thread.
1856 ESC C-u Go upward current thread.
1857 ESC C-k Mark articles under current thread as read.
1858 & Execute a command for each article conditionally.
1859 \\[gnus-summary-catchup]
1860 Mark all articles as read in the current newsgroup, preserving
1861 articles marked as unread.
1862 \\[gnus-summary-catchup-all]
1863 Mark all articles as read in the current newsgroup.
1864 \\[gnus-summary-catchup-and-exit]
1865 Catch up all articles not marked as unread, and then exit the
1867 \\[gnus-summary-catchup-all-and-exit]
1868 Catch up all articles, and then exit the current newsgroup.
1869 C-t Toggle truncations of subject lines.
1870 x Delete subject lines marked as read.
1871 X Delete subject lines with the specific marks.
1872 C-c C-s C-n Sort subjects by article number.
1873 C-c C-s C-a Sort subjects by article author.
1874 C-c C-s C-s Sort subjects alphabetically.
1875 C-c C-s C-d Sort subjects by date.
1876 = Expand Summary window to show headers full window.
1877 C-x C-s Reselect the current newsgroup. Prefix argument means to select all.
1878 w Stop page breaking by linefeed.
1879 C-c C-r Caesar rotates letters by 13/47 places.
1880 g Force to show the current article.
1881 t Show original article header if pruned header currently shown, or
1883 ESC-t Toggle MIME processing.
1884 C-d Run RMAIL on the current digest article.
1885 a Post a new article.
1886 f Post a reply article.
1887 F Post a reply article with original article.
1888 C Cancel the current article.
1889 r Mail a message to the author.
1890 R Mail a message to the author with original author.
1891 C-c C-f Forward the current message to another user.
1892 m Mail a message in other window.
1893 o Save the current article in your favorite format.
1894 C-o Append the current article to a file in Unix mail format.
1895 | Pipe the contents of the current article to a subprocess.
1896 q Quit reading news in the current newsgroup.
1897 Q Quit reading news without recording unread articles information.
1898 V Show the version number of this GNUS.
1899 ? Describe Summary mode commands briefly.
1900 C-h m Describe Summary mode.
1901 C-c C-i Read Info about Summary mode.
1903 User customizable variables:
1904 gnus-large-newsgroup
1905 The number of articles which indicates a large newsgroup. If the
1906 number of articles in a newsgroup is greater than the value, the
1907 number of articles to be selected is asked for. If the given value
1908 N is positive, the last N articles is selected. If N is negative,
1909 the first N articles are selected. An empty string means to select
1912 gnus-use-long-file-name
1913 Non-nil means that a newsgroup name is used as a default file name
1914 to save articles to. If it's nil, the directory form of a
1915 newsgroup is used instead.
1917 gnus-default-article-saver
1918 Specifies your favorite article saver which is interactively
1919 funcallable. Following functions are available:
1921 gnus-summary-save-in-rmail (in Rmail format)
1922 gnus-summary-save-in-mail (in Unix mail format)
1923 gnus-summary-save-in-folder (in MH folder)
1924 gnus-summary-save-in-file (in article format).
1926 gnus-rmail-save-name
1928 gnus-folder-save-name
1930 Specifies a function generating a file name to save articles in
1931 specified format. The function is called with NEWSGROUP, HEADERS,
1932 and optional LAST-FILE. Access macros to the headers are defined
1933 as nntp-header-FIELD, and functions are defined as
1936 gnus-article-save-directory
1937 Specifies a directory name to save articles to using the commands
1938 gnus-summary-save-in-rmail, gnus-summary-save-in-mail and
1939 gnus-summary-save-in-file. The variable is initialized from the
1940 SAVEDIR environment variable.
1942 gnus-show-all-headers
1943 Non-nil means that all headers of an article are shown.
1945 gnus-save-all-headers
1946 Non-nil means that all headers of an article are saved in a file.
1949 Non-nil means that show a MIME message.
1952 Non-nil means that conversation threads are shown in tree structure.
1954 gnus-thread-hide-subject
1955 Non-nil means that subjects for thread subtrees are hidden.
1957 gnus-thread-hide-subtree
1958 Non-nil means that thread subtrees are hidden initially.
1960 gnus-thread-hide-killed
1961 Non-nil means that killed thread subtrees are hidden automatically.
1963 gnus-thread-ignore-subject
1964 Non-nil means that subject differences are ignored in constructing
1967 gnus-thread-indent-level
1968 Indentation of thread subtrees.
1970 gnus-optional-headers
1971 Specifies a function which generates an optional string displayed
1972 in the Summary buffer. The function is called with an article
1973 HEADERS. The result must be a string excluding `[' and `]'. The
1974 default function returns a string like NNN:AUTHOR, where NNN is
1975 the number of lines in an article and AUTHOR is the name of the
1978 gnus-auto-extend-newsgroup
1979 Non-nil means visible articles are extended to forward and
1980 backward automatically if possible.
1982 gnus-auto-select-first
1983 Non-nil means the first unread article is selected automagically
1984 when a newsgroup is selected normally (by gnus-group-read-group).
1985 If you'd like to prevent automatic selection of the first unread
1986 article in some newsgroups, set the variable to nil in
1987 gnus-select-group-hook or gnus-apply-kill-hook.
1989 gnus-auto-select-next
1990 Non-nil means the next newsgroup is selected automagically at the
1991 end of the newsgroup. If the value is t and the next newsgroup is
1992 empty (no unread articles), GNUS will exit Summary mode and go
1993 back to Group mode. If the value is neither nil nor t, GNUS won't
1994 exit Summary mode but select the following unread newsgroup.
1995 Especially, if the value is the symbol `quietly', the next unread
1996 newsgroup will be selected without any confirmations.
1998 gnus-auto-select-same
1999 Non-nil means an article with the same subject as the current
2000 article is selected automagically like `rn -S'.
2002 gnus-auto-center-summary
2003 Non-nil means the point of Summary Mode window is always kept
2007 Non-nil means an article is broken into pages at page delimiters.
2008 This may not work with some versions of GNU Emacs earlier than
2012 Specifies a regexp describing line-beginnings that separate pages
2015 [gnus-more-message is obsolete. overlay-arrow-string interfares
2016 with other subsystems, such as dbx mode.]
2018 gnus-digest-show-summary
2019 Non-nil means that a summary of digest messages is shown when
2020 reading a digest article using `gnus-summary-rmail-digest'
2023 gnus-digest-separator
2024 Specifies a regexp separating messages in a digest article.
2026 gnus-mail-reply-method
2027 gnus-mail-other-window-method
2028 Specifies a function to begin composing mail message using
2029 commands gnus-summary-reply and gnus-summary-mail-other-window.
2030 Functions gnus-mail-reply-using-mail and gnus-mail-reply-using-mhe
2031 are available for the value of gnus-mail-reply-method. And
2032 functions gnus-mail-other-window-using-mail and
2033 gnus-mail-other-window-using-mhe are available for the value of
2034 gnus-mail-other-window-method.
2036 gnus-mail-send-method
2037 Specifies a function to mail a message too which is being posted
2038 as an article. The message must have To: or Cc: field. The value
2039 of the variable send-mail-function is the default function which
2040 uses sendmail mail program.
2042 Various hooks for customization:
2043 gnus-summary-mode-hook
2044 Entry to this mode calls the value with no arguments, if that
2047 gnus-select-group-hook
2048 Called with no arguments when newsgroup is selected, if that value
2049 is non-nil. It is possible to sort subjects in this hook. See the
2050 documentation of this variable for more information.
2052 gnus-summary-prepare-hook
2053 Called with no arguments after a summary list is created in the
2054 Summary buffer, if that value is non-nil. If you'd like to modify
2055 the buffer, you can use this hook.
2057 gnus-select-article-hook
2058 Called with no arguments when an article is selected, if that
2059 value is non-nil. See the documentation of this variable for more
2062 gnus-select-digest-hook
2063 Called with no arguments when reading digest messages using Rmail,
2064 if that value is non-nil. This hook can be used to modify an
2065 article so that Rmail can work with it. See the documentation of
2066 the variable for more information.
2068 gnus-rmail-digest-hook
2069 Called with no arguments when reading digest messages using Rmail,
2070 if that value is non-nil. This hook is intended to customize Rmail
2073 gnus-apply-kill-hook
2074 Called with no arguments when a newsgroup is selected and the
2075 Summary buffer is prepared. This hook is intended to apply a KILL
2076 file to the selected newsgroup. The format of KILL file is
2077 completely different from that of version 3.8. You have to rewrite
2078 them in the new format. See the documentation of Kill file mode
2079 for more information.
2081 gnus-mark-article-hook
2082 Called with no arguments when an article is selected at the first
2083 time. The hook is intended to mark an article as read (or unread)
2084 automatically when it is selected. See the documentation of the
2085 variable for more information.
2087 gnus-exit-group-hook
2088 Called with no arguments when exiting the current newsgroup, if
2089 that value is non-nil. If your machine is so slow that exiting
2090 from Summary mode takes very long time, inhibit marking articles
2091 as read using cross-references by setting the variable
2092 gnus-use-cross-reference to nil in this hook."
2094 (kill-all-local-variables)
2095 ;; Gee. Why don't you upgrade?
2096 (cond ((boundp 'mode-line-modified)
2097 (setq mode-line-modified "--- "))
2098 ((listp (default-value 'mode-line-format))
2099 (setq mode-line-format
2100 (cons "--- " (cdr (default-value 'mode-line-format))))))
2101 ;; To disable display-time facility.
2102 ;;(make-local-variable 'global-mode-string)
2103 ;;(setq global-mode-string nil)
2104 (setq major-mode 'gnus-summary-mode)
2105 (setq mode-name "Summary")
2106 ;;(setq mode-line-process '(" " gnus-newsgroup-name))
2107 (make-local-variable 'minor-mode-alist)
2108 (or (assq 'gnus-show-threads minor-mode-alist)
2109 (setq minor-mode-alist
2110 (cons (list 'gnus-show-threads " Thread") minor-mode-alist)))
2111 (gnus-summary-set-mode-line)
2112 (use-local-map gnus-summary-mode-map)
2113 (buffer-flush-undo (current-buffer))
2114 (setq buffer-read-only t) ;Disable modification
2115 (setq truncate-lines t) ;Stop line folding
2116 (setq selective-display t)
2117 (setq selective-display-ellipses t) ;Display `...'
2118 ;;(setq case-fold-search t)
2119 (run-hooks 'gnus-summary-mode-hook))
2121 (defun gnus-summary-setup-buffer ()
2122 "Initialize Summary buffer."
2123 (if (get-buffer gnus-summary-buffer)
2124 (set-buffer gnus-summary-buffer)
2125 (set-buffer (get-buffer-create gnus-summary-buffer))
2129 (defun gnus-summary-read-group (group &optional show-all no-article)
2130 "Start reading news in newsgroup GROUP.
2131 If optional 1st argument SHOW-ALL is non-nil, already read articles are
2133 If optional 2nd argument NO-ARTICLE is non-nil, no article is selected
2135 (message "Retrieving newsgroup: %s..." group)
2136 (if (gnus-select-newsgroup group show-all)
2138 ;; Don't switch-to-buffer to prevent displaying old contents
2139 ;; of the buffer until new subjects list is created.
2140 ;; Suggested by Juha Heinanen <jh@tut.fi>
2141 (gnus-summary-setup-buffer)
2142 ;; You can change the order of subjects in this hook.
2143 (run-hooks 'gnus-select-group-hook)
2144 (gnus-summary-prepare)
2145 ;; Function `gnus-apply-kill-file' must be called in this hook.
2146 (run-hooks 'gnus-apply-kill-hook)
2147 (if (zerop (buffer-size))
2148 ;; This newsgroup is empty.
2150 (gnus-summary-catchup-and-exit nil t) ;Without confirmations.
2151 (message "No unread news"))
2152 ;; Hide conversation thread subtrees. We cannot do this in
2153 ;; gnus-summary-prepare-hook since kill processing may not
2154 ;; work with hidden articles.
2155 (and gnus-show-threads
2156 gnus-thread-hide-subtree
2157 (gnus-summary-hide-all-threads))
2158 ;; Show first unread article if requested.
2159 (goto-char (point-min))
2160 (if (and (not no-article)
2161 gnus-auto-select-first
2162 (gnus-summary-first-unread-article))
2163 ;; Window is configured automatically.
2164 ;; Current buffer may be changed as a result of hook
2165 ;; evaluation, especially by gnus-summary-rmail-digest
2166 ;; command, so we should adjust cursor point carefully.
2167 (if (eq (current-buffer) (get-buffer gnus-summary-buffer))
2169 ;; Adjust cursor point.
2171 (search-forward ":" nil t)))
2172 (gnus-configure-windows 'summary)
2173 (pop-to-buffer gnus-summary-buffer)
2174 (gnus-summary-set-mode-line)
2175 ;; I sometime get confused with the old Article buffer.
2176 (if (get-buffer gnus-article-buffer)
2177 (if (get-buffer-window gnus-article-buffer)
2179 (set-buffer gnus-article-buffer)
2180 (let ((buffer-read-only nil))
2182 (kill-buffer gnus-article-buffer)))
2183 ;; Adjust cursor point.
2185 (search-forward ":" nil t))
2187 ;; Cannot select newsgroup GROUP.
2188 (if (gnus-gethash group gnus-active-hashtb)
2190 ;; If NNTP is used, nntp_access file may not be installed
2191 ;; properly. Otherwise, may be active file problem.
2195 (format "Cannot select %s. May be security or active file problem." group)))
2197 ;; Check bogus newsgroups.
2198 ;; We must be in Group Mode buffer.
2199 (gnus-group-check-bogus-groups))
2202 (defun gnus-summary-prepare ()
2203 "Prepare summary list of current newsgroup in Summary buffer."
2204 (let ((buffer-read-only nil))
2205 ;; Note: The next codes are not actually used because the user who
2206 ;; want it can define them in gnus-select-group-hook.
2207 ;; Print verbose messages if too many articles are selected.
2208 ;; (and (numberp gnus-large-newsgroup)
2209 ;; (> (length gnus-newsgroup-headers) gnus-large-newsgroup)
2210 ;; (message "Preparing headers..."))
2212 (gnus-summary-prepare-threads
2213 (if gnus-show-threads
2214 (gnus-make-threads gnus-newsgroup-headers)
2215 gnus-newsgroup-headers) 0)
2216 ;; Erase header retrieval message.
2218 ;; Call hooks for modifying Summary buffer.
2219 ;; Suggested by sven@tde.LTH.Se (Sven Mattisson).
2220 (goto-char (point-min))
2221 (run-hooks 'gnus-summary-prepare-hook)
2224 ;; Basic ideas by Paul Dworkin <paul@media-lab.media.mit.edu>
2225 ;; Subject bug fix by jbw@bigbird.bu.edu (Joe Wells)
2227 (defun gnus-summary-prepare-threads (threads level &optional parent-subject)
2228 "Prepare Summary buffer from THREADS and indentation LEVEL.
2229 THREADS is a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...]).'
2230 Optional PARENT-SUBJECT specifies the subject of the parent."
2236 (parent-subject (or parent-subject ""))
2237 ;; `M Indent NUM: [OPT] SUBJECT'
2238 (cntl (format "%%s %%s%%%dd: [%%s] %%s\n"
2239 (length (prin1-to-string gnus-newsgroup-end)))))
2241 (setq thread (car threads))
2242 (setq threads (cdr threads))
2243 ;; If thread is a cons, hierarchical threads is given.
2244 ;; Otherwise, thread itself is header.
2246 (setq header (car thread))
2247 (setq header thread))
2248 ;; Print valid header only.
2249 (if (vectorp header) ;Depends on nntp.el.
2251 (setq number (nntp-header-number header))
2252 (setq subject (nntp-header-subject header))
2253 (setq child-subject (gnus-simplify-subject subject 're-only))
2257 (cond ((memq number gnus-newsgroup-marked) "-")
2258 ((memq number gnus-newsgroup-unreads) " ")
2261 (make-string (* level gnus-thread-indent-level) ? )
2264 ;; Optional headers.
2265 (or (and gnus-optional-headers
2266 (funcall gnus-optional-headers header)) "")
2267 ;; Its subject string.
2268 (concat (if (or (zerop level)
2269 (not gnus-thread-hide-subject)
2270 ;; Subject is different from the parent.
2272 parent-subject child-subject)))
2274 (make-string (window-width) ? ))
2278 ;; Print subthreads.
2281 (gnus-summary-prepare-threads
2282 (cdr thread) (1+ level) child-subject))
2285 ;;(defun gnus-summary-set-mode-line ()
2286 ;; "Set Summary mode line string."
2287 ;; ;; The value must be a string to escape %-constructs.
2289 ;; (if gnus-current-headers
2290 ;; (nntp-header-subject gnus-current-headers) gnus-newsgroup-name)))
2291 ;; (setq mode-line-buffer-identification
2294 ;; ;; Enough spaces to pad subject to 17 positions.
2295 ;; (make-string (max 0 (- 17 (length subject))) ? ))))
2296 ;; (set-buffer-modified-p t))
2298 ;; New implementation in gnus 3.14.3
2300 (defun gnus-summary-set-mode-line ()
2301 "Set Summary mode line string.
2302 If you don't like it, define your own gnus-summary-set-mode-line."
2304 (- (length gnus-newsgroup-unreads)
2305 (length (gnus-intersection
2306 gnus-newsgroup-unreads gnus-newsgroup-marked))))
2308 (- (length gnus-newsgroup-unselected)
2309 (length (gnus-intersection
2310 gnus-newsgroup-unselected gnus-newsgroup-marked)))))
2311 (setq mode-line-buffer-identification
2313 (format "GNUS: %s%s %s"
2315 (if gnus-current-article
2316 (format "/%d" gnus-current-article) "")
2317 ;; Basic ideas by tale@pawl.rpi.edu.
2318 (cond ((and (zerop unmarked)
2322 (format "{%d more}" unmarked))
2324 (format "{%d(+%d) more}" unmarked unselected)))
2326 (set-buffer-modified-p t))
2328 ;; GNUS Summary mode command.
2330 (defun gnus-summary-search-group (&optional backward)
2331 "Search for next unread newsgroup.
2332 If optional argument BACKWARD is non-nil, search backward instead."
2334 (set-buffer gnus-group-buffer)
2336 ;; We don't want to alter current point of Group mode buffer.
2337 (if (gnus-group-search-forward backward nil)
2338 (gnus-group-group-name))
2341 (defun gnus-summary-search-subject (backward unread subject)
2342 "Search for article forward.
2343 If 1st argument BACKWARD is non-nil, search backward.
2344 If 2nd argument UNREAD is non-nil, only unread article is selected.
2345 If 3rd argument SUBJECT is non-nil, the article which has
2346 the same subject will be searched for."
2349 (function re-search-backward) (function re-search-forward)))
2351 ;; We have to take care of hidden lines.
2353 (format "^%s[ \t]+\\([0-9]+\\):.\\[[^]\r\n]*\\][ \t]+%s"
2354 ;;(if unread " " ".")
2355 (cond ((eq unread t) " ") (unread "[- ]") (t "."))
2357 (concat "\\([Rr][Ee]:[ \t]+\\)*"
2358 (regexp-quote (gnus-simplify-subject subject))
2359 ;; Ignore words in parentheses.
2360 "\\([ \t]*([^\r\n]*)\\)*[ \t]*\\(\r\\|$\\)")
2366 (if (funcall func regexp nil t)
2369 (buffer-substring (match-beginning 1) (match-end 1)))))
2370 ;; Adjust cursor point.
2372 (search-forward ":" nil t)
2373 ;; This is the result.
2377 (defun gnus-summary-search-forward (&optional unread subject)
2378 "Search for article forward.
2379 If 1st optional argument UNREAD is non-nil, only unread article is selected.
2380 If 2nd optional argument SUBJECT is non-nil, the article which has
2381 the same subject will be searched for."
2382 (gnus-summary-search-subject nil unread subject))
2384 (defun gnus-summary-search-backward (&optional unread subject)
2385 "Search for article backward.
2386 If 1st optional argument UNREAD is non-nil, only unread article is selected.
2387 If 2nd optional argument SUBJECT is non-nil, the article which has
2388 the same subject will be searched for."
2389 (gnus-summary-search-subject t unread subject))
2391 (defun gnus-summary-article-number ()
2392 "Article number around point. If nothing, return current number."
2395 (if (looking-at ".[ \t]+\\([0-9]+\\):")
2397 (buffer-substring (match-beginning 1) (match-end 1)))
2398 ;; If search fail, return current article number.
2399 gnus-current-article
2402 (defun gnus-summary-subject-string ()
2403 "Return current subject string or nil if nothing."
2405 ;; It is possible to implement this function using
2406 ;; `gnus-summary-article-number' and `gnus-newsgroup-headers'.
2408 ;; We have to take care of hidden lines.
2409 (if (looking-at ".[ \t]+[0-9]+:.\\[[^]\r\n]*\\][ \t]+\\([^\r\n]*\\)[\r\n]")
2410 (buffer-substring (match-beginning 1) (match-end 1)))
2413 (defun gnus-summary-goto-subject (article)
2414 "Move point to ARTICLE's subject."
2418 (completing-read "Article number: "
2423 (int-to-string (nntp-header-number headers)))))
2424 gnus-newsgroup-headers)
2425 nil 'require-match))))
2426 (let ((current (point)))
2427 (goto-char (point-min))
2428 (or (and article (re-search-forward (format "^.[ \t]+%d:" article) nil t))
2429 (progn (goto-char current) nil))
2432 (defun gnus-summary-recenter ()
2433 "Center point in Summary window."
2434 ;; Scroll window so as to cursor comes center of Summary window
2435 ;; only when article is displayed.
2436 ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
2437 ;; Recenter only when requested.
2438 ;; Subbested by popovich@park.cs.columbia.edu
2439 (and gnus-auto-center-summary
2440 (get-buffer-window gnus-article-buffer)
2441 (< (/ (- (window-height) 1) 2)
2442 (count-lines (point) (point-max)))
2443 (recenter (/ (- (window-height) 2) 2))))
2445 ;; Walking around Group mode buffer.
2447 (defun gnus-summary-jump-to-group (newsgroup)
2448 "Move point to NEWSGROUP in Group mode buffer."
2449 ;; Keep update point of Group mode buffer if visible.
2450 (if (eq (current-buffer)
2451 (get-buffer gnus-group-buffer))
2452 (save-window-excursion
2453 ;; Take care of tree window mode.
2454 (if (get-buffer-window gnus-group-buffer)
2455 (pop-to-buffer gnus-group-buffer))
2456 (gnus-group-jump-to-group newsgroup))
2458 ;; Take care of tree window mode.
2459 (if (get-buffer-window gnus-group-buffer)
2460 (pop-to-buffer gnus-group-buffer)
2461 (set-buffer gnus-group-buffer))
2462 (gnus-group-jump-to-group newsgroup))))
2464 (defun gnus-summary-next-group (no-article)
2465 "Exit current newsgroup and then select next unread newsgroup.
2466 If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
2468 ;; Make sure Group mode buffer point is on current newsgroup.
2469 (gnus-summary-jump-to-group gnus-newsgroup-name)
2470 (let ((group (gnus-summary-search-group)))
2473 (message "Exiting %s..." gnus-newsgroup-name)
2476 (message "Selecting %s..." group)
2477 (gnus-summary-exit t) ;Exit Summary mode temporary.
2478 ;; We are now in Group mode buffer.
2479 ;; Make sure Group mode buffer point is on GROUP.
2480 (gnus-summary-jump-to-group group)
2481 (gnus-summary-read-group group nil no-article)
2482 (or (eq (current-buffer)
2483 (get-buffer gnus-summary-buffer))
2484 (eq gnus-auto-select-next t)
2485 ;; Expected newsgroup has nothing to read since the articles
2486 ;; are marked as read by cross-referencing. So, try next
2487 ;; newsgroup. (Make sure we are in Group mode buffer now.)
2488 (and (eq (current-buffer)
2489 (get-buffer gnus-group-buffer))
2490 (gnus-group-group-name)
2491 (gnus-summary-read-group
2492 (gnus-group-group-name) nil no-article))
2496 (defun gnus-summary-prev-group (no-article)
2497 "Exit current newsgroup and then select previous unread newsgroup.
2498 If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
2500 ;; Make sure Group mode buffer point is on current newsgroup.
2501 (gnus-summary-jump-to-group gnus-newsgroup-name)
2502 (let ((group (gnus-summary-search-group t)))
2505 (message "Exiting %s..." gnus-newsgroup-name)
2508 (message "Selecting %s..." group)
2509 (gnus-summary-exit t) ;Exit Summary mode temporary.
2510 ;; We are now in Group mode buffer.
2511 ;; We have to adjust point of Group mode buffer because current
2512 ;; point is moved to next unread newsgroup by exiting.
2513 (gnus-summary-jump-to-group group)
2514 (gnus-summary-read-group group nil no-article)
2515 (or (eq (current-buffer)
2516 (get-buffer gnus-summary-buffer))
2517 (eq gnus-auto-select-next t)
2518 ;; Expected newsgroup has nothing to read since the articles
2519 ;; are marked as read by cross-referencing. So, try next
2520 ;; newsgroup. (Make sure we are in Group mode buffer now.)
2521 (and (eq (current-buffer)
2522 (get-buffer gnus-group-buffer))
2523 (gnus-summary-search-group t)
2524 (gnus-summary-read-group
2525 (gnus-summary-search-group t) nil no-article))
2529 ;; Walking around summary lines.
2531 (defun gnus-summary-next-subject (n &optional unread)
2532 "Go to next N'th summary line.
2533 If optional argument UNREAD is non-nil, only unread article is selected."
2536 (gnus-summary-search-forward unread))
2538 (cond ((gnus-summary-search-forward unread)
2539 (gnus-summary-recenter))
2541 (message "No more unread articles"))
2543 (message "No more articles"))
2546 (defun gnus-summary-next-unread-subject (n)
2547 "Go to next N'th unread summary line."
2549 (gnus-summary-next-subject n t))
2551 (defun gnus-summary-prev-subject (n &optional unread)
2552 "Go to previous N'th summary line.
2553 If optional argument UNREAD is non-nil, only unread article is selected."
2556 (gnus-summary-search-backward unread))
2558 (cond ((gnus-summary-search-backward unread)
2559 (gnus-summary-recenter))
2561 (message "No more unread articles"))
2563 (message "No more articles"))
2566 (defun gnus-summary-prev-unread-subject (n)
2567 "Go to previous N'th unread summary line."
2569 (gnus-summary-prev-subject n t))
2571 ;; Walking around summary lines with displaying articles.
2573 (defun gnus-summary-expand-window ()
2574 "Expand Summary window to show headers full window."
2576 (gnus-configure-windows 'summary)
2577 (pop-to-buffer gnus-summary-buffer))
2579 (defun gnus-summary-display-article (article &optional all-header)
2580 "Display ARTICLE in Article buffer."
2583 (gnus-configure-windows 'article)
2584 (pop-to-buffer gnus-summary-buffer)
2585 (gnus-article-prepare article all-header)
2586 (gnus-summary-recenter)
2587 (gnus-summary-set-mode-line)
2588 (run-hooks 'gnus-select-article-hook)
2589 ;; Successfully display article.
2593 (defun gnus-summary-select-article (&optional all-headers force)
2594 "Select the current article.
2595 Optional first argument ALL-HEADERS is non-nil, show all header fields.
2596 Optional second argument FORCE is nil, the article is only selected
2597 again when current header does not match with ALL-HEADERS option."
2598 (let ((article (gnus-summary-article-number))
2599 (all-headers (not (not all-headers)))) ;Must be T or NIL.
2600 (if (or (null gnus-current-article)
2601 (/= article gnus-current-article)
2602 (and force (not (eq all-headers gnus-have-all-headers))))
2603 ;; The selected one is different from that of the current article.
2604 (gnus-summary-display-article article all-headers)
2605 (gnus-configure-windows 'article)
2606 (pop-to-buffer gnus-summary-buffer))
2609 (defun gnus-summary-set-current-mark (&optional current-mark)
2610 "Put `+' at the current article.
2611 Optional argument specifies CURRENT-MARK instead of `+'."
2613 (set-buffer gnus-summary-buffer)
2614 (let ((buffer-read-only nil))
2615 (goto-char (point-min))
2616 ;; First of all clear mark at last article.
2617 (if (re-search-forward "^.[ \t]+[0-9]+:[^ \t]" nil t)
2621 (goto-char (point-min))))
2622 (if (re-search-forward (format "^.[ \t]+%d:" gnus-current-article) nil t)
2625 (insert (or current-mark "+"))))
2628 ;;(defun gnus-summary-next-article (unread &optional subject)
2629 ;; "Select article after current one.
2630 ;;If argument UNREAD is non-nil, only unread article is selected."
2631 ;; (interactive "P")
2632 ;; (cond ((gnus-summary-display-article
2633 ;; (gnus-summary-search-forward unread subject)))
2635 ;; (message "No more unread articles"))
2637 ;; (message "No more articles"))
2640 (defun gnus-summary-next-article (unread &optional subject)
2641 "Select article after current one.
2642 If argument UNREAD is non-nil, only unread article is selected."
2645 (cond ((gnus-summary-display-article
2646 (gnus-summary-search-forward unread subject)))
2648 gnus-auto-select-same
2649 (gnus-set-difference gnus-newsgroup-unreads
2650 gnus-newsgroup-marked)
2652 '(gnus-summary-next-unread-article
2653 gnus-summary-next-page
2654 gnus-summary-kill-same-subject-and-select
2655 ;;gnus-summary-next-article
2656 ;;gnus-summary-next-same-subject
2657 ;;gnus-summary-next-unread-same-subject
2659 ;; Wrap article pointer if there are unread articles.
2660 ;; Hook function, such as gnus-summary-rmail-digest, may
2661 ;; change current buffer, so need check.
2662 (let ((buffer (current-buffer))
2663 (last-point (point)))
2664 ;; No more articles with same subject, so jump to the first
2666 (gnus-summary-first-unread-article)
2667 ;;(and (eq buffer (current-buffer))
2668 ;; (= (point) last-point)
2669 ;; ;; Ignore given SUBJECT, and try again.
2670 ;; (gnus-summary-next-article unread nil))
2671 (and (eq buffer (current-buffer))
2672 (< (point) last-point)
2673 (message "Wrapped"))
2675 ((and gnus-auto-extend-newsgroup
2676 (not unread) ;Not unread only
2677 (not subject) ;Only if subject is not specified.
2678 (setq header (gnus-more-header-forward)))
2679 ;; Extend to next article if possible.
2680 ;; Basic ideas by himacdonald@watdragon.waterloo.edu
2681 (gnus-extend-newsgroup header nil)
2682 ;; Threads feature must be turned off.
2683 (let ((buffer-read-only nil))
2684 (goto-char (point-max))
2685 (gnus-summary-prepare-threads (list header) 0))
2686 (gnus-summary-goto-article gnus-newsgroup-end))
2688 ;; Select next newsgroup automatically if requested.
2689 (let ((cmd (string-to-char (this-command-keys)))
2690 (group (gnus-summary-search-group))
2692 (and gnus-auto-select-next
2693 ;;(null (gnus-set-difference gnus-newsgroup-unreads
2694 ;; gnus-newsgroup-marked))
2696 '(gnus-summary-next-unread-article
2697 gnus-summary-next-article
2698 gnus-summary-next-page
2699 gnus-summary-next-same-subject
2700 gnus-summary-next-unread-same-subject
2701 gnus-summary-kill-same-subject
2702 gnus-summary-kill-same-subject-and-select
2704 ;; Ignore characters typed ahead.
2705 (not (input-pending-p))
2707 (message "No more%s articles%s"
2708 (if unread " unread" "")
2709 (if (and auto-select
2710 (not (eq gnus-auto-select-next 'quietly)))
2712 (format " (Type %s for %s [%d])"
2713 (key-description (char-to-string cmd))
2715 (nth 1 (gnus-gethash group
2716 gnus-unread-hashtb)))
2717 (format " (Type %s to exit %s)"
2718 (key-description (char-to-string cmd))
2722 ;; Select next unread newsgroup automagically.
2723 (cond ((and auto-select
2724 (eq gnus-auto-select-next 'quietly))
2726 (gnus-summary-next-group nil))
2728 ;; Confirm auto selection.
2729 (let ((char (read-char)))
2731 (gnus-summary-next-group nil)
2732 (setq unread-command-char char))))
2737 (defun gnus-summary-next-unread-article ()
2738 "Select unread article after current one."
2740 (gnus-summary-next-article t (and gnus-auto-select-same
2741 (gnus-summary-subject-string))))
2743 (defun gnus-summary-prev-article (unread &optional subject)
2744 "Select article before current one.
2745 If argument UNREAD is non-nil, only unread article is selected."
2748 (cond ((gnus-summary-display-article
2749 (gnus-summary-search-backward unread subject)))
2751 gnus-auto-select-same
2752 (gnus-set-difference gnus-newsgroup-unreads
2753 gnus-newsgroup-marked)
2755 '(gnus-summary-prev-unread-article
2756 ;;gnus-summary-prev-page
2757 ;;gnus-summary-prev-article
2758 ;;gnus-summary-prev-same-subject
2759 ;;gnus-summary-prev-unread-same-subject
2761 ;; Ignore given SUBJECT, and try again.
2762 (gnus-summary-prev-article unread nil))
2764 (message "No more unread articles"))
2765 ((and gnus-auto-extend-newsgroup
2766 (not subject) ;Only if subject is not specified.
2767 (setq header (gnus-more-header-backward)))
2768 ;; Extend to previous article if possible.
2769 ;; Basic ideas by himacdonald@watdragon.waterloo.edu
2770 (gnus-extend-newsgroup header t)
2771 (let ((buffer-read-only nil))
2772 (goto-char (point-min))
2773 (gnus-summary-prepare-threads (list header) 0))
2774 (gnus-summary-goto-article gnus-newsgroup-begin))
2776 (message "No more articles"))
2779 (defun gnus-summary-prev-unread-article ()
2780 "Select unred article before current one."
2782 (gnus-summary-prev-article t (and gnus-auto-select-same
2783 (gnus-summary-subject-string))))
2785 (defun gnus-summary-next-page (lines)
2786 "Show next page of selected article.
2787 If end of article, select next article.
2788 Argument LINES specifies lines to be scrolled up."
2790 (let ((article (gnus-summary-article-number))
2792 (if (or (null gnus-current-article)
2793 (/= article gnus-current-article))
2794 ;; Selected subject is different from current article's.
2795 (gnus-summary-display-article article)
2796 (gnus-configure-windows 'article)
2797 (pop-to-buffer gnus-summary-buffer)
2798 (gnus-eval-in-buffer-window gnus-article-buffer
2799 (setq endp (gnus-article-next-page lines)))
2800 (cond ((and endp lines)
2801 (message "End of message"))
2802 ((and endp (null lines))
2803 (gnus-summary-next-unread-article)))
2806 (defun gnus-summary-prev-page (lines)
2807 "Show previous page of selected article.
2808 Argument LINES specifies lines to be scrolled down."
2810 (let ((article (gnus-summary-article-number)))
2811 (if (or (null gnus-current-article)
2812 (/= article gnus-current-article))
2813 ;; Selected subject is different from current article's.
2814 (gnus-summary-display-article article)
2815 (gnus-configure-windows 'article)
2816 (pop-to-buffer gnus-summary-buffer)
2817 (gnus-eval-in-buffer-window gnus-article-buffer
2818 (gnus-article-prev-page lines))
2821 (defun gnus-summary-scroll-up (lines)
2822 "Scroll up (or down) one line current article.
2823 Argument LINES specifies lines to be scrolled up (or down if negative)."
2825 (gnus-summary-select-article)
2826 (gnus-eval-in-buffer-window gnus-article-buffer
2828 (if (gnus-article-next-page lines)
2829 (message "End of message")))
2831 (gnus-article-prev-page (- 0 lines))))
2834 (defun gnus-summary-next-same-subject ()
2835 "Select next article which has the same subject as current one."
2837 (gnus-summary-next-article nil (gnus-summary-subject-string)))
2839 (defun gnus-summary-prev-same-subject ()
2840 "Select previous article which has the same subject as current one."
2842 (gnus-summary-prev-article nil (gnus-summary-subject-string)))
2844 (defun gnus-summary-next-unread-same-subject ()
2845 "Select next unread article which has the same subject as current one."
2847 (gnus-summary-next-article t (gnus-summary-subject-string)))
2849 (defun gnus-summary-prev-unread-same-subject ()
2850 "Select previous unread article which has the same subject as current one."
2852 (gnus-summary-prev-article t (gnus-summary-subject-string)))
2854 (defun gnus-summary-refer-parent-article (child)
2855 "Refer parent article of current article.
2856 If a prefix argument CHILD is non-nil, go back to the child article
2857 using internally maintained articles history.
2858 NOTE: This command may not work with nnspool.el."
2860 (gnus-summary-select-article t t) ;Request all headers.
2861 (let ((referenced-id nil)) ;Message-id of parent or child article.
2863 ;; Go back to child article using history.
2864 (gnus-summary-refer-article nil)
2865 (gnus-eval-in-buffer-window gnus-article-buffer
2866 ;; Look for parent Message-ID.
2867 ;; We cannot use gnus-current-headers to get references
2868 ;; because we may be looking at parent or referred article.
2869 (let ((references (gnus-fetch-field "References")))
2870 ;; Get the last message-id in the references.
2872 (string-match "\\(<[^<>]+>\\)[^>]*\\'" references)
2874 (substring references
2875 (match-beginning 1) (match-end 1))))
2877 (if (stringp referenced-id)
2878 (gnus-summary-refer-article referenced-id)
2879 (error "No more parents"))
2882 (defun gnus-summary-refer-article (message-id)
2883 "Refer article specified by MESSAGE-ID.
2884 If the MESSAGE-ID is nil or an empty string, Message-ID is poped from
2885 internally maintained articles history.
2886 NOTE: This command may not work with nnspool.el nor mhspool.el."
2887 (interactive "sMessage-ID: ")
2888 ;; Make sure that this command depends on the fact that article
2889 ;; related information is not updated when an article is retrieved
2891 (gnus-summary-select-article t t) ;Request all headers.
2892 (if (and (stringp message-id)
2893 (> (length message-id) 0))
2894 (gnus-eval-in-buffer-window gnus-article-buffer
2895 ;; Construct the correct Message-ID if necessary.
2896 ;; Suggested by tale@pawl.rpi.edu.
2897 (or (string-match "^<" message-id)
2898 (setq message-id (concat "<" message-id)))
2899 (or (string-match ">$" message-id)
2900 (setq message-id (concat message-id ">")))
2901 ;; Push current message-id on history.
2902 ;; We cannot use gnus-current-headers to get current
2903 ;; message-id because we may be looking at parent or referred
2905 (let ((current (gnus-fetch-field "Message-ID")))
2906 (or (equal current message-id) ;Nothing to do.
2907 (equal current (car gnus-current-history))
2908 (setq gnus-current-history
2909 (cons current gnus-current-history)))
2911 ;; Pop message-id from history.
2912 (setq message-id (car gnus-current-history))
2913 (setq gnus-current-history (cdr gnus-current-history)))
2914 (if (stringp message-id)
2915 ;; Retrieve article by message-id. This may not work with
2916 ;; nnspool nor mhspool.
2917 (gnus-article-prepare message-id t)
2918 (error "No such references"))
2921 (defun gnus-summary-next-digest (nth)
2922 "Move to head of NTH next digested message."
2924 (gnus-summary-select-article)
2925 (gnus-eval-in-buffer-window gnus-article-buffer
2926 (gnus-article-next-digest (or nth 1))
2929 (defun gnus-summary-prev-digest (nth)
2930 "Move to head of NTH previous digested message."
2932 (gnus-summary-select-article)
2933 (gnus-eval-in-buffer-window gnus-article-buffer
2934 (gnus-article-prev-digest (or nth 1))
2937 (defun gnus-summary-first-unread-article ()
2938 "Select first unread article. Return non-nil if successfully selected."
2940 (let ((begin (point)))
2941 (goto-char (point-min))
2942 (if (re-search-forward "^ [ \t]+[0-9]+:" nil t)
2943 (gnus-summary-display-article (gnus-summary-article-number))
2944 ;; If there is no unread articles, stay there.
2946 ;;(gnus-summary-display-article (gnus-summary-article-number))
2947 (message "No more unread articles")
2952 (defun gnus-summary-isearch-article ()
2953 "Do incremental search forward on current article."
2955 (gnus-summary-select-article)
2956 (gnus-eval-in-buffer-window gnus-article-buffer
2959 (defun gnus-summary-search-article-forward (regexp)
2960 "Search for an article containing REGEXP forward.
2961 gnus-select-article-hook is not called during the search."
2964 (concat "Search forward (regexp): "
2965 (if gnus-last-search-regexp
2966 (concat "(default " gnus-last-search-regexp ") "))))))
2967 (if (string-equal regexp "")
2968 (setq regexp (or gnus-last-search-regexp ""))
2969 (setq gnus-last-search-regexp regexp))
2970 (if (gnus-summary-search-article regexp nil)
2971 (gnus-eval-in-buffer-window gnus-article-buffer
2975 (error "Search failed: \"%s\"" regexp)
2978 (defun gnus-summary-search-article-backward (regexp)
2979 "Search for an article containing REGEXP backward.
2980 gnus-select-article-hook is not called during the search."
2983 (concat "Search backward (regexp): "
2984 (if gnus-last-search-regexp
2985 (concat "(default " gnus-last-search-regexp ") "))))))
2986 (if (string-equal regexp "")
2987 (setq regexp (or gnus-last-search-regexp ""))
2988 (setq gnus-last-search-regexp regexp))
2989 (if (gnus-summary-search-article regexp t)
2990 (gnus-eval-in-buffer-window gnus-article-buffer
2994 (error "Search failed: \"%s\"" regexp)
2997 (defun gnus-summary-search-article (regexp &optional backward)
2998 "Search for an article containing REGEXP.
2999 Optional argument BACKWARD means do search for backward.
3000 gnus-select-article-hook is not called during the search."
3001 (let ((gnus-select-article-hook nil) ;Disable hook.
3002 (gnus-mark-article-hook nil) ;Inhibit marking as read.
3005 (function re-search-backward) (function re-search-forward)))
3008 ;; Hidden thread subtrees must be searched for ,too.
3009 (gnus-summary-show-all-threads)
3010 ;; First of all, search current article.
3011 ;; We don't want to read article again from NNTP server nor reset
3013 (gnus-summary-select-article)
3014 (message "Searching article: %d..." gnus-current-article)
3015 (setq last gnus-current-article)
3016 (gnus-eval-in-buffer-window gnus-article-buffer
3019 ;; Begin search from current point.
3020 (setq found (funcall re-search regexp nil t))))
3021 ;; Then search next articles.
3022 (while (and (not found)
3023 (gnus-summary-display-article
3024 (gnus-summary-search-subject backward nil nil)))
3025 (message "Searching article: %d..." gnus-current-article)
3026 (gnus-eval-in-buffer-window gnus-article-buffer
3029 (goto-char (if backward (point-max) (point-min)))
3030 (setq found (funcall re-search regexp nil t)))
3033 ;; Adjust article pointer.
3034 (or (eq last gnus-current-article)
3035 (setq gnus-last-article last))
3036 ;; Return T if found such article.
3040 (defun gnus-summary-execute-command (field regexp command &optional backward)
3041 "If FIELD of article header matches REGEXP, execute a COMMAND string.
3042 If FIELD is an empty string (or nil), entire article body is searched for.
3043 If optional (prefix) argument BACKWARD is non-nil, do backward instead."
3045 (list (let ((completion-ignore-case t))
3046 (completing-read "Field name: "
3047 '(("Number")("Subject")("From")
3048 ("Lines")("Date")("Id")
3049 ("Xref")("References"))
3050 nil 'require-match))
3051 (read-string "Regexp: ")
3052 (read-key-sequence "Command: ")
3053 current-prefix-arg))
3054 ;; Hidden thread subtrees must be searched for ,too.
3055 (gnus-summary-show-all-threads)
3056 ;; We don't want to change current point nor window configuration.
3058 (save-window-excursion
3059 (message "Executing %s..." (key-description command))
3060 ;; We'd like to execute COMMAND interactively so as to give arguments.
3061 (gnus-execute field regexp
3063 (call-interactively '(, (key-binding command)))))
3065 (message "Executing %s... done" (key-description command)))))
3067 (defun gnus-summary-beginning-of-article ()
3068 "Go to beginning of article body"
3070 (gnus-summary-select-article)
3071 (gnus-eval-in-buffer-window gnus-article-buffer
3073 (beginning-of-buffer)
3074 (if gnus-break-pages
3075 (gnus-narrow-to-page))
3078 (defun gnus-summary-end-of-article ()
3079 "Go to end of article body"
3081 (gnus-summary-select-article)
3082 (gnus-eval-in-buffer-window gnus-article-buffer
3085 (if gnus-break-pages
3086 (gnus-narrow-to-page))
3089 (defun gnus-summary-goto-article (article &optional all-headers)
3090 "Read ARTICLE if exists.
3091 Optional argument ALL-HEADERS means all headers are shown."
3095 (completing-read "Article number: "
3100 (int-to-string (nntp-header-number headers)))))
3101 gnus-newsgroup-headers)
3102 nil 'require-match))))
3103 (if (gnus-summary-goto-subject article)
3104 (gnus-summary-display-article article all-headers)))
3106 (defun gnus-summary-goto-last-article ()
3107 "Go to last subject line."
3109 (if gnus-last-article
3110 (gnus-summary-goto-article gnus-last-article)))
3112 (defun gnus-summary-show-article ()
3113 "Force to show current article."
3115 ;; The following is a trick to force to read the current article again.
3116 (setq gnus-have-all-headers (not gnus-have-all-headers))
3117 (gnus-summary-select-article (not gnus-have-all-headers) t))
3119 (defun gnus-summary-toggle-header (arg)
3120 "Show original header if pruned header currently shown, or vice versa.
3121 With arg, show original header iff arg is positive."
3123 ;; Variable gnus-show-all-headers must be NIL to toggle really.
3124 (let ((gnus-show-all-headers nil)
3126 (if (null arg) (not gnus-have-all-headers)
3127 (> (prefix-numeric-value arg) 0))))
3128 (gnus-summary-select-article all-headers t)))
3130 (defun gnus-summary-show-all-headers ()
3131 "Show original article header."
3133 (gnus-summary-select-article t t))
3135 (defun gnus-summary-toggle-mime (arg)
3136 "Toggle MIME processing.
3137 With arg, turn MIME processing on iff arg is positive."
3139 (setq gnus-show-mime
3140 (if (null arg) (not gnus-show-mime)
3141 (> (prefix-numeric-value arg) 0)))
3142 ;; The following is a trick to force to read the current article again.
3143 (setq gnus-have-all-headers (not gnus-have-all-headers))
3144 (gnus-summary-select-article (not gnus-have-all-headers) t))
3146 (defun gnus-summary-stop-page-breaking ()
3147 "Stop page breaking by linefeed temporary (Widen article buffer)."
3149 (gnus-summary-select-article)
3150 (gnus-eval-in-buffer-window gnus-article-buffer
3154 (defun gnus-summary-kill-same-subject-and-select (unmark)
3155 "Mark articles which has the same subject as read, and then select next.
3156 If argument UNMARK is positive, remove any kinds of marks.
3157 If argument UNMARK is negative, mark articles as unread instead."
3160 (setq unmark (prefix-numeric-value unmark)))
3162 (gnus-summary-mark-same-subject
3163 (gnus-summary-subject-string) unmark)))
3164 ;; Select next unread article. If auto-select-same mode, should
3165 ;; select the first unread article.
3166 (gnus-summary-next-article t (and gnus-auto-select-same
3167 (gnus-summary-subject-string)))
3168 (message "%d articles are marked as %s"
3169 count (if unmark "unread" "read"))
3172 (defun gnus-summary-kill-same-subject (unmark)
3173 "Mark articles which has the same subject as read.
3174 If argument UNMARK is positive, remove any kinds of marks.
3175 If argument UNMARK is negative, mark articles as unread instead."
3178 (setq unmark (prefix-numeric-value unmark)))
3180 (gnus-summary-mark-same-subject
3181 (gnus-summary-subject-string) unmark)))
3182 ;; If marked as read, go to next unread subject.
3184 ;; Go to next unread subject.
3185 (gnus-summary-next-subject 1 t))
3186 (message "%d articles are marked as %s"
3187 count (if unmark "unread" "read"))
3190 (defun gnus-summary-mark-same-subject (subject &optional unmark)
3191 "Mark articles with same SUBJECT as read, and return marked number.
3192 If optional argument UNMARK is positive, remove any kinds of marks.
3193 If optional argument UNMARK is negative, mark articles as unread instead."
3196 (cond ((null unmark)
3197 (gnus-summary-mark-as-read nil "K"))
3199 (gnus-summary-mark-as-unread nil t))
3201 (gnus-summary-mark-as-unread)))
3203 (gnus-summary-search-forward nil subject))
3204 (cond ((null unmark)
3205 (gnus-summary-mark-as-read nil "K"))
3207 (gnus-summary-mark-as-unread nil t))
3209 (gnus-summary-mark-as-unread)))
3210 (setq count (1+ count))
3212 ;; Hide killed thread subtrees. Does not work properly always.
3213 ;;(and (null unmark)
3214 ;; gnus-thread-hide-killed
3215 ;; (gnus-summary-hide-thread))
3216 ;; Return number of articles marked as read.
3220 (defun gnus-summary-mark-as-unread-forward (count)
3221 "Mark current article as unread, and then go forward.
3222 Argument COUNT specifies number of articles marked as unread."
3225 (gnus-summary-mark-as-unread nil nil)
3226 (gnus-summary-next-subject 1 nil)
3227 (setq count (1- count))))
3229 (defun gnus-summary-mark-as-unread-backward (count)
3230 "Mark current article as unread, and then go backward.
3231 Argument COUNT specifies number of articles marked as unread."
3234 (gnus-summary-mark-as-unread nil nil)
3235 (gnus-summary-prev-subject 1 nil)
3236 (setq count (1- count))))
3238 (defun gnus-summary-mark-as-unread (&optional article clear-mark)
3239 "Mark current article as unread.
3240 Optional 1st argument ARTICLE specifies article number to be marked as unread.
3241 Optional 2nd argument CLEAR-MARK remove any kinds of mark."
3243 (set-buffer gnus-summary-buffer)
3244 ;; First of all, show hidden thread subtrees.
3245 (gnus-summary-show-thread)
3246 (let* ((buffer-read-only nil)
3247 (current (gnus-summary-article-number))
3248 (article (or article current)))
3249 (gnus-mark-article-as-unread article clear-mark)
3250 (if (or (eq article current)
3251 (gnus-summary-goto-subject article))
3255 (insert (if clear-mark " " "-"))))
3258 (defun gnus-summary-mark-as-read-forward (count)
3259 "Mark current article as read, and then go forward.
3260 Argument COUNT specifies number of articles marked as read"
3263 (gnus-summary-mark-as-read)
3264 (gnus-summary-next-subject 1 'unread-only)
3265 (setq count (1- count))))
3267 (defun gnus-summary-mark-as-read-backward (count)
3268 "Mark current article as read, and then go backward.
3269 Argument COUNT specifies number of articles marked as read"
3272 (gnus-summary-mark-as-read)
3273 (gnus-summary-prev-subject 1 'unread-only)
3274 (setq count (1- count))))
3276 (defun gnus-summary-mark-as-read (&optional article mark)
3277 "Mark current article as read.
3278 Optional 1st argument ARTICLE specifies article number to be marked as read.
3279 Optional 2nd argument MARK specifies a string inserted at beginning of line.
3280 Any kind of string (length 1) except for a space and `-' is ok."
3282 (set-buffer gnus-summary-buffer)
3283 ;; First of all, show hidden thread subtrees.
3284 (gnus-summary-show-thread)
3285 (let* ((buffer-read-only nil)
3286 (mark (or mark "D")) ;Default mark is `D'.
3287 (current (gnus-summary-article-number))
3288 (article (or article current)))
3289 (gnus-mark-article-as-read article)
3290 (if (or (eq article current)
3291 (gnus-summary-goto-subject article))
3298 (defun gnus-summary-clear-mark-forward (count)
3299 "Remove current article's mark, and go forward.
3300 Argument COUNT specifies number of articles unmarked"
3303 (gnus-summary-mark-as-unread nil t)
3304 (gnus-summary-next-subject 1 nil)
3305 (setq count (1- count))))
3307 (defun gnus-summary-clear-mark-backward (count)
3308 "Remove current article's mark, and go backward.
3309 Argument COUNT specifies number of articles unmarked"
3312 (gnus-summary-mark-as-unread nil t)
3313 (gnus-summary-prev-subject 1 nil)
3314 (setq count (1- count))))
3316 (defun gnus-summary-delete-marked-as-read ()
3317 "Delete lines which is marked as read."
3319 (if gnus-newsgroup-unreads
3320 (let ((buffer-read-only nil))
3322 (goto-char (point-min))
3323 (delete-non-matching-lines "^[- ]"))
3326 (gnus-summary-prev-subject 1)
3328 (search-forward ":" nil t)))
3329 ;; It is not so good idea to make the buffer empty.
3330 (message "All articles are marked as read")
3333 (defun gnus-summary-delete-marked-with (marks)
3334 "Delete lines which are marked with MARKS (e.g. \"DK\")."
3335 (interactive "sMarks: ")
3336 (let ((buffer-read-only nil))
3338 (goto-char (point-min))
3339 (delete-matching-lines (concat "^[" marks "]")))
3341 (or (zerop (buffer-size))
3343 (gnus-summary-prev-subject 1)
3345 (search-forward ":" nil t)))
3348 ;; Thread-based commands.
3350 (defun gnus-summary-toggle-threads (arg)
3351 "Toggle showing conversation threads.
3352 With arg, turn showing conversation threads on iff arg is positive."
3354 (let ((current (gnus-summary-article-number)))
3355 (setq gnus-show-threads
3356 (if (null arg) (not gnus-show-threads)
3357 (> (prefix-numeric-value arg) 0)))
3358 (gnus-summary-prepare)
3359 (gnus-summary-goto-subject current)
3362 (defun gnus-summary-show-all-threads ()
3363 "Show all thread subtrees."
3365 (if gnus-show-threads
3367 (let ((buffer-read-only nil))
3368 (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
3371 (defun gnus-summary-show-thread ()
3372 "Show thread subtrees."
3374 (if gnus-show-threads
3376 (let ((buffer-read-only nil))
3377 (subst-char-in-region (progn
3378 (beginning-of-line) (point))
3380 (end-of-line) (point))
3384 (defun gnus-summary-hide-all-threads ()
3385 "Hide all thread subtrees."
3387 (if gnus-show-threads
3389 ;; Adjust cursor point.
3390 (goto-char (point-min))
3391 (search-forward ":" nil t)
3392 (let ((level (current-column)))
3393 (gnus-summary-hide-thread)
3394 (while (gnus-summary-search-forward)
3395 (and (>= level (current-column))
3396 (gnus-summary-hide-thread)))
3399 (defun gnus-summary-hide-thread ()
3400 "Hide thread subtrees."
3402 (if gnus-show-threads
3404 ;; Adjust cursor point.
3406 (search-forward ":" nil t)
3407 (let ((buffer-read-only nil)
3410 (level (current-column)))
3411 (while (and (gnus-summary-search-forward)
3412 (< level (current-column)))
3413 ;; Interested in lower levels.
3414 (if (< level (current-column))
3419 (subst-char-in-region init last ?\n ?\^M t)
3422 (defun gnus-summary-next-thread (n)
3423 "Go to the same level next thread.
3424 Argument N specifies the number of threads."
3426 ;; Adjust cursor point.
3428 (search-forward ":" nil t)
3429 (let ((init (point))
3431 (level (current-column)))
3433 (gnus-summary-search-forward)
3434 (<= level (current-column)))
3435 ;; We have to skip lower levels.
3436 (if (= level (current-column))
3442 ;; Return non-nil if successfully move to the next.
3443 (prog1 (not (= init last))
3447 (defun gnus-summary-prev-thread (n)
3448 "Go to the same level previous thread.
3449 Argument N specifies the number of threads."
3451 ;; Adjust cursor point.
3453 (search-forward ":" nil t)
3454 (let ((init (point))
3456 (level (current-column)))
3458 (gnus-summary-search-backward)
3459 (<= level (current-column)))
3460 ;; We have to skip lower levels.
3461 (if (= level (current-column))
3467 ;; Return non-nil if successfully move to the previous.
3468 (prog1 (not (= init last))
3472 (defun gnus-summary-down-thread (d)
3473 "Go downward current thread.
3474 Argument D specifies the depth goes down."
3476 ;; Adjust cursor point.
3478 (search-forward ":" nil t)
3479 (let ((last (point))
3480 (level (current-column)))
3482 (gnus-summary-search-forward)
3483 (<= level (current-column))) ;<= can be <. Which do you like?
3484 ;; We have to skip the same levels.
3485 (if (< level (current-column))
3488 (setq level (current-column))
3495 (defun gnus-summary-up-thread (d)
3496 "Go upward current thread.
3497 Argument D specifies the depth goes up."
3499 ;; Adjust cursor point.
3501 (search-forward ":" nil t)
3502 (let ((last (point))
3503 (level (current-column)))
3505 (gnus-summary-search-backward))
3506 ;; We have to skip the same levels.
3507 (if (> level (current-column))
3510 (setq level (current-column))
3517 (defun gnus-summary-kill-thread (unmark)
3518 "Mark articles under current thread as read.
3519 If argument UNMARK is positive, remove any kinds of marks.
3520 If argument UNMARK is negative, mark articles as unread instead."
3523 (setq unmark (prefix-numeric-value unmark)))
3524 ;; Adjust cursor point.
3526 (search-forward ":" nil t)
3528 (let ((level (current-column)))
3529 ;; Mark current article.
3530 (cond ((null unmark)
3531 (gnus-summary-mark-as-read nil "K"))
3533 (gnus-summary-mark-as-unread nil t))
3535 (gnus-summary-mark-as-unread))
3537 ;; Mark following articles.
3538 (while (and (gnus-summary-search-forward)
3539 (< level (current-column)))
3540 (cond ((null unmark)
3541 (gnus-summary-mark-as-read nil "K"))
3543 (gnus-summary-mark-as-unread nil t))
3545 (gnus-summary-mark-as-unread))
3548 ;; Hide killed subtrees.
3550 gnus-thread-hide-killed
3551 (gnus-summary-hide-thread))
3552 ;; If marked as read, go to next unread subject.
3554 ;; Go to next unread subject.
3555 (gnus-summary-next-subject 1 t))
3558 (defun gnus-summary-toggle-truncation (arg)
3559 "Toggle truncation of summary lines.
3560 With arg, turn line truncation on iff arg is positive."
3562 (setq truncate-lines
3563 (if (null arg) (not truncate-lines)
3564 (> (prefix-numeric-value arg) 0)))
3567 (defun gnus-summary-sort-by-number (reverse)
3568 "Sort Summary buffer by article number.
3569 Argument REVERSE means reverse order."
3571 (gnus-summary-keysort-summary
3575 (nntp-header-number a)))
3579 (defun gnus-summary-sort-by-author (reverse)
3580 "Sort Summary buffer by author name alphabetically.
3581 If case-fold-search is non-nil, case of letters is ignored.
3582 Argument REVERSE means reverse order."
3584 (gnus-summary-keysort-summary
3585 (function string-lessp)
3588 (if case-fold-search
3589 (downcase (nntp-header-from a))
3590 (nntp-header-from a))))
3594 (defun gnus-summary-sort-by-subject (reverse)
3595 "Sort Summary buffer by subject alphabetically. `Re:'s are ignored.
3596 If case-fold-search is non-nil, case of letters is ignored.
3597 Argument REVERSE means reverse order."
3599 (gnus-summary-keysort-summary
3600 (function string-lessp)
3603 (if case-fold-search
3604 (downcase (gnus-simplify-subject (nntp-header-subject a) 're-only))
3605 (gnus-simplify-subject (nntp-header-subject a) 're-only))))
3609 (defun gnus-summary-sort-by-date (reverse)
3610 "Sort Summary buffer by date.
3611 Argument REVERSE means reverse order."
3613 (gnus-summary-keysort-summary
3614 (function string-lessp)
3617 (gnus-sortable-date (nntp-header-date a))))
3621 (defun gnus-summary-keysort-summary (predicate key &optional reverse)
3622 "Sort Summary buffer by PREDICATE using a value passed by KEY.
3623 Optional argument REVERSE means reverse order."
3624 (let ((current (gnus-summary-article-number)))
3625 (gnus-keysort-headers predicate key reverse)
3626 (gnus-summary-prepare)
3627 (gnus-summary-goto-subject current)
3630 (defun gnus-summary-sort-summary (predicate &optional reverse)
3631 "Sort Summary buffer by PREDICATE.
3632 Optional argument REVERSE means reverse order."
3633 (let ((current (gnus-summary-article-number)))
3634 (gnus-sort-headers predicate reverse)
3635 (gnus-summary-prepare)
3636 (gnus-summary-goto-subject current)
3639 (defun gnus-summary-reselect-current-group (show-all)
3640 "Once exit and then reselect the current newsgroup.
3641 Prefix argument SHOW-ALL means to select all articles."
3643 (let ((current-subject (gnus-summary-article-number)))
3644 (gnus-summary-exit t)
3645 ;; We have to adjust the point of Group mode buffer because the
3646 ;; current point was moved to the next unread newsgroup by
3648 (gnus-summary-jump-to-group gnus-newsgroup-name)
3649 (gnus-group-read-group show-all t)
3650 (gnus-summary-goto-subject current-subject)
3653 (defun gnus-summary-caesar-message (rotnum)
3654 "Caesar rotates all letters of current message by 13/47 places.
3655 With prefix arg, specifies the number of places to rotate each letter forward.
3656 Caesar rotates Japanese letters by 47 places in any case."
3658 (gnus-summary-select-article)
3659 (gnus-overload-functions)
3660 (gnus-eval-in-buffer-window gnus-article-buffer
3663 ;; We don't want to jump to the beginning of the message.
3664 ;; `save-excursion' does not do its job.
3665 (move-to-window-line 0)
3666 (let ((last (point)))
3667 (news-caesar-buffer-body rotnum)
3673 (defun gnus-summary-rmail-digest ()
3674 "Run RMAIL on current digest article.
3675 gnus-select-digest-hook will be called with no arguments, if that
3676 value is non-nil. It is possible to modify the article so that Rmail
3678 gnus-rmail-digest-hook will be called with no arguments, if that value
3679 is non-nil. The hook is intended to customize Rmail mode."
3681 (gnus-summary-select-article)
3683 (let ((artbuf gnus-article-buffer)
3684 (digbuf (get-buffer-create gnus-digest-buffer))
3685 (mail-header-separator ""))
3687 (buffer-flush-undo (current-buffer))
3688 (setq buffer-read-only nil)
3690 (insert-buffer-substring artbuf)
3691 (run-hooks 'gnus-select-digest-hook)
3692 (gnus-convert-article-to-rmail)
3693 (goto-char (point-min))
3694 ;; Rmail initializations.
3695 (rmail-insert-rmail-file-header)
3697 (rmail-set-message-counters)
3698 (rmail-show-message)
3701 (undigestify-rmail-message)
3702 (rmail-expunge) ;Delete original message.
3703 ;; File name is meaningless but `save-buffer' requires it.
3704 (setq buffer-file-name "GNUS Digest")
3705 (setq mode-line-buffer-identification
3707 (nntp-header-subject gnus-current-headers)))
3708 ;; There is no need to write this buffer to a file.
3709 (make-local-variable 'write-file-hooks)
3710 (setq write-file-hooks
3713 (set-buffer-modified-p nil)
3714 (message "(No changes need to be saved)")
3715 'no-need-to-write-this-buffer))))
3716 ;; Default file name saving digest messages.
3717 (setq rmail-last-rmail-file
3718 (funcall gnus-rmail-save-name
3720 gnus-current-headers
3721 gnus-newsgroup-last-rmail
3723 (setq rmail-last-file
3724 (funcall gnus-mail-save-name
3726 gnus-current-headers
3727 gnus-newsgroup-last-mail
3729 ;; Prevent generating new buffer named ***<N> each time.
3730 (setq rmail-summary-buffer
3731 (get-buffer-create gnus-digest-summary-buffer))
3732 (run-hooks 'gnus-rmail-digest-hook)
3733 ;; Take all windows safely.
3734 (gnus-configure-windows '(1 0 0))
3735 (pop-to-buffer gnus-group-buffer)
3736 ;; Use Summary Article windows for Digest summary and
3738 (if gnus-digest-show-summary
3739 (let ((gnus-summary-buffer gnus-digest-summary-buffer)
3740 (gnus-article-buffer gnus-digest-buffer))
3741 (gnus-configure-windows 'article)
3742 (pop-to-buffer gnus-digest-buffer)
3744 (pop-to-buffer gnus-digest-summary-buffer)
3745 (message (substitute-command-keys
3746 "Type \\[rmail-summary-quit] to return to GNUS")))
3747 (let ((gnus-summary-buffer gnus-digest-buffer))
3748 (gnus-configure-windows 'summary)
3749 (pop-to-buffer gnus-digest-buffer)
3750 (message (substitute-command-keys
3751 "Type \\[rmail-quit] to return to GNUS")))
3753 ;; Move the buffers to the end of buffer list.
3754 (bury-buffer gnus-article-buffer)
3755 (bury-buffer gnus-group-buffer)
3756 (bury-buffer gnus-digest-summary-buffer)
3757 (bury-buffer gnus-digest-buffer))
3758 (error (set-buffer-modified-p nil)
3759 (kill-buffer digbuf)
3760 ;; This command should not signal an error because the
3761 ;; command is called from hooks.
3762 (ding) (message "Article is not a digest")))
3765 (defun gnus-summary-save-article ()
3766 "Save this article using default saver function.
3767 The variable `gnus-default-article-saver' specifies the saver function."
3769 (gnus-summary-select-article gnus-save-all-headers gnus-save-all-headers)
3770 (if gnus-default-article-saver
3771 (call-interactively gnus-default-article-saver)
3772 (error "No default saver is defined.")))
3774 (defun gnus-summary-save-in-rmail (&optional filename)
3775 "Append this article to Rmail file.
3776 Optional argument FILENAME specifies file name.
3777 Directory to save to is default to `gnus-article-save-directory' which
3778 is initialized from the SAVEDIR environment variable."
3780 (gnus-summary-select-article gnus-save-all-headers gnus-save-all-headers)
3781 (gnus-eval-in-buffer-window gnus-article-buffer
3786 (funcall gnus-rmail-save-name
3788 gnus-current-headers
3789 gnus-newsgroup-last-rmail
3794 (concat "Save article in Rmail file: (default "
3795 (file-name-nondirectory default-name)
3797 (file-name-directory default-name)
3799 (gnus-make-directory (file-name-directory filename))
3800 (gnus-output-to-rmail filename)
3801 ;; Remember the directory name to save articles.
3802 (setq gnus-newsgroup-last-rmail filename)
3806 (defun gnus-summary-save-in-mail (&optional filename)
3807 "Append this article to Unix mail file.
3808 Optional argument FILENAME specifies file name.
3809 Directory to save to is default to `gnus-article-save-directory' which
3810 is initialized from the SAVEDIR environment variable."
3812 (gnus-summary-select-article gnus-save-all-headers gnus-save-all-headers)
3813 (gnus-eval-in-buffer-window gnus-article-buffer
3818 (funcall gnus-mail-save-name
3820 gnus-current-headers
3821 gnus-newsgroup-last-mail
3826 (concat "Save article in Unix mail file: (default "
3827 (file-name-nondirectory default-name)
3829 (file-name-directory default-name)
3832 (expand-file-name filename
3834 (file-name-directory default-name))))
3835 (gnus-make-directory (file-name-directory filename))
3836 (if (and (file-readable-p filename) (rmail-file-p filename))
3837 (gnus-output-to-rmail filename)
3838 (rmail-output filename 1 t t))
3839 ;; Remember the directory name to save articles.
3840 (setq gnus-newsgroup-last-mail filename)
3844 (defun gnus-summary-save-in-file (&optional filename)
3845 "Append this article to file.
3846 Optional argument FILENAME specifies file name.
3847 Directory to save to is default to `gnus-article-save-directory' which
3848 is initialized from the SAVEDIR environment variable."
3850 (gnus-summary-select-article gnus-save-all-headers gnus-save-all-headers)
3851 (gnus-eval-in-buffer-window gnus-article-buffer
3856 (funcall gnus-file-save-name
3858 gnus-current-headers
3859 gnus-newsgroup-last-file
3864 (concat "Save article in file: (default "
3865 (file-name-nondirectory default-name)
3867 (file-name-directory default-name)
3869 (gnus-make-directory (file-name-directory filename))
3870 (gnus-output-to-file filename)
3871 ;; Remember the directory name to save articles.
3872 (setq gnus-newsgroup-last-file filename)
3876 (defun gnus-summary-save-in-folder (&optional folder)
3877 "Save this article to MH folder (using `rcvstore' in MH library).
3878 Optional argument FOLDER specifies folder name."
3880 (gnus-summary-select-article gnus-save-all-headers gnus-save-all-headers)
3881 (gnus-eval-in-buffer-window gnus-article-buffer
3884 ;; Thanks to yuki@flab.Fujitsu.JUNET and ohm@kaba.junet.
3888 (mh-prompt-for-folder "Save article in"
3889 (funcall gnus-folder-save-name
3891 gnus-current-headers
3892 gnus-newsgroup-last-folder
3896 (errbuf (get-buffer-create " *GNUS rcvstore*")))
3898 (call-process-region (point-min) (point-max)
3899 (expand-file-name "rcvstore" mh-lib)
3900 nil errbuf nil folder)
3902 (if (zerop (buffer-size))
3903 (message "Article saved in folder: %s" folder)
3904 (message "%s" (buffer-string)))
3905 (kill-buffer errbuf)
3906 (setq gnus-newsgroup-last-folder folder))
3910 (defun gnus-summary-pipe-output ()
3911 "Pipe this article to subprocess."
3913 ;; Ignore `gnus-save-all-headers' since this is not save command.
3914 ;;(gnus-summary-select-article)
3915 ;; Huuum. Is this right?
3916 (gnus-summary-select-article gnus-save-all-headers gnus-save-all-headers)
3917 (gnus-eval-in-buffer-window gnus-article-buffer
3920 (let ((command (read-string "Shell command on article: "
3921 gnus-last-shell-command)))
3922 (if (string-equal command "")
3923 (setq command gnus-last-shell-command))
3924 (shell-command-on-region (point-min) (point-max) command nil)
3925 (setq gnus-last-shell-command command)
3929 (defun gnus-summary-catchup (all &optional quietly)
3930 "Mark all articles not marked as unread in this newsgroup as read.
3931 If prefix argument ALL is non-nil, all articles are marked as read."
3936 "Do you really want to mark everything as read? "
3937 "Delete all articles not marked as unread? ")))
3939 (gnus-set-difference gnus-newsgroup-unreads
3940 (if (not all) gnus-newsgroup-marked))))
3941 (message "") ;Erase "Yes or No" question.
3942 ;; Hidden thread subtrees must be searched for ,too.
3943 (gnus-summary-show-all-threads)
3945 (gnus-summary-mark-as-read (car unmarked) "C")
3946 (setq unmarked (cdr unmarked))
3950 (defun gnus-summary-catchup-all (&optional quietly)
3951 "Mark all articles in this newsgroup as read."
3953 (gnus-summary-catchup t quietly))
3955 (defun gnus-summary-catchup-and-exit (all &optional quietly)
3956 "Mark all articles not marked as unread in this newsgroup as read, then exit.
3957 If prefix argument ALL is non-nil, all articles are marked as read."
3962 "Do you really want to mark everything as read? "
3963 "Delete all articles not marked as unread? ")))
3965 (gnus-set-difference gnus-newsgroup-unreads
3966 (if (not all) gnus-newsgroup-marked))))
3967 (message "") ;Erase "Yes or No" question.
3969 (gnus-mark-article-as-read (car unmarked))
3970 (setq unmarked (cdr unmarked)))
3971 ;; Select next newsgroup or exit.
3972 (cond ((eq gnus-auto-select-next 'quietly)
3973 ;; Select next newsgroup quietly.
3974 (gnus-summary-next-group nil))
3976 (gnus-summary-exit)))
3979 (defun gnus-summary-catchup-all-and-exit (&optional quietly)
3980 "Mark all articles in this newsgroup as read, and then exit."
3982 (gnus-summary-catchup-and-exit t quietly))
3984 (defun gnus-summary-edit-global-kill ()
3985 "Edit a global KILL file."
3987 (setq gnus-current-kill-article (gnus-summary-article-number))
3988 (gnus-kill-file-edit-file nil) ;Nil stands for global KILL file.
3990 (substitute-command-keys
3991 "Editing a global KILL file (Type \\[gnus-kill-file-exit] to exit)")))
3993 (defun gnus-summary-edit-local-kill ()
3994 "Edit a local KILL file applied to the current newsgroup."
3996 (setq gnus-current-kill-article (gnus-summary-article-number))
3997 (gnus-kill-file-edit-file gnus-newsgroup-name)
3999 (substitute-command-keys
4000 "Editing a local KILL file (Type \\[gnus-kill-file-exit] to exit)")))
4002 (defun gnus-summary-exit (&optional temporary)
4003 "Exit reading current newsgroup, and then return to group selection mode.
4004 gnus-exit-group-hook is called with no arguments if that value is non-nil."
4007 (gnus-newsgroup-headers gnus-newsgroup-headers)
4008 (gnus-newsgroup-unreads gnus-newsgroup-unreads)
4009 (gnus-newsgroup-unselected gnus-newsgroup-unselected)
4010 (gnus-newsgroup-marked gnus-newsgroup-marked))
4011 ;; Important internal variables are saved, so we can reenter
4012 ;; Summary buffer even if hook changes them.
4013 (run-hooks 'gnus-exit-group-hook)
4014 (gnus-update-unread-articles gnus-newsgroup-name
4015 (append gnus-newsgroup-unselected
4016 gnus-newsgroup-unreads)
4017 gnus-newsgroup-marked)
4018 ;; T means ignore unsubscribed newsgroups.
4019 (if gnus-use-cross-reference
4021 (gnus-mark-as-read-by-xref gnus-newsgroup-name
4022 gnus-newsgroup-headers
4023 gnus-newsgroup-unreads
4024 (eq gnus-use-cross-reference t)
4026 ;; Do not switch windows but change the buffer to work.
4027 (set-buffer gnus-group-buffer)
4028 ;; Update cross referenced group info.
4030 (gnus-group-update-group (car updated) t) ;Ignore invisible group.
4031 (setq updated (cdr updated)))
4032 (gnus-group-update-group gnus-newsgroup-name))
4033 ;; Make sure where I was, and go to next newsgroup.
4034 (gnus-group-jump-to-group gnus-newsgroup-name)
4035 (gnus-group-next-unread-group 1)
4037 ;; If exiting temporary, caller should adjust Group mode
4038 ;; buffer point by itself.
4040 ;; Return to Group mode buffer.
4041 (if (get-buffer gnus-summary-buffer)
4042 (bury-buffer gnus-summary-buffer))
4043 (if (get-buffer gnus-article-buffer)
4044 (bury-buffer gnus-article-buffer))
4045 (gnus-configure-windows 'newsgroups)
4046 (pop-to-buffer gnus-group-buffer)))
4048 (defun gnus-summary-quit ()
4049 "Quit reading current newsgroup without updating read article info."
4051 (if (y-or-n-p "Do you really wanna quit reading this group? ")
4053 (message "") ;Erase "Yes or No" question.
4054 ;; Return to Group selection mode.
4055 (if (get-buffer gnus-summary-buffer)
4056 (bury-buffer gnus-summary-buffer))
4057 (if (get-buffer gnus-article-buffer)
4058 (bury-buffer gnus-article-buffer))
4059 (gnus-configure-windows 'newsgroups)
4060 (pop-to-buffer gnus-group-buffer)
4061 (gnus-group-jump-to-group gnus-newsgroup-name) ;Make sure where I was.
4062 (gnus-group-next-group 1) ;(gnus-group-next-unread-group 1)
4065 (defun gnus-summary-describe-briefly ()
4066 "Describe Summary mode commands briefly."
4070 (substitute-command-keys "\\[gnus-summary-next-page]:Select ")
4071 (substitute-command-keys "\\[gnus-summary-next-unread-article]:Forward ")
4072 (substitute-command-keys "\\[gnus-summary-prev-unread-article]:Backward ")
4073 (substitute-command-keys "\\[gnus-summary-exit]:Exit ")
4074 (substitute-command-keys "\\[gnus-info-find-node]:Run Info ")
4075 (substitute-command-keys "\\[gnus-summary-describe-briefly]:This help")
4080 ;;; GNUS Article Mode
4083 (if gnus-article-mode-map
4085 (setq gnus-article-mode-map (make-keymap))
4086 (suppress-keymap gnus-article-mode-map)
4087 (define-key gnus-article-mode-map " " 'gnus-article-next-page)
4088 (define-key gnus-article-mode-map "\177" 'gnus-article-prev-page)
4089 (define-key gnus-article-mode-map "r" 'gnus-article-refer-article)
4090 (define-key gnus-article-mode-map "o" 'gnus-article-pop-article)
4091 (define-key gnus-article-mode-map "h" 'gnus-article-show-summary)
4092 (define-key gnus-article-mode-map "s" 'gnus-article-show-summary)
4093 (define-key gnus-article-mode-map "?" 'gnus-article-describe-briefly)
4094 (define-key gnus-article-mode-map "\C-c\C-i" 'gnus-info-find-node))
4096 (defun gnus-article-mode ()
4097 "Major mode for browsing through an article.
4098 All normal editing commands are turned off.
4099 Instead, these commands are available:
4100 \\{gnus-article-mode-map}
4102 Various hooks for customization:
4103 gnus-article-mode-hook
4104 Entry to this mode calls the value with no arguments, if that
4107 gnus-article-prepare-hook
4108 Called with no arguments after an article is prepared for reading,
4109 if that value is non-nil."
4111 (kill-all-local-variables)
4112 ;; Gee. Why don't you upgrade?
4113 (cond ((boundp 'mode-line-modified)
4114 (setq mode-line-modified "--- "))
4115 ((listp (default-value 'mode-line-format))
4116 (setq mode-line-format
4117 (cons "--- " (cdr (default-value 'mode-line-format))))))
4118 ;; To disable display-time facility.
4119 ;;(make-local-variable 'global-mode-string)
4120 ;;(setq global-mode-string nil)
4121 (setq major-mode 'gnus-article-mode)
4122 (setq mode-name "Article")
4123 (make-local-variable 'minor-mode-alist)
4124 (or (assq 'gnus-show-mime minor-mode-alist)
4125 (setq minor-mode-alist
4126 (cons (list 'gnus-show-mime " MIME") minor-mode-alist)))
4127 (gnus-article-set-mode-line)
4128 (use-local-map gnus-article-mode-map)
4129 (make-local-variable 'page-delimiter)
4130 (setq page-delimiter gnus-page-delimiter)
4131 (make-local-variable 'mail-header-separator)
4132 (setq mail-header-separator "") ;For caesar function.
4133 (buffer-flush-undo (current-buffer))
4134 (setq buffer-read-only t) ;Disable modification
4135 (run-hooks 'gnus-article-mode-hook))
4137 (defun gnus-article-setup-buffer ()
4138 "Initialize Article mode buffer."
4139 (or (get-buffer gnus-article-buffer)
4141 (set-buffer (get-buffer-create gnus-article-buffer))
4142 (gnus-article-mode))
4145 (defun gnus-article-prepare (article &optional all-headers)
4146 "Prepare ARTICLE in Article mode buffer.
4147 ARTICLE can be either a article number or Message-ID.
4148 If optional argument ALL-HEADERS is non-nil, all headers are inserted."
4149 ;; Make sure a connection to NNTP server is alive.
4150 (if (not (gnus-server-opened))
4152 (gnus-start-news-server)
4153 (gnus-request-group gnus-newsgroup-name)))
4155 (set-buffer gnus-article-buffer)
4156 (let ((buffer-read-only nil))
4158 ;; mhspool does not work with Message-ID. So, let's translate
4159 ;; it into an article number as possible as can. This may help
4161 ;; Note: this conversion must be done here since if the article
4162 ;; is specified by number or message-id has a different meaning
4163 ;; in the following.
4165 (and (stringp article)
4166 (gnus-get-header-by-id article)))
4169 (nntp-header-number header) article)))
4170 (gnus-request-article article))
4172 ;; Prepare article buffer
4173 (insert-buffer-substring nntp-server-buffer)
4174 ;; gnus-have-all-headers must be either T or NIL.
4175 (setq gnus-have-all-headers
4176 (not (not (or all-headers gnus-show-all-headers))))
4177 (if (and (numberp article)
4178 (not (eq article gnus-current-article)))
4179 ;; Seems me that a new article has been selected.
4181 ;; gnus-current-article must be an article number.
4182 (setq gnus-last-article gnus-current-article)
4183 (setq gnus-current-article article)
4184 ;; (setq gnus-current-headers
4185 ;; (gnus-find-header-by-number gnus-newsgroup-headers
4186 ;; gnus-current-article))
4187 (setq gnus-current-headers
4188 (gnus-get-header-by-number gnus-current-article))
4189 (run-hooks 'gnus-mark-article-hook)
4191 ;; Clear article history only when the article is
4192 ;; retrieved by the article number.
4193 (if (numberp article)
4194 (setq gnus-current-history nil))
4195 ;; Hooks for modifying contents of the article. This hook
4196 ;; must be called before being narrowed.
4197 (run-hooks 'gnus-article-prepare-hook)
4198 ;; Decode MIME message.
4199 (if (and gnus-show-mime
4200 (gnus-fetch-field "Mime-Version"))
4201 (funcall gnus-show-mime-method))
4202 ;; Delete unnecessary headers.
4203 (or gnus-have-all-headers
4204 (gnus-article-delete-headers))
4206 (goto-char (point-min))
4207 (if gnus-break-pages
4208 (gnus-narrow-to-page))
4209 ;; Next function must be called after setting
4210 ;; `gnus-current-article' variable and narrowed to page.
4211 (gnus-article-set-mode-line)
4213 ;; There is no such article.
4214 (if (numberp article)
4215 (gnus-summary-mark-as-read article))
4216 (ding) (message "No such article (may be canceled)"))
4219 (defun gnus-article-show-all-headers ()
4220 "Show all article headers in Article mode buffer."
4221 (or gnus-have-all-headers
4222 (gnus-article-prepare gnus-current-article t)))
4224 ;;(defun gnus-article-set-mode-line ()
4225 ;; "Set Article mode line string."
4226 ;; (setq mode-line-buffer-identification
4228 ;; (format "GNUS: %s {%d-%d} %d"
4229 ;; gnus-newsgroup-name
4230 ;; gnus-newsgroup-begin
4231 ;; gnus-newsgroup-end
4232 ;; gnus-current-article
4234 ;; (set-buffer-modified-p t))
4236 ;;(defun gnus-article-set-mode-line ()
4237 ;; "Set Article mode line string."
4239 ;; (- (length gnus-newsgroup-unreads)
4240 ;; (length (gnus-intersection
4241 ;; gnus-newsgroup-unreads gnus-newsgroup-marked))))
4243 ;; (- (length gnus-newsgroup-unselected)
4244 ;; (length (gnus-intersection
4245 ;; gnus-newsgroup-unselected gnus-newsgroup-marked)))))
4246 ;; (setq mode-line-buffer-identification
4248 ;; (format "GNUS: %s{%d} %s"
4249 ;; gnus-newsgroup-name
4250 ;; gnus-current-article
4251 ;; ;; This is proposed by tale@pawl.rpi.edu.
4252 ;; (cond ((and (zerop unmarked)
4253 ;; (zerop unselected))
4255 ;; ((zerop unselected)
4256 ;; (format "%d more" unmarked))
4258 ;; (format "%d(+%d) more" unmarked unselected)))
4260 ;; (set-buffer-modified-p t))
4262 ;; New implementation in gnus 3.14.3
4264 (defun gnus-article-set-mode-line ()
4265 "Set Article mode line string.
4266 If you don't like it, define your own gnus-article-set-mode-line."
4267 (let ((maxlen 15) ;Maximum subject length
4269 (if gnus-current-headers
4270 (nntp-header-subject gnus-current-headers) "")))
4271 ;; The value must be a string to escape %-constructs because of subject.
4272 (setq mode-line-buffer-identification
4273 (format "GNUS: %s%s %s%s%s"
4275 (if gnus-current-article
4276 (format "/%d" gnus-current-article) "")
4277 (substring subject 0 (min (length subject) maxlen))
4278 (if (> (length subject) maxlen) "..." "")
4279 (make-string (max 0 (- 17 (length subject))) ? )
4281 (set-buffer-modified-p t))
4283 (defun gnus-article-delete-headers ()
4284 "Delete unnecessary headers."
4287 (goto-char (point-min))
4288 (narrow-to-region (point-min)
4289 (progn (search-forward "\n\n" nil 'move) (point)))
4290 (goto-char (point-min))
4291 (and (stringp gnus-ignored-headers)
4292 (while (re-search-forward gnus-ignored-headers nil t)
4294 (delete-region (point)
4295 (progn (re-search-forward "\n[^ \t]")
4300 ;; Working on article's buffer
4302 (defun gnus-article-next-page (lines)
4303 "Show next page of current article.
4304 If end of article, return non-nil. Otherwise return nil.
4305 Argument LINES specifies lines to be scrolled up."
4307 (move-to-window-line -1)
4308 ;; Fixed by enami@ptgd.sony.co.jp (enami tsugutomo)
4311 (and (pos-visible-in-window-p) ;Not continuation line.
4313 ;; Nothing in this page.
4314 (if (or (not gnus-break-pages)
4317 (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer?
4319 (gnus-narrow-to-page 1) ;Go to next page.
4322 ;; More in this page.
4326 ;; Long lines may cause an end-of-buffer error.
4327 (goto-char (point-max))))
4331 (defun gnus-article-prev-page (lines)
4332 "Show previous page of current article.
4333 Argument LINES specifies lines to be scrolled down."
4335 (move-to-window-line 0)
4336 (if (and gnus-break-pages
4338 (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer?
4340 (gnus-narrow-to-page -1) ;Go to previous page.
4341 (goto-char (point-max))
4343 (scroll-down lines)))
4345 (defun gnus-article-next-digest (nth)
4346 "Move to head of NTH next digested message.
4347 Set mark at end of digested message."
4348 ;; Stop page breaking in digest mode.
4351 ;; Skip NTH - 1 digest.
4352 ;; Suggested by Khalid Sattar <admin@cs.exeter.ac.uk>.
4353 ;; Digest separator is customizable.
4354 ;; Suggested by Skip Montanaro <montanaro@sprite.crd.ge.com>.
4355 (while (and (> nth 1)
4356 (re-search-forward gnus-digest-separator nil 'move))
4357 (setq nth (1- nth)))
4358 (if (re-search-forward gnus-digest-separator nil t)
4359 (let ((begin (point)))
4360 ;; Search for end of this message.
4362 (if (re-search-forward gnus-digest-separator nil t)
4364 (search-backward "\n\n") ;This may be incorrect.
4366 (goto-char (point-max)))
4367 (push-mark) ;Set mark at end of digested message.
4370 ;; Show From: and Subject: fields.
4372 (message "End of message")
4375 (defun gnus-article-prev-digest (nth)
4376 "Move to head of NTH previous digested message."
4377 ;; Stop page breaking in digest mode.
4380 ;; Skip NTH - 1 digest.
4381 ;; Suggested by Khalid Sattar <admin@cs.exeter.ac.uk>.
4382 ;; Digest separator is customizable.
4383 ;; Suggested by Skip Montanaro <montanaro@sprite.crd.ge.com>.
4384 (while (and (> nth 1)
4385 (re-search-backward gnus-digest-separator nil 'move))
4386 (setq nth (1- nth)))
4387 (if (re-search-backward gnus-digest-separator nil t)
4388 (let ((begin (point)))
4389 ;; Search for end of this message.
4391 (if (re-search-forward gnus-digest-separator nil t)
4393 (search-backward "\n\n") ;This may be incorrect.
4395 (goto-char (point-max)))
4396 (push-mark) ;Set mark at end of digested message.
4398 ;; Show From: and Subject: fields.
4400 (goto-char (point-min))
4401 (message "Top of message")
4404 (defun gnus-article-refer-article ()
4405 "Read article specified by message-id around point."
4407 (save-window-excursion
4409 (re-search-forward ">" nil t) ;Move point to end of "<....>".
4410 (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t)
4412 (buffer-substring (match-beginning 1) (match-end 1))))
4413 (set-buffer gnus-summary-buffer)
4414 (gnus-summary-refer-article message-id))
4415 (error "No references around point"))
4418 (defun gnus-article-pop-article ()
4419 "Pop up article history."
4421 (save-window-excursion
4422 (set-buffer gnus-summary-buffer)
4423 (gnus-summary-refer-article nil)))
4425 (defun gnus-article-show-summary ()
4426 "Reconfigure windows to show Summary buffer."
4428 (gnus-configure-windows 'article)
4429 (pop-to-buffer gnus-summary-buffer)
4430 (gnus-summary-goto-subject gnus-current-article))
4432 (defun gnus-article-describe-briefly ()
4433 "Describe Article mode commands briefly."
4437 (substitute-command-keys "\\[gnus-article-next-page]:Next page ")
4438 (substitute-command-keys "\\[gnus-article-prev-page]:Prev page ")
4439 (substitute-command-keys "\\[gnus-article-show-summary]:Show Summary ")
4440 (substitute-command-keys "\\[gnus-info-find-node]:Run Info ")
4441 (substitute-command-keys "\\[gnus-article-describe-briefly]:This help")
4446 ;;; GNUS KILL-File Mode
4449 (if gnus-kill-file-mode-map
4451 (setq gnus-kill-file-mode-map (copy-keymap emacs-lisp-mode-map))
4452 (define-key gnus-kill-file-mode-map "\C-c\C-k\C-s" 'gnus-kill-file-kill-by-subject)
4453 (define-key gnus-kill-file-mode-map "\C-c\C-k\C-a" 'gnus-kill-file-kill-by-author)
4454 (define-key gnus-kill-file-mode-map "\C-c\C-a" 'gnus-kill-file-apply-buffer)
4455 (define-key gnus-kill-file-mode-map "\C-c\C-e" 'gnus-kill-file-apply-last-sexp)
4456 (define-key gnus-kill-file-mode-map "\C-c\C-c" 'gnus-kill-file-exit)
4457 (define-key gnus-kill-file-mode-map "\C-c\C-i" 'gnus-info-find-node))
4459 (defun gnus-kill-file-mode ()
4460 "Major mode for editing KILL file.
4462 In addition to Emacs-Lisp Mode, the following commands are available:
4464 \\[gnus-kill-file-kill-by-subject] Insert KILL command for current subject.
4465 \\[gnus-kill-file-kill-by-author] Insert KILL command for current author.
4466 \\[gnus-kill-file-apply-buffer] Apply current buffer to selected newsgroup.
4467 \\[gnus-kill-file-apply-last-sexp] Apply sexp before point to selected newsgroup.
4468 \\[gnus-kill-file-exit] Save file and exit editing KILL file.
4469 \\[gnus-info-find-node] Read Info about KILL file.
4471 A KILL file contains lisp expressions to be applied to a selected
4472 newsgroup. The purpose is to mark articles as read on the basis of
4473 some set of regexps. A global KILL file is applied to every newsgroup,
4474 and a local KILL file is applied to a specified newsgroup. Since a
4475 global KILL file is applied to every newsgroup, for better performance
4478 A KILL file can contain any kind of Emacs lisp expressions expected
4479 to be evaluated in the Summary buffer. Writing lisp programs for this
4480 purpose is not so easy because the internal working of GNUS must be
4481 well-known. For this reason, GNUS provides a general function which
4482 does this easily for non-Lisp programmers.
4484 The `gnus-kill' function executes commands available in Summary Mode
4485 by their key sequences. `gnus-kill' should be called with FIELD,
4486 REGEXP and optional COMMAND and ALL. FIELD is a string representing
4487 the header field or an empty string. If FIELD is an empty string, the
4488 entire article body is searched for. REGEXP is a string which is
4489 compared with FIELD value. COMMAND is a string representing a valid
4490 key sequence in Summary Mode or Lisp expression. COMMAND is default to
4491 '(gnus-summary-mark-as-read nil \"X\"). Make sure that COMMAND is
4492 executed in the Summary buffer. If the second optional argument ALL
4493 is non-nil, the COMMAND is applied to articles which are already
4494 marked as read or unread. Articles which are marked are skipped over
4497 For example, if you want to mark articles of which subjects contain
4498 the string `AI' as read, a possible KILL file may look like:
4500 (gnus-kill \"Subject\" \"AI\")
4502 If you want to mark articles with `D' instead of `X', you can use
4503 the following expression:
4505 (gnus-kill \"Subject\" \"AI\" \"d\")
4507 In this example it is assumed that the command
4508 `gnus-summary-mark-as-read-forward' is assigned to `d' in Summary Mode.
4510 It is possible to delete unnecessary headers which are marked with
4511 `X' in a KILL file as follows:
4513 (gnus-expunge \"X\")
4515 If the Summary buffer is empty after applying KILL files, GNUS will
4516 exit the selected newsgroup normally. If headers which are marked
4517 with `D' are deleted in a KILL file, it is impossible to read articles
4518 which are marked as read in the previous GNUS sessions. Marks other
4519 than `D' should be used for articles which should really be deleted.
4521 Entry to this mode calls emacs-lisp-mode-hook and
4522 gnus-kill-file-mode-hook with no arguments, if that value is non-nil."
4524 (kill-all-local-variables)
4525 (use-local-map gnus-kill-file-mode-map)
4526 (set-syntax-table emacs-lisp-mode-syntax-table)
4527 (setq major-mode 'gnus-kill-file-mode)
4528 (setq mode-name "KILL-File")
4529 (lisp-mode-variables nil)
4530 (run-hooks 'emacs-lisp-mode-hook 'gnus-kill-file-mode-hook))
4532 (defun gnus-kill-file-edit-file (newsgroup)
4533 "Begin editing a KILL file of NEWSGROUP.
4534 If NEWSGROUP is nil, the global KILL file is selected."
4535 (interactive "sNewsgroup: ")
4536 (let ((file (gnus-newsgroup-kill-file newsgroup)))
4537 (gnus-make-directory (file-name-directory file))
4538 ;; Save current window configuration if this is first invocation.
4539 (or (and (get-file-buffer file)
4540 (get-buffer-window (get-file-buffer file)))
4541 (setq gnus-winconf-kill-file (current-window-configuration)))
4543 (let ((buffer (find-file-noselect file)))
4544 (cond ((get-buffer-window buffer)
4545 (pop-to-buffer buffer))
4546 ((eq major-mode 'gnus-group-mode)
4547 (gnus-configure-windows '(1 0 0)) ;Take all windows.
4548 (pop-to-buffer gnus-group-buffer)
4549 (let ((gnus-summary-buffer buffer))
4550 (gnus-configure-windows '(1 1 0)) ;Split into two.
4551 (pop-to-buffer buffer)))
4552 ((eq major-mode 'gnus-summary-mode)
4553 (gnus-configure-windows 'article)
4554 (pop-to-buffer gnus-article-buffer)
4555 (bury-buffer gnus-article-buffer)
4556 (switch-to-buffer buffer))
4558 (find-file-other-window file))
4560 (gnus-kill-file-mode)
4563 (defun gnus-kill-file-kill-by-subject ()
4564 "Insert KILL command for current subject."
4567 (format "(gnus-kill \"Subject\" %s)\n"
4569 (if gnus-current-kill-article
4571 (nntp-header-subject
4572 ;; No need to speed up this command.
4573 ;;(gnus-get-header-by-number gnus-current-kill-article)
4574 (gnus-find-header-by-number gnus-newsgroup-headers
4575 gnus-current-kill-article)))
4578 (defun gnus-kill-file-kill-by-author ()
4579 "Insert KILL command for current author."
4582 (format "(gnus-kill \"From\" %s)\n"
4584 (if gnus-current-kill-article
4587 ;; No need to speed up this command.
4588 ;;(gnus-get-header-by-number gnus-current-kill-article)
4589 (gnus-find-header-by-number gnus-newsgroup-headers
4590 gnus-current-kill-article)))
4593 (defun gnus-kill-file-apply-buffer ()
4594 "Apply current buffer to current newsgroup."
4596 (if (and gnus-current-kill-article
4597 (get-buffer gnus-summary-buffer))
4598 ;; Assume newsgroup is selected.
4599 (let ((string (concat "(progn \n" (buffer-string) "\n)" )))
4601 (save-window-excursion
4602 (pop-to-buffer gnus-summary-buffer)
4603 (eval (car (read-from-string string))))))
4604 (ding) (message "No newsgroup is selected.")))
4606 (defun gnus-kill-file-apply-last-sexp ()
4607 "Apply sexp before point in current buffer to current newsgroup."
4609 (if (and gnus-current-kill-article
4610 (get-buffer gnus-summary-buffer))
4611 ;; Assume newsgroup is selected.
4614 (save-excursion (forward-sexp -1) (point)) (point))))
4616 (save-window-excursion
4617 (pop-to-buffer gnus-summary-buffer)
4618 (eval (car (read-from-string string))))))
4619 (ding) (message "No newsgroup is selected.")))
4621 (defun gnus-kill-file-exit ()
4622 "Save a KILL file, then return to the previous buffer."
4625 (let ((killbuf (current-buffer)))
4626 ;; We don't want to return to Article buffer.
4627 (and (get-buffer gnus-article-buffer)
4628 (bury-buffer (get-buffer gnus-article-buffer)))
4629 ;; Delete the KILL file windows.
4630 (delete-windows-on killbuf)
4631 ;; Restore last window configuration if available.
4632 (and gnus-winconf-kill-file
4633 (set-window-configuration gnus-winconf-kill-file))
4634 (setq gnus-winconf-kill-file nil)
4635 ;; Kill the KILL file buffer. Suggested by tale@pawl.rpi.edu.
4636 (kill-buffer killbuf)))
4640 ;;; Utility functions
4643 ;; Basic ideas by emv@math.lsa.umich.edu (Edward Vielmetti)
4645 (defun gnus-batch-kill ()
4647 Usage: emacs -batch -l gnus -f gnus-batch-kill NEWSGROUP ..."
4648 (if (not noninteractive)
4649 (error "gnus-batch-kill is to be used only with -batch"))
4654 (gnus-parse-n-options
4655 (apply (function concat)
4656 (mapcar (function (lambda (g) (concat g " ")))
4657 command-line-args-left))))
4658 (yes (car yes-and-no))
4659 (no (cdr yes-and-no))
4660 ;; Disable verbose message.
4661 (gnus-novice-user nil)
4662 (gnus-large-newsgroup nil)
4663 (nntp-large-newsgroup nil))
4664 ;; Eat all arguments.
4665 (setq command-line-args-left nil)
4668 ;; Apply kills to specified newsgroups in command line arguments.
4669 (setq newsrc (copy-sequence gnus-newsrc-assoc))
4671 (setq group (car (car newsrc)))
4672 (setq subscribed (nth 1 (car newsrc)))
4673 (setq newsrc (cdr newsrc))
4675 (not (zerop (nth 1 (gnus-gethash group gnus-unread-hashtb))))
4677 (string-match yes group) t)
4679 (not (string-match no group))))
4681 (gnus-summary-read-group group nil t)
4682 (if (eq (current-buffer) (get-buffer gnus-summary-buffer))
4683 (gnus-summary-exit t))
4686 ;; Finally, exit Emacs.
4687 (set-buffer gnus-group-buffer)
4691 ;; For saving articles
4693 (defun gnus-Numeric-save-name (newsgroup headers &optional last-file)
4694 "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
4695 If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group/num.
4696 Otherwise, it is like ~/News/news/group/num."
4699 (concat (if gnus-use-long-file-name
4700 (gnus-capitalize-newsgroup newsgroup)
4701 (gnus-newsgroup-directory-form newsgroup))
4702 "/" (int-to-string (nntp-header-number headers)))
4703 (or gnus-article-save-directory "~/News"))))
4705 (string-equal (file-name-directory default)
4706 (file-name-directory last-file))
4707 (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
4709 (or last-file default))))
4711 (defun gnus-numeric-save-name (newsgroup headers &optional last-file)
4712 "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
4713 If variable `gnus-use-long-file-name' is nil, it is ~/News/news.group/num.
4714 Otherwise, it is like ~/News/news/group/num."
4717 (concat (if gnus-use-long-file-name
4719 (gnus-newsgroup-directory-form newsgroup))
4720 "/" (int-to-string (nntp-header-number headers)))
4721 (or gnus-article-save-directory "~/News"))))
4723 (string-equal (file-name-directory default)
4724 (file-name-directory last-file))
4725 (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
4727 (or last-file default))))
4729 (defun gnus-Plain-save-name (newsgroup headers &optional last-file)
4730 "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
4731 If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group.
4732 Otherwise, it is like ~/News/news/group/news."
4735 (if gnus-use-long-file-name
4736 (gnus-capitalize-newsgroup newsgroup)
4737 (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
4738 (or gnus-article-save-directory "~/News"))))
4740 (defun gnus-plain-save-name (newsgroup headers &optional last-file)
4741 "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
4742 If variable `gnus-use-long-file-name' is nil, it is ~/News/news.group.
4743 Otherwise, it is like ~/News/news/group/news."
4746 (if gnus-use-long-file-name
4748 (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
4749 (or gnus-article-save-directory "~/News"))))
4751 (defun gnus-Folder-save-name (newsgroup headers &optional last-folder)
4752 "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER.
4753 If variable `gnus-use-long-file-name' is nil, it is +News.group.
4754 Otherwise, it is like +news/group."
4757 (if gnus-use-long-file-name
4758 (gnus-capitalize-newsgroup newsgroup)
4759 (gnus-newsgroup-directory-form newsgroup)))))
4761 (defun gnus-folder-save-name (newsgroup headers &optional last-folder)
4762 "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER.
4763 If variable `gnus-use-long-file-name' is nil, it is +news.group.
4764 Otherwise, it is like +news/group."
4767 (if gnus-use-long-file-name
4769 (gnus-newsgroup-directory-form newsgroup)))))
4773 (defun gnus-apply-kill-file ()
4774 "Apply KILL file to the current newsgroup."
4775 ;; Apply the global KILL file.
4776 (load (gnus-newsgroup-kill-file nil) t nil t)
4777 ;; And then apply the local KILL file.
4778 (load (gnus-newsgroup-kill-file gnus-newsgroup-name) t nil t))
4780 (defun gnus-Newsgroup-kill-file (newsgroup)
4781 "Return the name of a KILL file of NEWSGROUP.
4782 If NEWSGROUP is nil, return the global KILL file instead."
4783 (cond ((or (null newsgroup)
4784 (string-equal newsgroup ""))
4785 ;; The global KILL file is placed at top of the directory.
4786 (expand-file-name gnus-kill-file-name
4787 (or gnus-article-save-directory "~/News")))
4788 (gnus-use-long-file-name
4789 ;; Append ".KILL" to capitalized newsgroup name.
4790 (expand-file-name (concat (gnus-capitalize-newsgroup newsgroup)
4791 "." gnus-kill-file-name)
4792 (or gnus-article-save-directory "~/News")))
4794 ;; Place "KILL" under the hierarchical directory.
4795 (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
4796 "/" gnus-kill-file-name)
4797 (or gnus-article-save-directory "~/News")))
4800 (defun gnus-newsgroup-kill-file (newsgroup)
4801 "Return the name of a KILL file of NEWSGROUP.
4802 If NEWSGROUP is nil, return the global KILL file instead."
4803 (cond ((or (null newsgroup)
4804 (string-equal newsgroup ""))
4805 ;; The global KILL file is placed at top of the directory.
4806 (expand-file-name gnus-kill-file-name
4807 (or gnus-article-save-directory "~/News")))
4808 (gnus-use-long-file-name
4809 ;; Append ".KILL" to newsgroup name.
4810 (expand-file-name (concat newsgroup "." gnus-kill-file-name)
4811 (or gnus-article-save-directory "~/News")))
4813 ;; Place "KILL" under the hierarchical directory.
4814 (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
4815 "/" gnus-kill-file-name)
4816 (or gnus-article-save-directory "~/News")))
4819 ;; For subscribing new newsgroup
4821 (defun gnus-subscribe-randomly (newsgroup)
4822 "Subscribe new NEWSGROUP and insert it at the beginning of newsgroups."
4823 (gnus-subscribe-newsgroup newsgroup
4824 (car (car gnus-newsrc-assoc))))
4826 (defun gnus-subscribe-alphabetically (newgroup)
4827 "Subscribe new NEWSGROUP and insert it in strict alphabetic order."
4828 ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
4829 (let ((groups gnus-newsrc-assoc)
4831 (while (and (not before) groups)
4832 (if (string< newgroup (car (car groups)))
4833 (setq before (car (car groups)))
4834 (setq groups (cdr groups))))
4835 (gnus-subscribe-newsgroup newgroup before)
4838 (defun gnus-subscribe-hierarchically (newgroup)
4839 "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order."
4840 ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
4842 (set-buffer (find-file-noselect gnus-current-startup-file))
4843 (let ((groupkey newgroup)
4845 (while (and (not before) groupkey)
4846 (goto-char (point-min))
4848 (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
4849 (while (and (re-search-forward groupkey-re nil t)
4851 (setq before (buffer-substring
4852 (match-beginning 1) (match-end 1)))
4853 (string< before newgroup)))
4855 ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
4857 (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
4858 (substring groupkey (match-beginning 1) (match-end 1)))))
4859 (gnus-subscribe-newsgroup newgroup before)
4862 (defun gnus-subscribe-interactively (newsgroup)
4863 "Subscribe new NEWSGROUP interactively.
4864 It is inserted in hierarchical newsgroup order if subscribed.
4865 Unless, it is killed."
4866 (if (y-or-n-p (format "Subscribe new newsgroup: %s " newsgroup))
4867 (gnus-subscribe-hierarchically newsgroup)
4868 ;; Save in kill-ring
4869 (gnus-subscribe-newsgroup newsgroup)
4870 (gnus-kill-newsgroup newsgroup)))
4872 (defun gnus-subscribe-newsgroup (newsgroup &optional next)
4873 "Subscribe new NEWSGROUP.
4874 If optional argument NEXT is non-nil, it is inserted before NEXT."
4875 (gnus-insert-newsgroup (list newsgroup t) next)
4876 (message "Subscribe newsgroup: %s" newsgroup))
4880 (defun gnus-newsgroup-directory-form (newsgroup)
4881 "Make hierarchical directory name from NEWSGROUP name."
4882 (let ((newsgroup (substring newsgroup 0)) ;Copy string.
4883 (len (length newsgroup))
4885 ;; Replace all occurrences of `.' with `/'.
4887 (if (= (aref newsgroup idx) ?.)
4888 (aset newsgroup idx ?/))
4889 (setq idx (1+ idx)))
4893 (defun gnus-make-directory (directory)
4894 "Make DIRECTORY recursively."
4895 (let ((directory (expand-file-name directory default-directory)))
4896 (or (file-exists-p directory)
4897 (gnus-make-directory-1 "" directory))
4900 (defun gnus-make-directory-1 (head tail)
4901 (cond ((string-match "^/\\([^/]+\\)" tail)
4902 ;; ange-ftp interferes with calling match-* after
4903 ;; calling file-name-as-directory.
4904 (let ((beg (match-beginning 1))
4905 (end (match-end 1)))
4906 (setq head (concat (file-name-as-directory head)
4907 (substring tail beg end)))
4908 (or (file-exists-p head)
4909 (call-process "mkdir" nil nil nil head))
4910 (gnus-make-directory-1 head (substring tail end))))
4911 ((string-equal tail "") t)
4914 (defun gnus-capitalize-newsgroup (newsgroup)
4915 "Capitalize NEWSGROUP name with treating '.' and '-' as part of words."
4916 ;; Suggested by "Jonathan I. Kamens" <jik@pit-manager.MIT.EDU>.
4917 (let ((current-syntax-table (syntax-table)))
4920 (set-syntax-table (copy-syntax-table current-syntax-table))
4921 (modify-syntax-entry ?- "w")
4922 (modify-syntax-entry ?. "w")
4923 (capitalize newsgroup))
4924 (set-syntax-table current-syntax-table))))
4926 (defun gnus-simplify-subject (subject &optional re-only)
4927 "Remove `Re:' and words in parentheses.
4928 If optional argument RE-ONLY is non-nil, strip `Re:' only."
4929 (let ((case-fold-search t)) ;Ignore case.
4930 ;; Remove `Re:' and `Re^N:'.
4931 (if (string-match "\\`\\(re\\(\\^[0-9]+\\)?:[ \t]+\\)+" subject)
4932 (setq subject (substring subject (match-end 0))))
4933 ;; Remove words in parentheses from end.
4935 (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject)
4936 (setq subject (substring subject 0 (match-beginning 0)))))
4937 ;; Return subject string.
4941 (defun gnus-optional-lines-and-from (header)
4942 "Return a string like `NNN:AUTHOR' from HEADER."
4943 (let ((name-length (length "umerin@photon")))
4944 (substring (format "%3d:%s"
4945 ;; Lines of the article.
4946 ;; Suggested by dana@bellcore.com.
4947 (nntp-header-lines header)
4949 (concat (mail-strip-quoted-names
4950 (nntp-header-from header))
4951 (make-string name-length ? )))
4952 ;; 4 stands for length of `NNN:'.
4953 0 (+ 4 name-length))))
4955 (defun gnus-optional-lines (header)
4956 "Return a string like `NNN' from HEADER."
4957 (format "%4d" (nntp-header-lines header)))
4959 ;; Basic ideas by flee@cs.psu.edu (Felix Lee)
4961 (defun gnus-keysort-headers (predicate key &optional reverse)
4962 "Sort current headers by PREDICATE using a value passed by KEY safely.
4963 *Safely* means C-g quitting is disabled during sort.
4964 Optional argument REVERSE means reverse order."
4965 (let ((inhibit-quit t))
4966 (setq gnus-newsgroup-headers
4969 (gnus-keysort (nreverse gnus-newsgroup-headers) predicate key))
4970 (gnus-keysort gnus-newsgroup-headers predicate key)))
4971 ;; Make sure we don't have to call
4972 ;; gnus-clear-hashtables-for-newsgroup-headers to clear hash
4973 ;; tables for the variable gnus-newsgroup-headers since no new
4974 ;; entry is added to nor deleted from the variable.
4977 (defun gnus-keysort (list predicate key)
4978 "Sort LIST by PREDICATE using a value passed by KEY."
4979 (mapcar (function cdr)
4980 (sort (mapcar (function (lambda (a) (cons (funcall key a) a))) list)
4981 (function (lambda (a b)
4982 (funcall predicate (car a) (car b)))))))
4984 (defun gnus-sort-headers (predicate &optional reverse)
4985 "Sort current headers by PREDICATE safely.
4986 *Safely* means C-g quitting is disabled during sort.
4987 Optional argument REVERSE means reverse order."
4988 (let ((inhibit-quit t))
4989 (setq gnus-newsgroup-headers
4991 (nreverse (sort (nreverse gnus-newsgroup-headers) predicate))
4992 (sort gnus-newsgroup-headers predicate)))
4993 ;; Make sure we don't have to call
4994 ;; gnus-clear-hashtables-for-newsgroup-headers to clear hash
4995 ;; tables for the variable gnus-newsgroup-headers since no new
4996 ;; entry is added to nor deleted from the variable.
4999 (defun gnus-string-lessp (a b)
5000 "Return T if first arg string is less than second in lexicographic order.
5001 If case-fold-search is non-nil, case of letters is ignored."
5002 (if case-fold-search
5003 (string-lessp (downcase a) (downcase b))
5004 (string-lessp a b)))
5006 (defun gnus-date-lessp (date1 date2)
5007 "Return T if DATE1 is earlyer than DATE2."
5008 (string-lessp (gnus-sortable-date date1)
5009 (gnus-sortable-date date2)))
5011 (defun gnus-sortable-date (date)
5012 "Make sortable string by string-lessp from DATE.
5013 Timezone package is used."
5014 (let* ((date (timezone-parse-date date)) ;[Y M D T]
5015 (year (string-to-int (aref date 0)))
5016 (month (string-to-int (aref date 1)))
5017 (day (string-to-int (aref date 2)))
5018 (time (aref date 3))) ;HH:MM:SS
5019 ;; Timezone package is used. But, we don't have to care about
5020 ;; the timezone since article's timezones are always GMT.
5021 (timezone-make-sortable-date year month day time)
5024 ;;(defun gnus-sortable-date (date)
5025 ;; "Make sortable string by string-lessp from DATE."
5026 ;; (let ((month '(("JAN" . " 1")("FEB" . " 2")("MAR" . " 3")
5027 ;; ("APR" . " 4")("MAY" . " 5")("JUN" . " 6")
5028 ;; ("JUL" . " 7")("AUG" . " 8")("SEP" . " 9")
5029 ;; ("OCT" . "10")("NOV" . "11")("DEC" . "12")))
5030 ;; (date (or date "")))
5031 ;; ;; Can understand the following styles:
5032 ;; ;; (1) 14 Apr 89 03:20:12 GMT
5033 ;; ;; (2) Fri, 17 Mar 89 4:01:33 GMT
5034 ;; (if (string-match
5035 ;; "\\([0-9]+\\) \\([^ ,]+\\) \\([0-9]+\\) \\([0-9:]+\\)" date)
5038 ;; (substring date (match-beginning 3) (match-end 3))
5042 ;; (upcase (substring date (match-beginning 2) (match-end 2))) month))
5044 ;; (format "%2d" (string-to-int
5046 ;; (match-beginning 1) (match-end 1))))
5048 ;; (substring date (match-beginning 4) (match-end 4)))
5049 ;; ;; Cannot understand DATE string.
5054 (defun gnus-fetch-field (field)
5055 "Return the value of the header FIELD of current article."
5059 (goto-char (point-min))
5060 (narrow-to-region (point-min)
5061 (progn (search-forward "\n\n" nil 'move) (point)))
5062 (mail-fetch-field field))))
5064 (fset 'gnus-expunge 'gnus-summary-delete-marked-with)
5066 (defun gnus-kill (field regexp &optional command all)
5067 "If FIELD of an article matches REGEXP, execute COMMAND.
5068 Optional 1st argument COMMAND is default to
5069 (gnus-summary-mark-as-read nil \"X\").
5070 If optional 2nd argument ALL is non-nil, articles marked are also applied to.
5071 If FIELD is an empty string (or nil), entire article body is searched for.
5072 COMMAND must be a lisp expression or a string representing a key sequence."
5073 ;; We don't want to change current point nor window configuration.
5075 (save-window-excursion
5076 ;; Selected window must be Summary buffer to execute keyboard
5077 ;; macros correctly. See command_loop_1.
5078 (switch-to-buffer gnus-summary-buffer 'norecord)
5079 (goto-char (point-min)) ;From the beginning.
5081 (setq command '(gnus-summary-mark-as-read nil "X")))
5082 (gnus-execute field regexp command nil (not all))
5085 (defun gnus-execute (field regexp form &optional backward ignore-marked)
5086 "If FIELD of article header matches REGEXP, execute lisp FORM (or a string).
5087 If FIELD is an empty string (or nil), entire article body is searched for.
5088 If optional 1st argument BACKWARD is non-nil, do backward instead.
5089 If optional 2nd argument IGNORE-MARKED is non-nil, articles which are
5090 marked as read or unread are ignored."
5091 (let ((function nil)
5094 (if (string-equal field "")
5099 (setq field (symbol-name field)))
5100 ;; Get access function of header filed.
5101 (setq function (intern-soft (concat "gnus-header-" (downcase field))))
5102 (if (and function (fboundp function))
5103 (setq function (symbol-function function))
5104 (error "Unknown header field: \"%s\"" field)))
5105 ;; Make FORM funcallable.
5106 (if (and (listp form) (not (eq (car form) 'lambda)))
5107 (setq form (list 'lambda nil form)))
5108 ;; Starting from the current article.
5109 (or (and ignore-marked
5110 ;; Articles marked as read and unread should be ignored.
5111 (setq article (gnus-summary-article-number))
5112 (or (not (memq article gnus-newsgroup-unreads)) ;Marked as read.
5113 (memq article gnus-newsgroup-marked) ;Marked as unread.
5115 (gnus-execute-1 function regexp form))
5116 (while (gnus-summary-search-subject backward ignore-marked nil)
5117 (gnus-execute-1 function regexp form))
5120 (defun gnus-execute-1 (function regexp form)
5122 ;; The point of Summary buffer must be saved during execution.
5123 (let ((article (gnus-summary-article-number)))
5127 ;; Compare with header field.
5128 (let (;;(header (gnus-find-header-by-number
5129 ;; gnus-newsgroup-headers article))
5130 (header (gnus-get-header-by-number article))
5134 (setq value (funcall function header))
5135 ;; Number (Lines:) or symbol must be converted to string.
5137 (setq value (prin1-to-string value)))
5138 (string-match regexp value))
5139 (if (stringp form) ;Keyboard macro.
5140 (execute-kbd-macro form)
5142 ;; Search article body.
5143 (let ((gnus-current-article nil) ;Save article pointer.
5144 (gnus-last-article nil)
5145 (gnus-break-pages nil) ;No need to break pages.
5146 (gnus-mark-article-hook nil)) ;Inhibit marking as read.
5147 (message "Searching for article: %d..." article)
5148 (gnus-article-setup-buffer)
5149 (gnus-article-prepare article t)
5151 (set-buffer gnus-article-buffer)
5152 (goto-char (point-min))
5153 (re-search-forward regexp nil t))
5154 (if (stringp form) ;Keyboard macro.
5155 (execute-kbd-macro form)
5160 ;;; caesar-region written by phr@prep.ai.mit.edu Nov 86
5161 ;;; modified by tower@prep Nov 86
5162 ;;; Modified by umerin@flab.flab.Fujitsu.JUNET for ROT47.
5164 (defun gnus-caesar-region (&optional n)
5165 "Caesar rotation of region by N, default 13, for decrypting netnews.
5166 ROT47 will be performed for Japanese text in any case."
5167 (interactive (if current-prefix-arg ; Was there a prefix arg?
5168 (list (prefix-numeric-value current-prefix-arg))
5170 (cond ((not (numberp n)) (setq n 13))
5171 (t (setq n (mod n 26)))) ;canonicalize N
5172 (if (not (zerop n)) ; no action needed for a rot of 0
5174 (if (or (not (boundp 'caesar-translate-table))
5175 (/= (aref caesar-translate-table ?a) (+ ?a n)))
5176 (let ((i 0) (lower "abcdefghijklmnopqrstuvwxyz") upper)
5177 (message "Building caesar-translate-table...")
5178 (setq caesar-translate-table (make-vector 256 0))
5180 (aset caesar-translate-table i i)
5182 (setq lower (concat lower lower) upper (upcase lower) i 0)
5184 (aset caesar-translate-table (+ ?a i) (aref lower (+ i n)))
5185 (aset caesar-translate-table (+ ?A i) (aref upper (+ i n)))
5187 ;; ROT47 for Japanese text.
5188 ;; Thanks to ichikawa@flab.fujitsu.junet.
5190 (let ((t1 (logior ?O 128))
5191 (t2 (logior ?! 128))
5192 (t3 (logior ?~ 128)))
5194 (aset caesar-translate-table i
5195 (let ((v (aref caesar-translate-table i)))
5196 (if (<= v t1) (if (< v t2) v (+ v 47))
5197 (if (<= v t3) (- v 47) v))))
5199 (message "Building caesar-translate-table... done")))
5200 (let ((from (region-beginning))
5203 (setq str (buffer-substring from to))
5204 (setq len (length str))
5206 (aset str i (aref caesar-translate-table (aref str i)))
5209 (delete-region from to)
5212 ;; Functions accessing headers.
5213 ;; Functions are more convenient than macros in some case.
5215 (defun gnus-header-number (header)
5216 "Return article number in HEADER."
5217 (nntp-header-number header))
5219 (defun gnus-header-subject (header)
5220 "Return subject string in HEADER."
5221 (nntp-header-subject header))
5223 (defun gnus-header-from (header)
5224 "Return author string in HEADER."
5225 (nntp-header-from header))
5227 (defun gnus-header-xref (header)
5228 "Return xref string in HEADER."
5229 (nntp-header-xref header))
5231 (defun gnus-header-lines (header)
5232 "Return lines in HEADER."
5233 (nntp-header-lines header))
5235 (defun gnus-header-date (header)
5236 "Return date in HEADER."
5237 (nntp-header-date header))
5239 (defun gnus-header-id (header)
5240 "Return Id in HEADER."
5241 (nntp-header-id header))
5243 (defun gnus-header-references (header)
5244 "Return references in HEADER."
5245 (nntp-header-references header))
5252 (defun gnus-output-to-rmail (file-name)
5253 "Append the current article to an Rmail file named FILE-NAME."
5255 ;; Most of these codes are borrowed from rmailout.el.
5256 (setq file-name (expand-file-name file-name))
5257 (setq rmail-last-rmail-file file-name)
5258 (let ((artbuf (current-buffer))
5259 (tmpbuf (get-buffer-create " *GNUS-output*")))
5261 (or (get-file-buffer file-name)
5262 (file-exists-p file-name)
5264 (concat "\"" file-name "\" does not exist, create it? "))
5265 (let ((file-buffer (create-file-buffer file-name)))
5267 (set-buffer file-buffer)
5268 (rmail-insert-rmail-file-header)
5269 (let ((require-final-newline nil))
5270 (write-region (point-min) (point-max) file-name t 1)))
5271 (kill-buffer file-buffer))
5272 (error "Output file does not exist")))
5274 (buffer-flush-undo (current-buffer))
5276 (insert-buffer-substring artbuf)
5277 (gnus-convert-article-to-rmail)
5278 ;; Decide whether to append to a file or to an Emacs buffer.
5279 (let ((outbuf (get-file-buffer file-name)))
5281 (append-to-file (point-min) (point-max) file-name)
5282 ;; File has been visited, in buffer OUTBUF.
5284 (let ((buffer-read-only nil)
5285 (msg (and (boundp 'rmail-current-message)
5286 rmail-current-message)))
5287 ;; If MSG is non-nil, buffer is in RMAIL mode.
5290 (narrow-to-region (point-max) (point-max))))
5291 (insert-buffer-substring tmpbuf)
5294 (goto-char (point-min))
5296 (search-backward "\^_")
5297 (narrow-to-region (point) (point-max))
5298 (goto-char (1+ (point-min)))
5299 (rmail-count-new-messages t)
5300 (rmail-show-message msg))))))
5302 (kill-buffer tmpbuf)
5305 (defun gnus-output-to-file (file-name)
5306 "Append the current article to a file named FILE-NAME."
5307 (setq file-name (expand-file-name file-name))
5308 (let ((artbuf (current-buffer))
5309 (tmpbuf (get-buffer-create " *GNUS-output*")))
5312 (buffer-flush-undo (current-buffer))
5314 (insert-buffer-substring artbuf)
5315 ;; Append newline at end of the buffer as separator, and then
5317 (goto-char (point-max))
5319 (append-to-file (point-min) (point-max) file-name))
5320 (kill-buffer tmpbuf)
5323 (defun gnus-convert-article-to-rmail ()
5324 "Convert article in current buffer to Rmail message format."
5325 (let ((buffer-read-only nil))
5326 ;; Convert article directly into Babyl format.
5327 ;; Suggested by Rob Austein <sra@lcs.mit.edu>
5328 (goto-char (point-min))
5329 (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
5330 (while (search-forward "\n\^_" nil t) ;single char
5331 (replace-match "\n^_")) ;2 chars: "^" and "_"
5332 (goto-char (point-max))
5335 ;;(defun gnus-convert-article-to-rmail ()
5336 ;; "Convert article in current buffer to Rmail message format."
5337 ;; (let ((buffer-read-only nil))
5338 ;; ;; Insert special header of Unix mail.
5339 ;; (goto-char (point-min))
5341 ;; (or (mail-strip-quoted-names (mail-fetch-field "from"))
5343 ;; " " (current-time-string) "\n")
5344 ;; ;; Stop quoting `From' since this seems unnecessary in most cases.
5345 ;; ;; ``Quote'' "\nFrom " as "\n>From "
5346 ;; ;;(while (search-forward "\nFrom " nil t)
5347 ;; ;; (forward-char -5)
5349 ;; ;; Convert article to babyl format.
5350 ;; (rmail-convert-to-babyl-format)
5355 ;;; Internal functions.
5358 (defun gnus-start-news-server (&optional confirm)
5359 "Open network stream to remote NNTP server.
5360 If optional argument CONFIRM is non-nil, ask you host that NNTP server
5361 is running even if it is defined.
5362 Run gnus-open-server-hook just before opening news server."
5363 (if (gnus-server-opened)
5364 ;; Stream is already opened.
5366 ;; Open NNTP server.
5368 (null gnus-nntp-server))
5369 ;; If someone has set the service to nil, then this should always
5370 ;; be the local host.
5371 (if gnus-nntp-service
5372 (if (and (boundp 'gnus-secondary-servers) gnus-secondary-servers)
5373 ;; Read server name with completion.
5374 (setq gnus-nntp-server
5375 (completing-read "NNTP server: "
5376 (cons (list gnus-nntp-server)
5377 gnus-secondary-servers)
5378 nil nil gnus-nntp-server))
5379 (setq gnus-nntp-server
5380 (read-string "NNTP server: " gnus-nntp-server)))
5381 (setq gnus-nntp-server "")))
5382 ;; If no server name is given, local host is assumed.
5383 (if (or (string-equal gnus-nntp-server "")
5384 (string-equal gnus-nntp-server "::")) ;RMS preference.
5385 (setq gnus-nntp-server (system-name)))
5386 ;; gnus-nntp-server must be either (system-name), ':DIRECTORY', or
5387 ;; nntp server name. I mean '::' cannot be a value of
5388 ;; gnus-nntp-server.
5389 (cond ((and (null gnus-nntp-service)
5390 (string-equal gnus-nntp-server (system-name)))
5392 (gnus-define-access-method 'nnspool)
5393 (message "Looking up local news spool..."))
5394 ((string-match ":" gnus-nntp-server)
5397 (gnus-define-access-method 'mhspool)
5398 (message "Looking up private directory..."))
5400 (gnus-define-access-method 'nntp)
5401 (message "Connecting to NNTP server on %s..." gnus-nntp-server)))
5402 (run-hooks 'gnus-open-server-hook)
5403 (cond ((gnus-server-opened) ;Maybe opened in gnus-open-server-hook.
5405 ((gnus-open-server gnus-nntp-server gnus-nntp-service)
5410 (format "Cannot open NNTP server on %s" gnus-nntp-server)))))
5413 ;; Dummy functions used only once. Should return nil.
5414 (defun gnus-server-opened () nil)
5415 (defun gnus-close-server () nil)
5417 (defun gnus-nntp-message (&optional message)
5418 "Return a message returned from NNTP server.
5419 If no message is available and optional MESSAGE is given, return it."
5420 (let ((status (gnus-status-message))
5421 (message (or message "")))
5422 (if (and (stringp status)
5423 (> (length status) 0))
5426 (defun gnus-define-access-method (method &optional access-methods)
5427 "Define access functions for the access METHOD.
5428 Methods definition is taken from optional argument ACCESS-METHODS or
5429 the variable gnus-access-methods."
5431 (cdr (assoc method (or access-methods gnus-access-methods)))))
5433 (error "Unknown access method: %s" method)
5434 ;; Should not use symbol-function here since overload does not work.
5436 ;; Alist syntax is different from that of 3.14.3.
5437 (fset (car (car bindings)) (car (cdr (car bindings))))
5438 (setq bindings (cdr bindings)))
5441 (defun gnus-select-newsgroup (group &optional show-all)
5442 "Select newsgroup GROUP.
5443 If optional argument SHOW-ALL is non-nil, all of articles in the group
5445 ;; Make sure a connection to NNTP server is alive.
5446 (gnus-start-news-server)
5447 (if (gnus-request-group group)
5448 (let ((articles nil))
5449 (setq gnus-newsgroup-name group)
5450 (setq gnus-newsgroup-unreads
5451 (gnus-uncompress-sequence
5452 (nthcdr 2 (gnus-gethash group gnus-unread-hashtb))))
5454 ;; Select all active articles.
5456 (gnus-uncompress-sequence
5457 (nthcdr 2 (gnus-gethash group gnus-active-hashtb)))))
5459 ;; Select unread articles only.
5460 (setq articles gnus-newsgroup-unreads)))
5461 ;; Require confirmation if selecting large newsgroup.
5462 (setq gnus-newsgroup-unselected nil)
5463 (if (not (numberp gnus-large-newsgroup))
5465 (let ((selected nil)
5466 (number (length articles)))
5467 (if (> number gnus-large-newsgroup)
5473 "How many articles from %s (default %d): "
5474 gnus-newsgroup-name number))))
5476 (if (string-equal input "")
5477 number (string-to-int input))))
5480 (cond ((and (> selected 0)
5481 (< selected number))
5482 ;; Select last N articles.
5483 (setq articles (nthcdr (- number selected) articles)))
5484 ((and (< selected 0)
5485 (< (- 0 selected) number))
5486 ;; Select first N articles.
5487 (setq selected (- 0 selected))
5488 (setq articles (copy-sequence articles))
5489 (setcdr (nthcdr (1- selected) articles) nil))
5491 (setq articles nil))
5492 ;; Otherwise select all.
5494 ;; Get unselected unread articles.
5495 (setq gnus-newsgroup-unselected
5496 (gnus-set-difference gnus-newsgroup-unreads articles))
5499 ;; Get headers list.
5500 (setq gnus-newsgroup-headers (gnus-retrieve-headers articles))
5501 ;; UNREADS may contain expired articles, so we have to remove
5502 ;; them from the list.
5503 (setq gnus-newsgroup-unreads
5504 (gnus-intersection gnus-newsgroup-unreads
5508 (nntp-header-number header)))
5509 gnus-newsgroup-headers)))
5510 ;; Marked article must be a subset of unread articles.
5511 (setq gnus-newsgroup-marked
5512 (gnus-intersection (append gnus-newsgroup-unselected
5513 gnus-newsgroup-unreads)
5515 (gnus-gethash group gnus-marked-hashtb))))
5516 ;; First and last article in this newsgroup.
5517 (setq gnus-newsgroup-begin
5518 (if gnus-newsgroup-headers
5519 (nntp-header-number (car gnus-newsgroup-headers))
5522 (setq gnus-newsgroup-end
5523 (if gnus-newsgroup-headers
5525 (gnus-last-element gnus-newsgroup-headers))
5528 ;; File name that an article was saved last.
5529 (setq gnus-newsgroup-last-rmail nil)
5530 (setq gnus-newsgroup-last-mail nil)
5531 (setq gnus-newsgroup-last-folder nil)
5532 (setq gnus-newsgroup-last-file nil)
5533 ;; Reset article pointer etc.
5534 (setq gnus-current-article nil)
5535 (setq gnus-current-headers nil)
5536 (setq gnus-current-history nil)
5537 (setq gnus-have-all-headers nil)
5538 (setq gnus-last-article nil)
5539 ;; Clear old hash tables for the variable gnus-newsgroup-headers.
5540 (gnus-clear-hashtables-for-newsgroup-headers)
5541 ;; GROUP is successfully selected.
5546 ;; Hacking for making header search much faster.
5548 (defun gnus-get-header-by-number (number)
5549 "Return a header specified by a NUMBER.
5550 If the variable gnus-newsgroup-headers is updated, the hashed table
5551 gnus-newsgroup-headers-hashtb-by-number must be set to nil to indicate
5552 rehash is necessary."
5553 (or gnus-newsgroup-headers-hashtb-by-number
5554 (gnus-make-headers-hashtable-by-number))
5555 (gnus-gethash (int-to-string number)
5556 gnus-newsgroup-headers-hashtb-by-number))
5558 (defun gnus-get-header-by-id (id)
5559 "Return a header specified by an ID.
5560 If the variable gnus-newsgroup-headers is updated, the hashed table
5561 gnus-newsgroup-headers-hashtb-by-id must be set to nil to indicate
5562 rehash is necessary."
5563 (or gnus-newsgroup-headers-hashtb-by-id
5564 (gnus-make-headers-hashtable-by-id))
5566 (gnus-gethash id gnus-newsgroup-headers-hashtb-by-id)))
5568 (defun gnus-make-headers-hashtable-by-number ()
5569 "Make hashtable for the variable gnus-newsgroup-headers by number."
5571 (headers gnus-newsgroup-headers))
5572 (setq gnus-newsgroup-headers-hashtb-by-number
5573 (gnus-make-hashtable (length headers)))
5575 (setq header (car headers))
5576 (gnus-sethash (int-to-string (nntp-header-number header))
5577 header gnus-newsgroup-headers-hashtb-by-number)
5578 (setq headers (cdr headers))
5581 (defun gnus-make-headers-hashtable-by-id ()
5582 "Make hashtable for the variable gnus-newsgroup-headers by id."
5584 (headers gnus-newsgroup-headers))
5585 (setq gnus-newsgroup-headers-hashtb-by-id
5586 (gnus-make-hashtable (length headers)))
5588 (setq header (car headers))
5589 (gnus-sethash (nntp-header-id header)
5590 header gnus-newsgroup-headers-hashtb-by-id)
5591 (setq headers (cdr headers))
5594 (defun gnus-clear-hashtables-for-newsgroup-headers ()
5595 "Clear hash tables created for the variable gnus-newsgroup-headers."
5596 (setq gnus-newsgroup-headers-hashtb-by-id nil)
5597 (setq gnus-newsgroup-headers-hashtb-by-number nil))
5599 (defun gnus-more-header-backward ()
5600 "Find new header backward."
5602 (car (nth 2 (gnus-gethash gnus-newsgroup-name gnus-active-hashtb))))
5603 (artnum gnus-newsgroup-begin)
5605 (while (and (not header)
5607 (setq artnum (1- artnum))
5608 (setq header (car (gnus-retrieve-headers (list artnum)))))
5612 (defun gnus-more-header-forward ()
5613 "Find new header forward."
5615 (cdr (nth 2 (gnus-gethash gnus-newsgroup-name gnus-active-hashtb))))
5616 (artnum gnus-newsgroup-end)
5618 (while (and (not header)
5620 (setq artnum (1+ artnum))
5621 (setq header (car (gnus-retrieve-headers (list artnum)))))
5625 (defun gnus-extend-newsgroup (header &optional backward)
5626 "Extend newsgroup selection with HEADER.
5627 Optional argument BACKWARD means extend toward backward."
5629 (let ((artnum (nntp-header-number header)))
5630 (setq gnus-newsgroup-headers
5632 (cons header gnus-newsgroup-headers)
5633 (append gnus-newsgroup-headers (list header))))
5634 ;; Clear current hash tables for the variable gnus-newsgroup-headers.
5635 (gnus-clear-hashtables-for-newsgroup-headers)
5636 ;; We have to update unreads and unselected, but don't have to
5637 ;; care about gnus-newsgroup-marked.
5638 (if (memq artnum gnus-newsgroup-unselected)
5639 (setq gnus-newsgroup-unreads
5640 (cons artnum gnus-newsgroup-unreads)))
5641 (setq gnus-newsgroup-unselected
5642 (delq artnum gnus-newsgroup-unselected))
5643 (setq gnus-newsgroup-begin (min gnus-newsgroup-begin artnum))
5644 (setq gnus-newsgroup-end (max gnus-newsgroup-end artnum))
5647 (defun gnus-mark-article-as-read (article)
5648 "Remember that ARTICLE is marked as read."
5649 ;; Remove from unread and marked list.
5650 (setq gnus-newsgroup-unreads
5651 (delq article gnus-newsgroup-unreads))
5652 (setq gnus-newsgroup-marked
5653 (delq article gnus-newsgroup-marked)))
5655 (defun gnus-mark-article-as-unread (article &optional clear-mark)
5656 "Remember that ARTICLE is marked as unread.
5657 Optional argument CLEAR-MARK means ARTICLE should not be remembered
5658 that it was marked as read once."
5659 ;; Add to unread list.
5660 (or (memq article gnus-newsgroup-unreads)
5661 (setq gnus-newsgroup-unreads
5662 (cons article gnus-newsgroup-unreads)))
5663 ;; If CLEAR-MARK is non-nil, the article must be removed from marked
5664 ;; list. Otherwise, it must be added to the list.
5666 (setq gnus-newsgroup-marked
5667 (delq article gnus-newsgroup-marked))
5668 (or (memq article gnus-newsgroup-marked)
5669 (setq gnus-newsgroup-marked
5670 (cons article gnus-newsgroup-marked)))))
5672 (defun gnus-clear-system ()
5673 "Clear all variables and buffer."
5674 ;; Clear GNUS variables.
5675 (let ((variables gnus-variable-list))
5677 (set (car variables) nil)
5678 (setq variables (cdr variables))))
5679 ;; Clear other internal variables.
5680 (setq gnus-newsrc-hashtb nil)
5681 (setq gnus-marked-hashtb nil)
5682 (setq gnus-killed-hashtb nil)
5683 (setq gnus-active-hashtb nil)
5684 (setq gnus-octive-hashtb nil)
5685 (setq gnus-unread-hashtb nil)
5686 (setq gnus-newsgroup-headers nil)
5687 (setq gnus-newsgroup-headers-hashtb-by-id nil)
5688 (setq gnus-newsgroup-headers-hashtb-by-number nil)
5689 ;; Kill the startup file.
5690 (and gnus-current-startup-file
5691 (get-file-buffer gnus-current-startup-file)
5692 (kill-buffer (get-file-buffer gnus-current-startup-file)))
5693 (setq gnus-current-startup-file nil)
5694 ;; Kill GNUS buffers.
5695 (let ((buffers gnus-buffer-list))
5697 (if (get-buffer (car buffers))
5698 (kill-buffer (car buffers)))
5699 (setq buffers (cdr buffers))
5702 (defun gnus-configure-windows (action)
5703 "Configure GNUS windows according to the next ACTION.
5704 The ACTION is either a symbol, such as `summary', or a
5705 configuration list such as `(1 1 2)'. If ACTION is not a list,
5706 configuration list is got from the variable gnus-window-configuration."
5709 action (car (cdr (assq action gnus-window-configuration)))))
5710 (grpwin (get-buffer-window gnus-group-buffer))
5711 (subwin (get-buffer-window gnus-summary-buffer))
5712 (artwin (get-buffer-window gnus-article-buffer))
5718 (if (or (null windows) ;No configuration is specified.
5719 (and (eq (null grpwin)
5720 (zerop (nth 0 windows)))
5722 (zerop (nth 1 windows)))
5724 (zerop (nth 2 windows)))))
5725 ;; No need to change window configuration.
5727 (select-window (or grpwin subwin artwin (selected-window)))
5728 ;; First of all, compute the height of each window.
5729 (cond (gnus-use-full-window
5730 ;; Take up the entire screen.
5731 (delete-other-windows)
5732 (setq height (window-height (selected-window))))
5734 (setq height (+ (if grpwin (window-height grpwin) 0)
5735 (if subwin (window-height subwin) 0)
5736 (if artwin (window-height artwin) 0)))))
5737 ;; The Newsgroup buffer exits always. So, use it to extend the
5738 ;; Group window so as to get enough window space.
5739 (switch-to-buffer gnus-group-buffer 'norecord)
5740 (and (get-buffer gnus-summary-buffer)
5741 (delete-windows-on gnus-summary-buffer))
5742 (and (get-buffer gnus-article-buffer)
5743 (delete-windows-on gnus-article-buffer))
5744 ;; Compute expected window height.
5745 (setq winsum (apply (function +) windows))
5746 (if (not (zerop (nth 0 windows)))
5747 (setq grpheight (max window-min-height
5748 (/ (* height (nth 0 windows)) winsum))))
5749 (if (not (zerop (nth 1 windows)))
5750 (setq subheight (max window-min-height
5751 (/ (* height (nth 1 windows)) winsum))))
5752 (if (not (zerop (nth 2 windows)))
5753 (setq artheight (max window-min-height
5754 (/ (* height (nth 2 windows)) winsum))))
5755 (setq height (+ grpheight subheight artheight))
5756 (enlarge-window (max 0 (- height (window-height (selected-window)))))
5757 ;; Then split the window.
5758 (and (not (zerop artheight))
5759 (or (not (zerop grpheight))
5760 (not (zerop subheight)))
5761 (split-window-vertically (+ grpheight subheight)))
5762 (and (not (zerop grpheight))
5763 (not (zerop subheight))
5764 (split-window-vertically grpheight))
5765 ;; Then select buffers in each window.
5766 (and (not (zerop grpheight))
5768 (switch-to-buffer gnus-group-buffer 'norecord)
5770 (and (not (zerop subheight))
5772 (switch-to-buffer gnus-summary-buffer 'norecord)
5774 (and (not (zerop artheight))
5776 ;; If Article buffer does not exist, it will be created
5778 (gnus-article-setup-buffer)
5779 (switch-to-buffer gnus-article-buffer 'norecord)))
5783 (defun gnus-find-header-by-number (headers number)
5784 "Return a header which is a element of HEADERS and has NUMBER."
5786 (while (and headers (not found))
5787 ;; We cannot use `=' to accept non-numeric NUMBER.
5788 (if (eq number (nntp-header-number (car headers)))
5789 (setq found (car headers)))
5790 (setq headers (cdr headers)))
5794 (defun gnus-find-header-by-id (headers id)
5795 "Return a header which is a element of HEADERS and has Message-ID."
5797 (while (and headers (not found))
5798 (if (string-equal id (nntp-header-id (car headers)))
5799 (setq found (car headers)))
5800 (setq headers (cdr headers)))
5804 (defun gnus-version ()
5805 "Version numbers of this version of GNUS."
5807 (cond ((and (boundp 'mhspool-version) (boundp 'nnspool-version))
5808 (message "%s; %s; %s; %s"
5809 gnus-version nntp-version nnspool-version mhspool-version))
5810 ((boundp 'mhspool-version)
5811 (message "%s; %s; %s"
5812 gnus-version nntp-version mhspool-version))
5813 ((boundp 'nnspool-version)
5814 (message "%s; %s; %s"
5815 gnus-version nntp-version nnspool-version))
5817 (message "%s; %s" gnus-version nntp-version))))
5819 (defun gnus-info-find-node ()
5820 "Find Info documentation of GNUS."
5823 ;; Enlarge info window if needed.
5824 (cond ((eq major-mode 'gnus-group-mode)
5825 (gnus-configure-windows '(1 0 0)) ;Take all windows.
5826 (pop-to-buffer gnus-group-buffer))
5827 ((eq major-mode 'gnus-summary-mode)
5828 (gnus-configure-windows '(0 1 0)) ;Take all windows.
5829 (pop-to-buffer gnus-summary-buffer)))
5830 (Info-goto-node (car (cdr (assq major-mode gnus-info-nodes)))))
5832 (defun gnus-overload-functions (&optional overloads)
5833 "Overload functions specified by optional argument OVERLOADS.
5834 If nothing is specified, use the variable gnus-overload-functions."
5836 (overloads (or overloads gnus-overload-functions)))
5838 (setq defs (car overloads))
5839 (setq overloads (cdr overloads))
5840 ;; Load file before overloading function if necessary. Make
5841 ;; sure we cannot use `require' always.
5842 (and (not (fboundp (car defs)))
5843 (car (cdr (cdr defs)))
5844 (load (car (cdr (cdr defs))) nil 'nomessage))
5845 (fset (car defs) (car (cdr defs)))
5848 (defun gnus-make-threads (newsgroup-headers)
5849 "Make conversation threads tree from NEWSGROUP-HEADERS."
5850 (let ((headers newsgroup-headers)
5856 ;; Make message dependency alist.
5858 (setq h (car headers))
5859 (setq headers (cdr headers))
5860 ;; Ignore invalid headers.
5861 (if (vectorp h) ;Depends on nntp.el.
5863 ;; Ignore broken references, e.g "<123@a.b.c".
5864 (setq refer (nntp-header-references h))
5866 (string-match "\\(<[^<>]+>\\)[^>]*$" refer)
5867 ;; (gnus-find-header-by-id
5868 ;; newsgroup-headers
5869 ;; (substring refer (match-beginning 1) (match-end 1)))
5870 ;; In fact if the variable newsgroup-headers
5871 ;; is not 'equal' to the variable
5872 ;; gnus-newsgroup-headers, the following
5873 ;; function call may return bogus value.
5874 (gnus-get-header-by-id
5875 (substring refer (match-beginning 1) (match-end 1)))
5877 ;; Check subject equality.
5878 (or gnus-thread-ignore-subject
5880 (string-equal (gnus-simplify-subject
5881 (nntp-header-subject h) 're)
5882 (gnus-simplify-subject
5883 (nntp-header-subject d) 're))
5884 ;; H should be a thread root.
5888 (cons (cons h d) dependencies))
5889 ;; H is a thread root.
5891 (setq roots (cons h roots)))
5894 ;; Make complete threads from the roots.
5895 ;; Note: dependencies are in reverse order, but
5896 ;; gnus-make-threads-1 processes it in reverse order again. So,
5897 ;; we don't have to worry about it.
5901 (gnus-make-threads-1 root dependencies))) (nreverse roots))
5904 (defun gnus-make-threads-1 (parent dependencies)
5905 (let ((children nil)
5907 (depends dependencies))
5910 (setq d (car depends))
5911 (setq depends (cdr depends))
5913 (eq (nntp-header-id parent) (nntp-header-id (cdr d)))
5914 (setq children (cons (car d) children))))
5920 (gnus-make-threads-1 child dependencies))) children))
5923 (defun gnus-narrow-to-page (&optional arg)
5924 "Make text outside current page invisible except for page delimiter.
5925 A numeric arg specifies to move forward or backward by that many pages,
5926 thus showing a page other than the one point was originally in."
5928 (setq arg (if arg (prefix-numeric-value arg) 0))
5930 (forward-page -1) ;Beginning of current page.
5935 (forward-page (1- arg))))
5936 ;; Find the end of the page.
5938 ;; If we stopped due to end of buffer, stay there.
5939 ;; If we stopped after a page delimiter, put end of restriction
5940 ;; at the beginning of that line.
5941 ;; These are commented out.
5942 ;; (if (save-excursion (beginning-of-line)
5943 ;; (looking-at page-delimiter))
5944 ;; (beginning-of-line))
5945 (narrow-to-region (point)
5947 ;; Find the top of the page.
5949 ;; If we found beginning of buffer, stay there.
5950 ;; If extra text follows page delimiter on same line,
5952 ;; Otherwise, show text starting with following line.
5953 (if (and (eolp) (not (bobp)))
5958 ;; Create hash table for alist, such as gnus-newsrc-assoc,
5959 ;; gnus-killed-assoc, and gnus-marked-assoc.
5961 (defun gnus-make-hashtable-from-alist (alist &optional hashsize)
5962 "Return hash table for ALIST.
5963 Optional argument HASHSIZE specifies the hashtable size.
5964 Hash key is a car of alist element, which must be a string."
5965 (let ((hashtb (gnus-make-hashtable (or hashsize (length alist)))))
5967 (gnus-sethash (car (car alist)) ;Newsgroup name
5968 (car alist) ;Alist element
5970 (setq alist (cdr alist)))
5974 (defun gnus-last-element (list)
5975 "Return last element of LIST."
5978 (if (null (cdr list))
5979 (setq last (car list)))
5980 (setq list (cdr list)))
5984 (defun gnus-set-difference (list1 list2)
5985 "Return a list of elements of LIST1 that do not appear in LIST2."
5986 (let ((list1 (copy-sequence list1)))
5988 (setq list1 (delq (car list2) list1))
5989 (setq list2 (cdr list2)))
5993 (defun gnus-intersection (list1 list2)
5994 "Return a list of elements that appear in both LIST1 and LIST2."
5997 (if (memq (car list2) list1)
5998 (setq result (cons (car list2) result)))
5999 (setq list2 (cdr list2)))
6005 ;;; Get information about active articles, already read articles, and
6006 ;;; still unread articles.
6009 ;; GNUS internal format of gnus-newsrc-assoc and gnus-killed-assoc:
6010 ;; (("general" t (1 . 1))
6011 ;; ("misc" t (1 . 10) (12 . 15))
6012 ;; ("test" nil (1 . 99)) ...)
6013 ;; GNUS internal format of gnus-marked-assoc:
6014 ;; (("general" 1 2 3)
6016 ;; GNUS internal format of gnus-active-hashtb:
6017 ;; (("general" t (1 . 1))
6018 ;; ("misc" t (1 . 10))
6019 ;; ("test" nil (1 . 99)) ...)
6020 ;; GNUS internal format of gnus-unread-hashtb:
6021 ;; (("general" 1 (1 . 1))
6022 ;; ("misc" 14 (1 . 10) (12 . 15))
6023 ;; ("test" 99 (1 . 99)) ...)
6025 (defun gnus-setup-news (&optional rawfile)
6026 "Setup news information.
6027 If optional argument RAWFILE is non-nil, force to read raw startup file."
6028 (let ((init (not (and gnus-newsrc-assoc
6033 ;; We have to clear some variables to re-initialize news info.
6035 (setq gnus-newsrc-assoc nil
6036 gnus-active-hashtb nil
6037 gnus-unread-hashtb nil))
6038 (gnus-read-active-file)
6039 ;; Initialize only once.
6042 ;; Get distributions only once.
6043 (gnus-read-distributions-file)
6044 ;; newsrc file must be read after reading active file since
6045 ;; its size is used to guess the size of gnus-newsrc-hashtb.
6046 (gnus-read-newsrc-file rawfile)
6048 (gnus-expire-marked-articles)
6049 (gnus-get-unread-articles)
6050 ;; Check new newsgroups and subscribe them.
6052 (let ((new-newsgroups (gnus-find-new-newsgroups)))
6053 (while new-newsgroups
6054 (funcall gnus-subscribe-newsgroup-method (car new-newsgroups))
6055 (setq new-newsgroups (cdr new-newsgroups))
6059 (defun gnus-add-newsgroup (newsgroup)
6060 "Subscribe new NEWSGROUP safely and put it at top."
6061 (and (null (gnus-gethash newsgroup gnus-newsrc-hashtb)) ;Really new?
6062 (gnus-gethash newsgroup gnus-active-hashtb) ;Really exist?
6063 (gnus-insert-newsgroup (or (gnus-gethash newsgroup gnus-killed-hashtb)
6065 (car (car gnus-newsrc-assoc)))))
6067 (defun gnus-find-new-newsgroups ()
6068 "Looking for new newsgroups and return names.
6069 `-n' option of options line in .newsrc file is recognized."
6071 (new-newsgroups nil))
6075 (setq group (symbol-name sym))
6076 ;; Taking account of `-n' option.
6077 (and (or (null gnus-newsrc-options-n-no)
6078 (not (string-match gnus-newsrc-options-n-no group))
6079 (and gnus-newsrc-options-n-yes
6080 (string-match gnus-newsrc-options-n-yes group)))
6081 (null (gnus-gethash group gnus-killed-hashtb)) ;Ignore killed.
6082 (null (gnus-gethash group gnus-newsrc-hashtb)) ;Really new.
6083 ;; Find new newsgroup.
6084 (setq new-newsgroups
6085 (cons group new-newsgroups)))
6088 ;; Return new newsgroups.
6092 (defun gnus-kill-newsgroup (group)
6093 "Kill GROUP from gnus-newsrc-assoc, .newsrc and gnus-unread-hashtb."
6094 (let ((info (gnus-gethash group gnus-newsrc-hashtb)))
6097 ;; Delete from gnus-newsrc-assoc and gnus-newsrc-hashtb.
6098 (setq gnus-newsrc-assoc (delq info gnus-newsrc-assoc))
6099 (gnus-sethash group nil gnus-newsrc-hashtb)
6100 ;; Add to gnus-killed-assoc and gnus-killed-hashtb.
6101 (setq gnus-killed-assoc
6103 (delq (gnus-gethash group gnus-killed-hashtb)
6104 gnus-killed-assoc)))
6105 (gnus-sethash group info gnus-killed-hashtb)
6106 ;; Clear unread hashtable.
6107 ;; Thanks cwitty@csli.Stanford.EDU (Carl Witty).
6108 (gnus-sethash group nil gnus-unread-hashtb)
6109 ;; Then delete from .newsrc
6110 (gnus-update-newsrc-buffer group 'delete)
6111 ;; Return the deleted newsrc entry.
6115 (defun gnus-insert-newsgroup (info &optional next)
6116 "Insert newsrc INFO entry before NEXT.
6117 If optional argument NEXT is nil, appended to the last."
6119 (error "Invalid argument: %s" info))
6120 (let* ((group (car info)) ;Newsgroup name.
6122 (gnus-difference-of-range
6123 (nth 2 (gnus-gethash group gnus-active-hashtb)) (nthcdr 2 info))))
6124 ;; Check duplication.
6125 (if (gnus-gethash group gnus-newsrc-hashtb)
6126 (error "Duplicated: %s" group))
6127 ;; Insert to gnus-newsrc-assoc and gnus-newsrc-hashtb.
6128 (if (string-equal next (car (car gnus-newsrc-assoc)))
6129 (setq gnus-newsrc-assoc
6130 (cons info gnus-newsrc-assoc))
6132 (rest (cdr gnus-newsrc-assoc))
6133 (tail gnus-newsrc-assoc))
6134 ;; Seach insertion point.
6135 (while (and (not found) rest)
6136 (if (string-equal next (car (car rest)))
6138 (setq rest (cdr rest))
6139 (setq tail (cdr tail))
6143 (setcdr tail (cons info rest))
6144 ;; gnus-newsrc-assoc must be nil.
6145 (setq gnus-newsrc-assoc
6146 (append gnus-newsrc-assoc (cons info rest))))
6148 (gnus-sethash group info gnus-newsrc-hashtb)
6149 ;; Delete from gnus-killed-assoc and gnus-killed-hashtb.
6150 (setq gnus-killed-assoc
6151 (delq (gnus-gethash group gnus-killed-hashtb) gnus-killed-assoc))
6152 (gnus-sethash group nil gnus-killed-hashtb)
6153 ;; Then insert to .newsrc.
6154 (gnus-update-newsrc-buffer group nil next)
6155 ;; Add to gnus-unread-hashtb.
6157 (cons group ;Newsgroup name.
6158 (cons (gnus-number-of-articles range) range))
6162 (defun gnus-check-killed-newsgroups ()
6163 "Check consistency between gnus-newsrc-assoc and gnus-killed-assoc.
6164 gnus-killed-hashtb is also updated."
6167 (old-killed gnus-killed-assoc))
6169 (setq group (car (car old-killed)))
6170 (and (or (null gnus-newsrc-options-n-no)
6171 (not (string-match gnus-newsrc-options-n-no group))
6172 (and gnus-newsrc-options-n-yes
6173 (string-match gnus-newsrc-options-n-yes group)))
6174 (null (gnus-gethash group gnus-newsrc-hashtb)) ;No duplication.
6175 ;; Subscribed in options line and not in gnus-newsrc-assoc.
6177 (cons (car old-killed) new-killed)))
6178 (setq old-killed (cdr old-killed))
6180 (setq gnus-killed-assoc (nreverse new-killed))
6181 (setq gnus-killed-hashtb
6182 (gnus-make-hashtable-from-alist gnus-killed-assoc))
6185 (defun gnus-check-bogus-newsgroups (&optional confirm)
6186 "Delete bogus newsgroups.
6187 If optional argument CONFIRM is non-nil, confirm deletion of newsgroups."
6188 (let ((group nil) ;Newsgroup name temporary used.
6189 (old-newsrc gnus-newsrc-assoc)
6191 (bogus nil) ;List of bogus newsgroups.
6192 (old-killed gnus-killed-assoc)
6194 (old-marked gnus-marked-assoc)
6196 (message "Checking bogus newsgroups...")
6197 ;; Update gnus-newsrc-assoc and gnus-newsrc-hashtb.
6199 (setq group (car (car old-newsrc)))
6200 (if (or (gnus-gethash group gnus-active-hashtb)
6203 (format "Delete bogus newsgroup: %s " group)))))
6204 ;; Active newsgroup.
6205 (setq new-newsrc (cons (car old-newsrc) new-newsrc))
6206 ;; Found a bogus newsgroup.
6207 (setq bogus (cons group bogus)))
6208 (setq old-newsrc (cdr old-newsrc))
6210 (setq gnus-newsrc-assoc (nreverse new-newsrc))
6211 (setq gnus-newsrc-hashtb
6212 (gnus-make-hashtable-from-alist gnus-newsrc-assoc))
6213 ;; Update gnus-killed-assoc and gnus-killed-hashtb.
6214 ;; The killed newsgroups are deleted without any confirmations.
6216 (setq group (car (car old-killed)))
6217 (and (gnus-gethash group gnus-active-hashtb)
6218 (null (gnus-gethash group gnus-newsrc-hashtb))
6219 ;; Active and really killed newsgroup.
6220 (setq new-killed (cons (car old-killed) new-killed)))
6221 (setq old-killed (cdr old-killed))
6223 (setq gnus-killed-assoc (nreverse new-killed))
6224 (setq gnus-killed-hashtb
6225 (gnus-make-hashtable-from-alist gnus-killed-assoc))
6226 ;; Remove BOGUS from .newsrc file.
6228 (gnus-update-newsrc-buffer (car bogus) 'delete)
6229 (setq bogus (cdr bogus)))
6230 ;; Update gnus-marked-assoc and gnus-marked-hashtb.
6232 (setq group (car (car old-marked)))
6233 (if (and (cdr (car old-marked)) ;Non-empty?
6234 (gnus-gethash group gnus-newsrc-hashtb)) ;Not bogus?
6235 (setq new-marked (cons (car old-marked) new-marked)))
6236 (setq old-marked (cdr old-marked)))
6237 (setq gnus-marked-assoc new-marked)
6238 (setq gnus-marked-hashtb
6239 (gnus-make-hashtable-from-alist gnus-marked-assoc))
6240 (message "Checking bogus newsgroups... done")
6243 (defun gnus-get-unread-articles ()
6244 "Compute diffs between active and read articles."
6245 (let ((read gnus-newsrc-assoc)
6250 (message "Checking new news...")
6251 (or gnus-unread-hashtb
6252 (setq gnus-unread-hashtb
6253 (gnus-make-hashtable (length gnus-active-hashtb))))
6255 (setq group-info (car read)) ;About one newsgroup
6256 (setq group-name (car group-info))
6257 (setq active (nth 2 (gnus-gethash group-name gnus-active-hashtb)))
6258 (if (and gnus-octive-hashtb
6259 ;; Is nothing changed?
6261 (nth 2 (gnus-gethash group-name gnus-octive-hashtb)))
6262 ;; Is this newsgroup in the unread hash table?
6263 (gnus-gethash group-name gnus-unread-hashtb)
6266 (setq range (gnus-difference-of-range active (nthcdr 2 group-info)))
6267 (gnus-sethash group-name
6268 (cons group-name ;Group name
6269 (cons (gnus-number-of-articles range)
6270 range)) ;Range of unread articles
6273 (setq read (cdr read))
6275 (message "Checking new news... done")
6278 (defun gnus-expire-marked-articles ()
6279 "Check expired article which is marked as unread."
6280 (let ((marked-assoc gnus-marked-assoc)
6282 (marked nil) ;Current marked info.
6283 (articles nil) ;List of marked articles.
6284 (updated nil) ;List of real marked.
6287 (setq marked (car marked-assoc))
6288 (setq articles (cdr marked))
6291 (car (nth 2 (gnus-gethash (car marked) gnus-active-hashtb))))
6292 (while (and begin articles)
6293 (if (>= (car articles) begin)
6294 ;; This article is still active.
6295 (setq updated (cons (car articles) updated)))
6296 (setq articles (cdr articles)))
6299 (cons (cons (car marked) updated) updated-assoc)))
6300 (setq marked-assoc (cdr marked-assoc)))
6301 (setq gnus-marked-assoc updated-assoc)
6302 (setq gnus-marked-hashtb
6303 (gnus-make-hashtable-from-alist gnus-marked-assoc))
6306 (defun gnus-mark-as-read-by-xref
6307 (group headers unreads &optional subscribed-only)
6308 "Mark articles as read using cross references and return updated newsgroups.
6309 Arguments are GROUP, HEADERS, UNREADS, and optional SUBSCRIBED-ONLY."
6310 (let ((xref-list nil)
6312 (xrefs nil) ;One Xref: field info.
6313 (xref nil) ;(NEWSGROUP . ARTICLE)
6314 (gname nil) ;Newsgroup name
6315 (article nil)) ;Article number
6317 (setq header (car headers))
6318 (if (memq (nntp-header-number header) unreads)
6319 ;; This article is not yet marked as read.
6321 (setq xrefs (gnus-parse-xref-field (nntp-header-xref header)))
6322 ;; For each cross reference info. in one Xref: field.
6324 (setq xref (car xrefs))
6325 (setq gname (car xref)) ;Newsgroup name
6326 (setq article (cdr xref)) ;Article number
6327 (or (string-equal group gname) ;Ignore current newsgroup.
6328 ;; Ignore unsubscribed newsgroup if requested.
6329 (and subscribed-only
6330 (not (nth 1 (gnus-gethash gname gnus-newsrc-hashtb))))
6331 ;; Ignore article marked as unread.
6332 (memq article (cdr (gnus-gethash gname gnus-marked-hashtb)))
6333 (let ((group-xref (assoc gname xref-list)))
6335 (if (memq article (cdr group-xref))
6337 (setcdr group-xref (cons article (cdr group-xref))))
6338 ;; Create new assoc entry for GROUP.
6339 (setq xref-list (cons (list gname article) xref-list)))
6341 (setq xrefs (cdr xrefs))
6343 (setq headers (cdr headers)))
6344 ;; Mark cross referenced articles as read.
6345 (gnus-mark-xrefed-as-read xref-list)
6346 ;;(message "%s %s" (prin1-to-string unreads) (prin1-to-string xref-list))
6347 ;; Return list of updated group name.
6348 (mapcar (function car) xref-list)
6351 (defun gnus-parse-xref-field (xref-value)
6352 "Parse Xref: field value, and return list of `(group . article-id)'."
6353 (let ((xref-list nil)
6354 (xref-value (or xref-value "")))
6355 ;; Remove server host name.
6356 (if (string-match "^[ \t]*[^ \t,]+[ \t,]+\\(.*\\)$" xref-value)
6357 (setq xref-value (substring xref-value (match-beginning 1)))
6358 (setq xref-value nil))
6359 ;; Process each xref info.
6362 "^[ \t,]*\\([^ \t,]+\\):\\([0-9]+\\)[^0-9]*" xref-value)
6368 (substring xref-value (match-beginning 1) (match-end 1))
6371 (substring xref-value (match-beginning 2) (match-end 2))))
6373 (setq xref-value (substring xref-value (match-end 2))))
6374 (setq xref-value nil)))
6379 (defun gnus-mark-xrefed-as-read (xrefs)
6380 "Update unread article information using XREFS alist."
6385 (setq group (car (car xrefs)))
6386 (setq idlist (cdr (car xrefs)))
6387 (setq unread (gnus-uncompress-sequence
6388 (nthcdr 2 (gnus-gethash group gnus-unread-hashtb))))
6390 (setq unread (delq (car idlist) unread))
6391 (setq idlist (cdr idlist)))
6392 (gnus-update-unread-articles group unread 'ignore)
6393 (setq xrefs (cdr xrefs))
6396 (defun gnus-update-unread-articles (group unread-list marked-list)
6397 "Update unread articles of GROUP using UNREAD-LIST and MARKED-LIST."
6398 (let ((active (nth 2 (gnus-gethash group gnus-active-hashtb)))
6399 (unread (gnus-gethash group gnus-unread-hashtb)))
6400 (if (or (null active) (null unread))
6401 ;; Ignore unknown newsgroup.
6403 ;; Update gnus-unread-hashtb.
6405 (setcdr (cdr unread)
6406 (gnus-compress-sequence unread-list))
6407 ;; All of the articles are read.
6408 (setcdr (cdr unread) '((0 . 0))))
6409 ;; Number of unread articles.
6410 (setcar (cdr unread)
6411 (gnus-number-of-articles (nthcdr 2 unread)))
6412 ;; Update gnus-newsrc-assoc.
6413 (if (> (car active) 0)
6414 ;; Articles from 1 to N are not active.
6415 (setq active (cons 1 (cdr active))))
6416 (setcdr (cdr (gnus-gethash group gnus-newsrc-hashtb))
6417 (gnus-difference-of-range active (nthcdr 2 unread)))
6418 ;; Update .newsrc buffer.
6419 (gnus-update-newsrc-buffer group)
6420 ;; Update gnus-marked-assoc.
6421 (if (listp marked-list) ;Includes NIL.
6422 (let ((marked (gnus-gethash group gnus-marked-hashtb)))
6423 (cond (marked ;There is an entry.
6424 (setcdr marked marked-list))
6425 (marked-list ;Non-NIL.
6426 (let ((info (cons group marked-list)))
6427 ;; hashtb must share the same cons cell.
6428 (setq gnus-marked-assoc
6429 (cons info gnus-marked-assoc))
6430 (gnus-sethash group info gnus-marked-hashtb)
6435 (defun gnus-read-active-file ()
6436 "Get active file from NNTP server."
6437 ;; Make sure a connection to NNTP server is alive.
6438 (gnus-start-news-server)
6439 (message "Reading active file...")
6440 (if (gnus-request-list) ;Get active file from server
6442 (set-buffer nntp-server-buffer)
6443 (gnus-active-to-gnus-format)
6444 (message "Reading active file... done"))
6445 (error "Cannot read active file from NNTP server.")))
6447 (defun gnus-active-to-gnus-format ()
6448 "Convert active file format to internal format.
6449 Lines matching gnus-ignored-newsgroups are ignored."
6450 ;; Delete unnecessary lines.
6451 (goto-char (point-min))
6452 ;;(delete-matching-lines "^to\\..*$")
6453 (delete-matching-lines gnus-ignored-newsgroups)
6454 ;; Save OLD active info.
6455 (setq gnus-octive-hashtb gnus-active-hashtb)
6456 ;; Make large enough hash table.
6457 (setq gnus-active-hashtb
6458 (gnus-make-hashtable (count-lines (point-min) (point-max))))
6459 ;; Store active file in hashtable.
6460 (goto-char (point-min))
6463 "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([ymn]\\).*$"
6466 (buffer-substring (match-beginning 1) (match-end 1))
6467 (list (buffer-substring (match-beginning 1) (match-end 1))
6469 "y" (buffer-substring (match-beginning 4) (match-end 4)))
6470 (cons (string-to-int
6471 (buffer-substring (match-beginning 3) (match-end 3)))
6473 (buffer-substring (match-beginning 2) (match-end 2)))))
6477 (defun gnus-read-newsrc-file (&optional rawfile)
6479 If optional argument RAWFILE is non-nil, the raw startup file is read."
6480 (setq gnus-current-startup-file (gnus-make-newsrc-file gnus-startup-file))
6481 ;; Reset variables which may be included in the quick startup file.
6482 (let ((variables gnus-variable-list))
6484 (set (car variables) nil)
6485 (setq variables (cdr variables))))
6486 (let* ((newsrc-file gnus-current-startup-file)
6487 (quick-file (concat newsrc-file ".el"))
6490 ;; Prepare .newsrc buffer.
6491 (set-buffer (find-file-noselect newsrc-file))
6492 ;; It is not so good idea turning off undo.
6493 ;;(buffer-flush-undo (current-buffer))
6494 ;; Load quick .newsrc to restore gnus-marked-assoc and
6495 ;; gnus-killed-assoc even if gnus-newsrc-assoc is out of date.
6498 (setq quick-loaded (load quick-file t t t))
6499 ;; Recreate hashtables.
6500 (setq gnus-killed-hashtb
6501 (gnus-make-hashtable-from-alist gnus-killed-assoc))
6502 (setq gnus-marked-hashtb
6503 (gnus-make-hashtable-from-alist gnus-marked-assoc))
6506 (cond ((and (not rawfile) ;Not forced to read the raw file.
6507 ;; .newsrc.el is newer than .newsrc.
6508 ;; Do it this way in case timestamps are identical
6509 ;; (on fast machines/disks).
6510 (not (file-newer-than-file-p newsrc-file quick-file))
6512 gnus-newsrc-assoc ;Really loaded?
6514 ;; We don't have to read the raw startup file.
6515 ;; gnus-newsrc-assoc may be defined in the quick startup file.
6516 ;; So, we have to define the hashtable here.
6517 (setq gnus-newsrc-hashtb
6518 (gnus-make-hashtable-from-alist gnus-newsrc-assoc)))
6520 ;; Since .newsrc file is newer than quick file, read it.
6521 (message "Reading %s..." newsrc-file)
6522 (gnus-newsrc-to-gnus-format)
6523 (gnus-check-killed-newsgroups)
6524 (message "Reading %s... Done" newsrc-file)))
6527 (defun gnus-make-newsrc-file (file)
6528 "Make server dependent file name by catenating FILE and server host name."
6529 (let* ((file (expand-file-name file nil))
6530 (real-file (concat file "-" gnus-nntp-server)))
6531 (if (file-exists-p real-file)
6535 (defun gnus-newsrc-to-gnus-format ()
6536 "Parse current buffer as .newsrc file."
6537 (let ((newsgroup nil)
6542 ;; We have to re-initialize these variable (except for
6543 ;; gnus-marked-assoc and gnus-killed-assoc) because quick startup
6544 ;; file may contain bogus values.
6545 (setq gnus-newsrc-options nil)
6546 (setq gnus-newsrc-options-n-yes nil)
6547 (setq gnus-newsrc-options-n-no nil)
6548 (setq gnus-newsrc-assoc nil)
6549 ;; Make large enough hash table.
6550 (setq gnus-newsrc-hashtb
6551 (gnus-make-hashtable
6552 (max (length gnus-active-hashtb)
6553 (count-lines (point-min) (point-max)))))
6554 ;; Save options line to variable.
6555 ;; Lines beginning with white spaces are treated as continuation
6556 ;; line. Refer man page of newsrc(5).
6557 (goto-char (point-min))
6558 (if (re-search-forward
6559 "^[ \t]*options[ \t]*\\(.*\\(\n[ \t]+.*\\)*\\)[ \t]*$" nil t)
6561 ;; Save entire options line.
6562 (setq gnus-newsrc-options
6563 (buffer-substring (match-beginning 1) (match-end 1)))
6564 ;; Compile "-n" option.
6565 (if (string-match "\\(^\\|[ \t\n]\\)-n" gnus-newsrc-options)
6567 (gnus-parse-n-options
6568 (substring gnus-newsrc-options (match-end 0)))))
6569 (setq gnus-newsrc-options-n-yes (car yes-and-no))
6570 (setq gnus-newsrc-options-n-no (cdr yes-and-no))
6573 ;; Parse body of .newsrc file
6574 ;; Options line continuation lines must be also considered here.
6575 ;; Before supporting continuation lines, " newsgroup ! 1-5" was
6576 ;; okay, but now it is invalid. It should be "newsgroup! 1-5".
6577 (goto-char (point-min))
6578 ;; Due to overflows in regex.c, change the following regexp:
6579 ;; "^\\([^:! \t\n]+\\)\\([:!]\\)[ \t]*\\(.*\\)$"
6580 ;; Suggested by composer@bucsf.bu.edu (Jeff Kellem)
6581 ;; but no longer viable because of extensive backtracking in Emacs 19:
6582 ;; "^\\([^:! \t\n]+\\)\\([:!]\\)[ \t]*\\(\\(...\\)*.*\\)$"
6583 ;; but, the following causes trouble on some case:
6584 ;; "^\\([^:! \t\n]+\\)\\([:!]\\)[ \t]*\\(\\|[^ \t\n].*\\)$"
6585 (while (re-search-forward
6586 (if (= gnus-emacs-version 18)
6587 "^\\([^:! \t\n]+\\)\\([:!]\\)[ \t]*\\(\\(...\\)*.*\\)$"
6588 "^\\([^:! \t\n]+\\)\\([:!]\\)[ \t]*\\(.*\\)$")
6590 (setq newsgroup (buffer-substring (match-beginning 1) (match-end 1)))
6591 ;; Check duplications of newsgroups.
6592 ;; Note: Checking the duplications takes very long time.
6593 (if (gnus-gethash newsgroup gnus-newsrc-hashtb)
6594 (message "Ignore duplicated newsgroup: %s" newsgroup)
6597 ":" (buffer-substring (match-beginning 2) (match-end 2))))
6598 (setq ranges (buffer-substring (match-beginning 3) (match-end 3)))
6599 (setq read-list nil)
6600 (while (string-match "^[, \t]*\\([0-9-]+\\)" ranges)
6601 (setq subrange (substring ranges (match-beginning 1) (match-end 1)))
6602 (setq ranges (substring ranges (match-end 1)))
6603 (cond ((string-match "^\\([0-9]+\\)-\\([0-9]+\\)$" subrange)
6606 (cons (string-to-int
6608 (match-beginning 1) (match-end 1)))
6611 (match-beginning 2) (match-end 2))))
6613 ((string-match "^[0-9]+$" subrange)
6615 (cons (cons (string-to-int subrange)
6616 (string-to-int subrange))
6619 (ding) (message "Ignoring bogus lines of %s" newsgroup)
6622 (setq gnus-newsrc-assoc
6623 (cons (cons newsgroup (cons subscribe (nreverse read-list)))
6625 ;; Update gnus-newsrc-hashtb one by one.
6626 (gnus-sethash newsgroup (car gnus-newsrc-assoc) gnus-newsrc-hashtb)
6628 (setq gnus-newsrc-assoc (nreverse gnus-newsrc-assoc))
6631 (defun gnus-parse-n-options (options)
6632 "Parse -n NEWSGROUPS options and return a cons of YES and NO regexps."
6635 (yes-or-no nil) ;`!' or not.
6637 ;; Parse each newsgroup description such as "comp.all". Commas
6638 ;; and white spaces can be a newsgroup separator.
6640 (string-match "^[ \t\n,]*\\(!?\\)\\([^- \t\n,][^ \t\n,]*\\)" options)
6642 (substring options (match-beginning 1) (match-end 1)))
6646 (match-beginning 2) (match-end 2))))
6647 (setq options (substring options (match-end 2)))
6648 ;; Rewrite "all" to ".+" not ".*". ".+" requires at least one
6650 (while (string-match "\\(^\\|\\\\[.]\\)all\\(\\\\[.]\\|$\\)" newsgroup)
6652 (concat (substring newsgroup 0 (match-end 1))
6654 (substring newsgroup (match-beginning 2)))))
6656 (cond ((string-equal yes-or-no "!")
6657 (setq no (cons newsgroup no)))
6658 ((string-equal newsgroup ".+")) ;Ignore `all'.
6660 (setq yes (cons newsgroup yes))))
6662 ;; Make a cons of regexps from parsing result.
6663 ;; We have to append \(\.\|$\) to prevent matching substring of
6664 ;; newsgroup. For example, "jp.net" should not match with
6666 ;; Fixes for large regexp problems are from yonezu@nak.math.keio.ac.jp.
6669 (apply (function concat)
6673 (concat newsgroup "\\|")))
6675 (car yes) "\\)\\(\\.\\|$\\)"))
6678 (apply (function concat)
6682 (concat newsgroup "\\|")))
6684 (car no) "\\)\\(\\.\\|$\\)")))
6687 (defun gnus-save-newsrc-file ()
6688 "Save to .newsrc FILE."
6689 ;; Note: We cannot save .newsrc file if all newsgroups are removed
6690 ;; from the variable gnus-newsrc-assoc.
6691 (and (or gnus-newsrc-assoc gnus-killed-assoc)
6692 gnus-current-startup-file
6694 ;; A buffer containing .newsrc file may be deleted.
6695 (set-buffer (find-file-noselect gnus-current-startup-file))
6696 (if (not (buffer-modified-p))
6697 (message "(No changes need to be saved)")
6698 (message "Saving %s..." gnus-current-startup-file)
6699 (let ((make-backup-files t)
6700 (version-control nil)
6701 (require-final-newline t)) ;Don't ask even if requested.
6702 ;; Make backup file of master newsrc.
6703 ;; You can stop or change version control of backup file.
6704 ;; Suggested by jason@violet.berkeley.edu.
6705 (run-hooks 'gnus-save-newsrc-hook)
6707 ;; Quickly loadable .newsrc.
6708 (set-buffer (get-buffer-create " *GNUS-newsrc*"))
6709 (buffer-flush-undo (current-buffer))
6711 (gnus-gnus-to-quick-newsrc-format)
6712 (let ((make-backup-files nil)
6713 (version-control nil)
6714 (require-final-newline t)) ;Don't ask even if requested.
6715 (write-file (concat gnus-current-startup-file ".el")))
6716 (kill-buffer (current-buffer))
6717 (message "Saving %s... Done" gnus-current-startup-file)
6721 (defun gnus-update-newsrc-buffer (group &optional delete next)
6722 "Incrementally update .newsrc buffer about GROUP.
6723 If optional 1st argument DELETE is non-nil, delete the group.
6724 If optional 2nd argument NEXT is non-nil, inserted before it."
6726 ;; Taking account of the killed startup file.
6727 ;; Suggested by tale@pawl.rpi.edu.
6728 (set-buffer (or (get-file-buffer gnus-current-startup-file)
6729 (find-file-noselect gnus-current-startup-file)))
6730 ;; Options line continuation lines must be also considered here.
6731 ;; Before supporting continuation lines, " newsgroup ! 1-5" was
6732 ;; okay, but now it is invalid. It should be "newsgroup! 1-5".
6734 (case-fold-search nil) ;Should NOT ignore case.
6735 (buffer-read-only nil)) ;May be not modifiable.
6736 ;; Delete ALL entries which match for GROUP.
6737 (goto-char (point-min))
6738 (while (re-search-forward
6739 (concat "^" (regexp-quote group) "[:!]") nil t)
6741 (delete-region (point) (progn (forward-line 1) (point)))
6742 (setq deleted t) ;Old entry is deleted.
6746 ;; Insert group entry.
6747 (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
6750 ;; Find insertion point.
6751 (cond (deleted nil) ;Insert here.
6752 ((and (stringp next)
6754 (goto-char (point-min))
6756 (concat "^" (regexp-quote next) "[:!]") nil t)))
6757 (beginning-of-line))
6759 (goto-char (point-max))
6762 ;; Insert after options line.
6763 (if (looking-at "^[ \t]*options\\([ \t]\\|$\\)")
6766 ;; Skip continuation lines.
6767 (while (and (not (eobp))
6768 (looking-at "^[ \t]+"))
6770 (insert group ;Group name
6771 (if (nth 1 newsrc) ": " "! ")) ;Subscribed?
6772 (gnus-ranges-to-newsrc-format (nthcdr 2 newsrc)) ;Read articles
6777 (defun gnus-gnus-to-quick-newsrc-format ()
6778 "Insert GNUS variables such as gnus-newsrc-assoc in lisp format."
6779 (insert ";; GNUS internal format of .newsrc.\n")
6780 (insert ";; Touch .newsrc instead if you think to remove this file.\n")
6781 (let ((variable nil)
6782 (variables gnus-variable-list)
6783 ;; Temporary rebind to make changes
6784 ;; gnus-check-killed-newsgroups in invisible.
6785 (gnus-killed-assoc gnus-killed-assoc)
6786 (gnus-killed-hashtb gnus-killed-hashtb))
6787 ;; Remove duplicated or unsubscribed newsgroups in
6788 ;; gnus-killed-assoc (and gnus-killed-hashtb).
6789 (gnus-check-killed-newsgroups)
6790 ;; Then, insert lisp expressions.
6792 (setq variable (car variables))
6793 (and (boundp variable)
6794 (symbol-value variable)
6795 (insert "(setq " (symbol-name variable) " '"
6796 (prin1-to-string (symbol-value variable))
6798 (setq variables (cdr variables)))
6801 (defun gnus-ranges-to-newsrc-format (ranges)
6802 "Insert ranges of read articles."
6803 (let ((range nil)) ;Range is a pair of BEGIN and END.
6805 (setq range (car ranges))
6806 (setq ranges (cdr ranges))
6807 (cond ((= (car range) (cdr range))
6808 (if (= (car range) 0)
6809 (setq ranges nil) ;No unread articles.
6810 (insert (int-to-string (car range)))
6811 (if ranges (insert ","))
6814 (insert (int-to-string (car range))
6816 (int-to-string (cdr range)))
6817 (if ranges (insert ","))
6821 (defun gnus-compress-sequence (numbers)
6822 "Convert list of sorted numbers to ranges."
6823 (let* ((numbers (sort (copy-sequence numbers) (function <)))
6824 (first (car numbers))
6825 (last (car numbers))
6828 (cond ((= last (car numbers)) nil) ;Omit duplicated number
6829 ((= (1+ last) (car numbers)) ;Still in sequence
6830 (setq last (car numbers)))
6831 (t ;End of one sequence
6832 (setq result (cons (cons first last) result))
6833 (setq first (car numbers))
6834 (setq last (car numbers)))
6836 (setq numbers (cdr numbers))
6838 (nreverse (cons (cons first last) result))
6841 (defun gnus-uncompress-sequence (ranges)
6842 "Expand compressed format of sequence."
6847 (setq first (car (car ranges)))
6848 (setq last (cdr (car ranges)))
6849 (while (< first last)
6850 (setq result (cons first result))
6851 (setq first (1+ first)))
6852 (setq result (cons first result))
6853 (setq ranges (cdr ranges))
6858 (defun gnus-number-of-articles (range)
6859 "Compute number of articles from RANGE `((beg1 . end1) (beg2 . end2) ...)'."
6862 (if (/= (cdr (car range)) 0)
6863 ;; If end1 is 0, it must be skipped. Usually no articles in
6865 (setq count (+ count 1 (- (cdr (car range)) (car (car range))))))
6866 (setq range (cdr range))
6871 (defun gnus-difference-of-range (src obj)
6872 "Compute (SRC - OBJ) on range.
6873 Range of SRC is expressed as `(beg . end)'.
6874 Range of OBJ is expressed as `((beg1 . end1) (beg2 . end2) ...)."
6875 (let ((beg (car src))
6877 (range nil)) ;This is result.
6879 (while (and src obj)
6880 (let ((beg1 (car (car obj)))
6881 (end1 (cdr (car obj))))
6883 (setq obj nil)) ;Terminate loop
6885 (setq range (cons (cons beg (min (1- beg1) end)) range))
6886 (setq beg (1+ end1)))
6888 (setq beg (max beg (1+ end1))))
6890 (setq obj (cdr obj)) ;Next OBJ
6893 (if (and src (<= beg end))
6894 (setq range (cons (cons beg end) range)))
6901 (defun gnus-read-distributions-file ()
6902 "Get distributions file from NNTP server (NNTP2 functionality)."
6903 ;; Make sure a connection to NNTP server is alive.
6904 (gnus-start-news-server)
6905 (message "Reading distributions file...")
6906 (setq gnus-distribution-list nil)
6907 (if (gnus-request-list-distributions)
6909 (set-buffer nntp-server-buffer)
6910 (gnus-distributions-to-gnus-format)
6911 (message "Reading distributions file... done"))
6912 ;; It's not a fatal error.
6913 ;;(error "Cannot read distributions file from NNTP server.")
6915 ;; Merge with user supplied default distributions.
6916 (let ((defaults (reverse gnus-local-distributions))
6919 (setq dist (assoc (car defaults) gnus-distribution-list))
6921 (setq gnus-distribution-list
6922 (delq dist gnus-distribution-list)))
6923 (setq gnus-distribution-list
6924 (cons (list (car defaults)) gnus-distribution-list))
6925 (setq defaults (cdr defaults))
6928 (defun gnus-distributions-to-gnus-format ()
6929 "Convert distributions file format to internal format."
6930 (setq gnus-distribution-list nil)
6931 (goto-char (point-min))
6932 (while (re-search-forward "^\\([^ \t\n]+\\).*$" nil t)
6933 (setq gnus-distribution-list
6934 (cons (list (buffer-substring (match-beginning 1) (match-end 1)))
6935 gnus-distribution-list)))
6936 (setq gnus-distribution-list
6937 (nreverse gnus-distribution-list)))
6939 ;; Some older version of GNU Emacs does not support function
6940 ;; `file-newer-than-file-p'.
6942 (or (fboundp 'file-newer-than-file-p)
6943 (defun file-newer-than-file-p (file1 file2)
6944 "Return t if file FILE1 is newer than file FILE2.
6945 If FILE1 does not exist, the answer is nil;
6946 otherwise, if FILE2 does not exist, the answer is t."
6947 (let ((mod1 (nth 5 (file-attributes file1)))
6948 (mod2 (nth 5 (file-attributes file2))))
6949 (cond ((not (file-exists-p file1)) nil)
6950 ((not (file-exists-p file2)) t)
6952 (or (< (car mod2) (car mod1))
6953 (and (= (car mod2) (car mod1))
6954 (<= (nth 1 mod2) (nth 1 mod1)))))
6959 ;;eval: (put 'gnus-eval-in-buffer-window 'lisp-indent-hook 1)
6962 ;;; gnus.el ends here