*** empty log message ***
[emacs.git] / lisp / gnus.el
blob98d8c7f54d2e7c9e0966c39a25dc992fd64a5024
1 ;;; gnus.el --- GNUS: an NNTP-based News Reader for GNU Emacs
3 ;; Copyright (C) 1987, 1988, 1989 Fujitsu Laboratories LTD.
4 ;; Copyright (C) 1987, 1988, 1989, 1990 Masanobu UMEDA
5 ;; $Header: gnus.el,v 3.13 90/03/23 13:24:27 umerin Locked $
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is distributed in the hope that it will be useful,
10 ;; but WITHOUT ANY WARRANTY. No author or distributor
11 ;; accepts responsibility to anyone for the consequences of using it
12 ;; or for whether it serves any particular purpose or works at all,
13 ;; unless he says so in writing. Refer to the GNU Emacs General Public
14 ;; License for full details.
16 ;; Everyone is granted permission to copy, modify and redistribute
17 ;; GNU Emacs, but only under the conditions described in the
18 ;; GNU Emacs General Public License. A copy of this license is
19 ;; supposed to have been given to you along with GNU Emacs so you
20 ;; can know your rights and responsibilities. It should be in a
21 ;; file named COPYING. Among other things, the copyright notice
22 ;; and this notice must be preserved on all copies.
24 ;; GNUS Mailing List:
25 ;; There are two mailing lists for GNUS lovers in the world:
27 ;; info-gnus@flab.fujitsu.co.jp, and
28 ;; info-gnus-english@tut.cis.ohio-state.edu.
30 ;; They are intended to exchange useful information about GNUS, such
31 ;; as bug fixes, useful hooks, and extensions. The major difference
32 ;; between the lists is what the official language is. Both Japanese
33 ;; and English are available in info-gnus, while English is only
34 ;; available in info-gnus-english. There is no need to subscribe to
35 ;; info-gnus if you cannot read Japanese messages, because most of the
36 ;; discussion and important announcements will be sent to
37 ;; info-gnus-english. Moreover, if you can read gnu.emacs.gnus
38 ;; newsgroup of USENET, you need not, either. info-gnus-english and
39 ;; gnu.emacs.gnus are linked each other.
41 ;; Please send subscription request to:
43 ;; info-gnus-request@flab.fujitsu.co.jp, or
44 ;; info-gnus-english-request@cis.ohio-state.edu
46 ;; TO DO:
47 ;; (1) Incremental update of active info.
48 ;; (2) GNUS own poster.
49 ;; (3) Multi-GNUS (Talking to many hosts same time).
50 ;; (4) Asynchronous transmission of large messages.
52 (require 'nntp)
53 (require 'mail-utils)
55 (defvar gnus-nntp-server (or (getenv "NNTPSERVER") gnus-default-nntp-server)
56 "The name of the host running NNTP server.
57 If it is a string such as `:DIRECTORY', the user's private DIRECTORY
58 is used as a news spool.
59 Initialized from the NNTPSERVER environment variable.")
61 (defvar gnus-signature-file "~/.signature"
62 "*Your .signature file. Use `.signature-DISTRIBUTION' instead if exists.")
64 (defvar gnus-use-cross-reference t
65 "Specifies what to do with cross references (Xref: field).
66 If nil, ignore cross references. If t, mark articles as read in subscribed
67 newsgroups. Otherwise, mark articles as read in all newsgroups.")
69 (defvar gnus-use-followup-to t
70 "*Specifies what to do with Followup-To: field.
71 If nil, ignore followup-to: field. If t, use its value execpt for
72 `poster'. Otherewise, if not nil nor t, always use its value.")
74 (defvar gnus-large-newsgroup 50
75 "*The number of articles which indicates a large newsgroup.
76 If the number of articles in a newsgroup is greater than the value,
77 confirmation is required for selecting the newsgroup.")
79 (defvar gnus-author-copy (getenv "AUTHORCOPY")
80 "*Filename for saving a copy of an article posted using FCC: field.
81 Initialized from the AUTHORCOPY environment variable.
83 Articles are saved using a function specified by the the variable
84 `gnus-author-copy-saver' (`rmail-output' is the default) if a file name
85 is given. Instead, if the first character of the name is `|', the
86 contents of the article is piped out to the named program. It is
87 possible to save an article in an MH folder as follows:
89 (setq gnus-author-copy \"|/usr/local/lib/mh/rcvstore +Article\")")
91 (defvar gnus-author-copy-saver (function rmail-output)
92 "*A function called with a file name to save an author copy to.
93 The default function is `rmail-output' which saves in Unix mailbox format.")
95 (defvar gnus-use-long-file-name
96 (not (memq system-type '(usg-unix-v xenix)))
97 "Non-nil means that a newsgroup name is used as a default file name
98 to save articles to. If nil, the directory form of a newsgroup is
99 used instead.")
101 (defvar gnus-article-save-directory (getenv "SAVEDIR")
102 "*The directory in which to save articles; defaults to ~/News.
103 Initialized from the SAVEDIR environment variable.")
105 (defvar gnus-default-article-saver (function gnus-Subject-save-in-rmail)
106 "A function used to save articles in your favorite format.
107 The function must be interactively callable (in other words, it must
108 be an Emacs command).
110 GNUS provides the following functions:
111 gnus-Subject-save-in-rmail (in Rmail format)
112 gnus-Subject-save-in-mail (in Unix mail format)
113 gnus-Subject-save-in-folder (in an MH folder)
114 gnus-Subject-save-in-file (in article format).")
116 (defvar gnus-rmail-save-name (function gnus-plain-save-name)
117 "A function generating a file name to save articles in Rmail format.
118 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
120 (defvar gnus-mail-save-name (function gnus-plain-save-name)
121 "A function generating a file name to save articles in Unix mail format.
122 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
124 (defvar gnus-folder-save-name (function gnus-folder-save-name)
125 "A function generating a file name to save articles in MH folder.
126 The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER.")
128 (defvar gnus-file-save-name (function gnus-numeric-save-name)
129 "A function generating a file name to save articles in article format.
130 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
132 (defvar gnus-kill-file-name "KILL"
133 "File name of a KILL file.")
135 (defvar gnus-default-distribution "local"
136 "*Use this value as distribution if no distribution is specified.")
138 (defvar gnus-novice-user t
139 "*Non-nil means that you are a novice to USENET.
140 If non-nil, verbose messages may be displayed or your confirmation
141 may be required.")
143 (defvar gnus-interactive-post t
144 "*Newsgroup, subject, and distribution will be asked for if non-nil.")
146 (defvar gnus-user-login-name nil
147 "*The login name of the user.
148 Uses USER and LOGNAME environment variables if undefined.")
150 (defvar gnus-user-full-name nil
151 "*The full name of the user.
152 Uses from the NAME environment variable if undefined.")
154 (defvar gnus-show-threads t
155 "*Show conversation threads in Subject Mode if non-nil.")
157 (defvar gnus-thread-hide-subject t
158 "*Non-nil means hide subjects for thread subtrees.")
160 (defvar gnus-thread-hide-subtree nil
161 "*Non-nil means hide thread subtrees initially.
162 If non-nil, you have to run the command `gnus-Subject-show-thread' by
163 hand or by using `gnus-Select-article-hook' to show hidden threads.")
165 (defvar gnus-thread-hide-killed t
166 "*Non-nil means hide killed thread subtrees automatically.")
168 (defvar gnus-thread-ignore-subject nil
169 "*Don't take care of subject differences, but only references if non-nil.
170 If it is non-nil, some commands work with subjects do not work properly.")
172 (defvar gnus-thread-indent-level 4
173 "Indentation of thread subtrees.")
175 (defvar gnus-ignored-headers
176 "^Path:\\|^Posting-Version:\\|^Article-I.D.:\\|^Expires:\\|^Date-Received:\\|^References:\\|^Control:\\|^Xref:\\|^Lines:\\|^Posted:\\|^Relay-Version:\\|^Message-ID:\\|^Nf-ID:\\|^Nf-From:\\|^Approved:\\|^Sender:\\|^In-Reply-To:"
177 "Regexp matching headers not to display in messages.")
179 (defvar gnus-show-all-headers nil
180 "*Show all headers of an article if non-nil.")
182 (defvar gnus-save-all-headers nil
183 "*Save all headers of an article if non-nil.")
185 (defvar gnus-optional-headers (function gnus-optional-lines-and-from)
186 "A function generating a optional string displayed in GNUS Subject
187 mode buffer. The function is called with an article HEADER. The
188 result must be a string excluding `[' and `]'.")
190 (defvar gnus-auto-extend-newsgroup t
191 "*Extend visible articles to forward and backward if non-nil.")
193 (defvar gnus-auto-select-first t
194 "*Select the first unread article automagically if non-nil.
195 If you want to prevent automatic selection of the first unread article
196 in some newsgroups, set the variable to nil in `gnus-Select-group-hook'
197 or `gnus-Apply-kill-hook'.")
199 (defvar gnus-auto-select-next t
200 "*Select the next newsgroup automagically if non-nil.
201 If the value is t and the next newsgroup is empty, GNUS will exit
202 Subject mode and go back to Group mode. If the value is neither nil
203 nor t, GNUS will select the following unread newsgroup. Especially, if
204 the value is the symbol `quietly', the next unread newsgroup will be
205 selected without any confirmations.")
207 (defvar gnus-auto-select-same nil
208 "*Select the next article with the same subject automagically if non-nil.")
210 (defvar gnus-auto-center-subject t
211 "*Always center the current subject in GNUS Subject mode window if non-nil.")
213 (defvar gnus-break-pages t
214 "*Break an article into pages if non-nil.
215 Page delimiter is specified by the variable `gnus-page-delimiter'.")
217 (defvar gnus-page-delimiter "^\^L"
218 "*Regexp describing line-beginnings that separate pages of news article.")
220 (defvar gnus-digest-show-summary t
221 "*Show a summary of undigestified messages if non-nil.")
223 (defvar gnus-digest-separator "^Subject:[ \t]"
224 "*Regexp that separates messages in a digest article.")
226 (defvar gnus-use-full-window t
227 "*Non-nil means to take up the entire screen of Emacs.")
229 (defvar gnus-window-configuration
230 '((SelectNewsgroup (0 1 0))
231 (ExitNewsgroup (1 0 0))
232 (SelectArticle (0 3 10))
233 (ExpandSubject (0 1 0)))
234 "Specify window configurations for each action.
235 The format of the variable is a list of (ACTION (G S A)), where
236 G, S, and A are the relative height of Group, Subject, and Article
237 windows, respectively. ACTION is `SelectNewsgroup', `ExitNewsgroup',
238 `SelectArticle', or `ExpandSubject'.")
240 (defvar gnus-mail-reply-method
241 (function gnus-mail-reply-using-mail)
242 "A function to compose reply mail.
243 The function `gnus-mail-reply-using-mail' uses usual the sendmail mail
244 program. The function `gnus-mail-reply-using-mhe' uses the mh-e mail
245 program. You can use yet another program by customizing this variable.")
247 (defvar gnus-mail-other-window-method
248 (function gnus-mail-other-window-using-mail)
249 "A function to compose mail in other window.
250 The function `gnus-mail-other-window-using-mail' uses usual sendmail
251 mail program. The function `gnus-mail-other-window-using-mhe' uses mh-e
252 mail program. You can use yet another program by customizing this variable.")
254 (defvar gnus-subscribe-newsgroup-method
255 (function
256 (lambda (newsgroup)
257 (gnus-subscribe-newsgroup newsgroup
258 (car (car gnus-newsrc-assoc)))))
259 "A function called with a newsgroup name when it is created.")
261 (defvar gnus-Group-mode-hook nil
262 "A hook for GNUS Group Mode.")
264 (defvar gnus-Subject-mode-hook nil
265 "A hook for GNUS Subject Mode.")
267 (defvar gnus-Article-mode-hook nil
268 "A hook for GNUS Article Mode.")
270 (defvar gnus-Kill-file-mode-hook nil
271 "A hook for GNUS KILL File Mode.")
273 (defvar gnus-Open-server-hook nil
274 "A hook called just before opening connection to news server.")
276 (defvar gnus-Startup-hook nil
277 "A hook called at start up time.
278 This hook is called after GNUS is connected to the NNTP server.
279 So, it is possible to change the behavior of GNUS according to the
280 selected NNTP server.")
282 (defvar gnus-Group-prepare-hook nil
283 "A hook called after newsgroup list is created in the Newsgroup buffer.
284 If you want to modify the Newsgroup buffer, you can use this hook.")
286 (defvar gnus-Subject-prepare-hook nil
287 "A hook called after subject list is created in the Subject buffer.
288 If you want to modify the Subject buffer, you can use this hook.")
290 (defvar gnus-Article-prepare-hook nil
291 "A hook called after an article is prepared in the Article buffer.
292 If you want to run a special decoding program like nkf, use this hook.")
294 (defvar gnus-Select-group-hook nil
295 "A hook called when a newsgroup is selected.
296 If you want to sort Subject buffer by date and then by subject, you
297 can use the following hook:
299 (setq gnus-Select-group-hook
300 '(lambda ()
301 ;; First of all, sort by date.
302 (gnus-sort-headers
303 '(lambda (a b)
304 (gnus-date-lessp (gnus-header-date a)
305 (gnus-header-date b))))
306 ;; Then sort by subject string ignoring `Re:'.
307 ;; If case-fold-search is non-nil, case of letters is ignored.
308 (gnus-sort-headers
309 '(lambda (a b)
310 (gnus-string-lessp
311 (gnus-simplify-subject (gnus-header-subject a) 're)
312 (gnus-simplify-subject (gnus-header-subject b) 're)
313 )))))
315 If you'd like to simplify subjects like the `gnus-Subject-next-same-subject'
316 command does, you can use the following hook:
318 (setq gnus-Select-group-hook
319 '(lambda ()
320 (mapcar (function
321 (lambda (header)
322 (nntp-set-header-subject
323 header
324 (gnus-simplify-subject
325 (gnus-header-subject header) 're-only))))
326 gnus-newsgroup-headers)))
328 In some newsgroups author name is meaningless. It is possible to
329 prevent listing author names in the GNUS Subject buffer as follows:
331 (setq gnus-Select-group-hook
332 '(lambda ()
333 (cond ((string-equal \"comp.sources.unix\" gnus-newsgroup-name)
334 (setq gnus-optional-headers
335 (function gnus-optional-lines)))
337 (setq gnus-optional-headers
338 (function gnus-optional-lines-and-from))))))")
340 (defvar gnus-Select-article-hook
341 (function (lambda () (gnus-Subject-show-thread)))
342 "Hook called when an article is selected.
343 The default hook automatically shows conversation thread subtrees
344 of the selected article as follows:
346 (setq gnus-Select-article-hook
347 '(lambda ()
348 (gnus-Subject-show-thread)))
350 If you'd like to run RMAIL on a digest article automagically, you can
351 use the following hook:
353 (setq gnus-Select-article-hook
354 '(lambda ()
355 (gnus-Subject-show-thread)
356 (cond ((string-equal \"comp.sys.sun\" gnus-newsgroup-name)
357 (gnus-Subject-rmail-digest))
358 ((and (string-equal \"comp.text\" gnus-newsgroup-name)
359 (string-match \"^TeXhax Digest\"
360 (gnus-header-subject gnus-current-headers)))
361 (gnus-Subject-rmail-digest)
362 ))))")
364 (defvar gnus-Select-digest-hook
365 (function
366 (lambda ()
367 ;; Reply-To: is required by `undigestify-rmail-message'.
368 (or (mail-position-on-field "Reply-to" t)
369 (progn
370 (mail-position-on-field "Reply-to")
371 (insert (gnus-fetch-field "From"))))))
372 "A hook called when reading digest messages using Rmail.
373 This hook can be used to modify incomplete digest articles as follows
374 (this is the default):
376 (setq gnus-Select-digest-hook
377 '(lambda ()
378 ;; Reply-To: is required by `undigestify-rmail-message'.
379 (or (mail-position-on-field \"Reply-to\" t)
380 (progn
381 (mail-position-on-field \"Reply-to\")
382 (insert (gnus-fetch-field \"From\"))))))")
384 (defvar gnus-Rmail-digest-hook nil
385 "A hook called when reading digest messages using Rmail.
386 This hook is intended to customize Rmail mode for reading digest articles.")
388 (defvar gnus-Apply-kill-hook (function gnus-apply-kill-file)
389 "A hook called when a newsgroup is selected and subject list is prepared.
390 This hook is intended to apply a KILL file to the selected newsgroup.
391 The function `gnus-apply-kill-file' is called defaultly.
393 Since a general KILL file is too heavy to use for only a few
394 newsgroups, we recommend you use a lighter hook function. For
395 example, if you'd like to apply a KILL file to articles which contains
396 a string `rmgroup' in subject in newsgroup `control', you can use the
397 following hook:
399 (setq gnus-Apply-kill-hook
400 '(lambda ()
401 (cond ((string-match \"control\" gnus-newsgroup-name)
402 (gnus-kill \"Subject\" \"rmgroup\")
403 (gnus-expunge \"X\")))))")
405 (defvar gnus-Mark-article-hook
406 (function
407 (lambda ()
408 (or (memq gnus-current-article gnus-newsgroup-marked)
409 (gnus-Subject-mark-as-read gnus-current-article))
410 (gnus-Subject-set-current-mark "+")))
411 "A hook called when an article is selected for the first time.
412 The hook is intended to mark an article as read when it is selected.
413 If you'd like to mark as unread (-) instead, use the following hook:
415 (setq gnus-Mark-article-hook
416 '(lambda ()
417 (gnus-Subject-mark-as-unread gnus-current-article)
418 (gnus-Subject-set-current-mark \"+\")))")
420 (defvar gnus-Inews-article-hook nil
421 "A hook called before posting an article.
422 If you'd like to run a special encoding program, use this hook.")
424 (defvar gnus-Exit-group-hook nil
425 "A hook called when exiting (not quitting) Subject mode.
426 If your machine is so slow that exiting from Subject mode takes a
427 long time, set the variable `gnus-newsgroup-headers' to nil. This
428 inhibits marking articles as read using cross-reference information.")
430 (defvar gnus-Suspend-gnus-hook nil
431 "A hook called when suspending (not exiting) GNUS.")
433 (defvar gnus-Exit-gnus-hook nil
434 "A hook called when exiting (not suspending) GNUS.")
436 (defvar gnus-Save-newsrc-hook nil
437 "A hook called when saving the newsrc file.
438 This hook is called before saving .newsrc file.")
440 (defvar gnus-your-domain nil
441 "*Your domain name without your host name like: \"stars.flab.Fujitsu.CO.JP\"
442 The environment variable DOMAINNAME is used instead if defined. If
443 the function `system-name' returns the full internet name, there is no
444 need to define this variable.")
446 (defvar gnus-your-organization nil
447 "*Your organization like: \"Fujitsu Laboratories Ltd., Kawasaki, Japan.\"
448 The `ORGANIZATION' environment variable is used instead if defined.")
450 (defvar gnus-use-generic-from nil
451 "*If nil, prepend local host name to the defined domain in the From:
452 field; if stringp, use this; if non-nil, strip of the local host name.")
454 (defvar gnus-use-generic-path nil
455 "*If nil, use the NNTP server name in the Path: field; if stringp,
456 use this; if non-nil, use no host name (user name only)")
458 ;; Internal variables.
460 (defconst gnus-version "GNUS 3.13"
461 "Version numbers of this version of GNUS.")
463 (defvar gnus-Info-nodes
464 '((gnus-Group-mode . "(gnus)Newsgroup Commands")
465 (gnus-Subject-mode . "(gnus)Subject Commands")
466 (gnus-Article-mode . "(gnus)Article Commands")
467 (gnus-Kill-file-mode . "(gnus)KILL File")
468 (gnus-Browse-killed-mode . "(gnus)Maintenance"))
469 "Assoc list of major modes and related Info nodes.")
471 (defvar gnus-access-methods
472 '((nntp
473 (gnus-retrieve-headers . nntp-retrieve-headers)
474 (gnus-open-server . nntp-open-server)
475 (gnus-close-server . nntp-close-server)
476 (gnus-server-opened . nntp-server-opened)
477 (gnus-status-message . nntp-status-message)
478 (gnus-request-article . nntp-request-article)
479 (gnus-request-group . nntp-request-group)
480 (gnus-request-list . nntp-request-list)
481 (gnus-request-post . nntp-request-post))
482 (nnspool
483 (gnus-retrieve-headers . nnspool-retrieve-headers)
484 (gnus-open-server . nnspool-open-server)
485 (gnus-close-server . nnspool-close-server)
486 (gnus-server-opened . nnspool-server-opened)
487 (gnus-status-message . nnspool-status-message)
488 (gnus-request-article . nnspool-request-article)
489 (gnus-request-group . nnspool-request-group)
490 (gnus-request-list . nnspool-request-list)
491 (gnus-request-post . nnspool-request-post))
492 (mhspool
493 (gnus-retrieve-headers . mhspool-retrieve-headers)
494 (gnus-open-server . mhspool-open-server)
495 (gnus-close-server . mhspool-close-server)
496 (gnus-server-opened . mhspool-server-opened)
497 (gnus-status-message . mhspool-status-message)
498 (gnus-request-article . mhspool-request-article)
499 (gnus-request-group . mhspool-request-group)
500 (gnus-request-list . mhspool-request-list)
501 (gnus-request-post . mhspool-request-post)))
502 "Access method for NNTP, nnspool, and mhspool.")
504 (defvar gnus-Group-buffer "*Newsgroup*")
505 (defvar gnus-Subject-buffer "*Subject*")
506 (defvar gnus-Article-buffer "*Article*")
507 (defvar gnus-Digest-buffer "GNUS Digest")
508 (defvar gnus-Digest-summary-buffer "GNUS Digest-summary")
510 (defvar gnus-buffer-list
511 (list gnus-Group-buffer gnus-Subject-buffer gnus-Article-buffer
512 gnus-Digest-buffer gnus-Digest-summary-buffer)
513 "GNUS buffer names which should be killed when exiting.")
515 (defvar gnus-variable-list
516 '(gnus-newsrc-options
517 gnus-newsrc-options-n-yes gnus-newsrc-options-n-no
518 gnus-newsrc-assoc gnus-killed-assoc gnus-marked-assoc)
519 "GNUS variables saved in the quick startup file.")
521 (defvar gnus-overload-functions
522 '((news-inews gnus-inews-news "rnewspost")
523 (caesar-region gnus-caesar-region "rnews"))
524 "Functions overloaded by gnus.
525 It is a list of `(original overload &optional file)'.")
527 (defvar gnus-newsrc-options nil
528 "Options line in the .newsrc file.")
530 (defvar gnus-newsrc-options-n-yes nil
531 "Regexp representing subscribed newsgroups.")
533 (defvar gnus-newsrc-options-n-no nil
534 "Regexp representing unsubscribed newsgroups.")
536 (defvar gnus-newsrc-assoc nil
537 "Assoc list of read articles.")
539 (defvar gnus-killed-assoc nil
540 "Assoc list of newsgroups removed from `gnus-newsrc-assoc'.")
542 (defvar gnus-marked-assoc nil
543 "Assoc list of articles marked as unread.")
545 (defvar gnus-unread-hashtb nil
546 "Hashtable of unread articles.")
548 (defvar gnus-active-hashtb nil
549 "Hashtable of active articles.")
551 (defvar gnus-octive-hashtb nil
552 "Hashtable of OLD active articles.")
554 (defvar gnus-current-startup-file nil
555 "Startup file for the current host.")
557 (defvar gnus-last-search-regexp nil
558 "Default regexp for article search command.")
560 (defvar gnus-last-shell-command nil
561 "Default shell command on article.")
563 (defvar gnus-have-all-newsgroups nil)
565 (defvar gnus-newsgroup-name nil)
566 (defvar gnus-newsgroup-begin nil)
567 (defvar gnus-newsgroup-end nil)
568 (defvar gnus-newsgroup-last-rmail nil)
569 (defvar gnus-newsgroup-last-mail nil)
570 (defvar gnus-newsgroup-last-folder nil)
571 (defvar gnus-newsgroup-last-file nil)
573 (defvar gnus-newsgroup-unreads nil
574 "List of unread articles in the current newsgroup.")
576 (defvar gnus-newsgroup-unselected nil
577 "List of unselected unread articles in the current newsgroup.")
579 (defvar gnus-newsgroup-marked nil
580 "List of marked articles in the current newsgroup (a subset of unread art).")
582 (defvar gnus-newsgroup-headers nil
583 "List of article headers in the current newsgroup.")
585 (defvar gnus-current-article nil)
586 (defvar gnus-current-headers nil)
587 (defvar gnus-current-history nil)
588 (defvar gnus-have-all-headers nil)
589 (defvar gnus-last-article nil)
590 (defvar gnus-current-kill-article nil)
592 ;; Save window configuration.
593 (defvar gnus-winconf-kill-file nil)
595 (defvar gnus-Group-mode-map nil)
596 (defvar gnus-Subject-mode-map nil)
597 (defvar gnus-Article-mode-map nil)
598 (defvar gnus-Kill-file-mode-map nil)
600 (defvar rmail-last-file (expand-file-name "~/XMBOX"))
601 (defvar rmail-last-rmail-file (expand-file-name "~/XNEWS"))
603 ;; Define GNUS Subsystems.
604 (autoload 'gnus-Group-post-news "gnuspost"
605 "Post an article." t)
606 (autoload 'gnus-Subject-post-news "gnuspost"
607 "Post an article." t)
608 (autoload 'gnus-Subject-post-reply "gnuspost"
609 "Post a reply article." t)
610 (autoload 'gnus-Subject-post-reply-with-original "gnuspost"
611 "Post a reply article with original article." t)
612 (autoload 'gnus-Subject-cancel-article "gnuspost"
613 "Cancel an article you posted." t)
615 (autoload 'gnus-Subject-mail-reply "gnusmail"
616 "Reply mail to news author." t)
617 (autoload 'gnus-Subject-mail-reply-with-original "gnusmail"
618 "Reply mail to news author with original article." t)
619 (autoload 'gnus-Subject-mail-other-window "gnusmail"
620 "Compose mail in other window." t)
622 (autoload 'gnus-Group-kill-group "gnusmisc"
623 "Kill newsgroup on current line." t)
624 (autoload 'gnus-Group-yank-group "gnusmisc"
625 "Yank the last killed newsgroup on current line." t)
626 (autoload 'gnus-Browse-killed-groups "gnusmisc"
627 "Browse the killed newsgroups." t)
629 (autoload 'rmail-output "rmailout"
630 "Append this message to Unix mail file named FILE-NAME." t)
631 (autoload 'mail-position-on-field "sendmail")
632 (autoload 'mh-find-path "mh-e")
633 (autoload 'mh-prompt-for-folder "mh-e")
635 (put 'gnus-Group-mode 'mode-class 'special)
636 (put 'gnus-Subject-mode 'mode-class 'special)
637 (put 'gnus-Article-mode 'mode-class 'special)
640 ;;(put 'gnus-eval-in-buffer-window 'lisp-indent-function 1)
642 (defmacro gnus-eval-in-buffer-window (buffer &rest forms)
643 "Pop to BUFFER, evaluate FORMS, and then returns to original window."
644 (` (let ((GNUSStartBufferWindow (selected-window)))
645 (unwind-protect
646 (progn
647 (pop-to-buffer (, buffer))
648 (,@ forms))
649 (select-window GNUSStartBufferWindow)))))
651 (defmacro gnus-make-hashtable ()
652 '(make-abbrev-table))
654 (defmacro gnus-gethash (string hashtable)
655 "Get hash value of STRING in HASHTABLE."
656 ;;(` (symbol-value (abbrev-symbol (, string) (, hashtable))))
657 (` (abbrev-expansion (, string) (, hashtable))))
659 (defmacro gnus-sethash (string value hashtable)
660 "Set hash value. Arguments are STRING, VALUE, and HASHTABLE."
661 ;; We cannot use define-abbrev since it only accepts string as value.
662 (` (set (intern (, string) (, hashtable)) (, value))))
664 ;; Note: Macros defined here are also defined in nntp.el. I don't like
665 ;; to put them here, but many users got troubled with the old
666 ;; definitions in nntp.elc. These codes are NNTP 3.10 version.
668 (defmacro nntp-header-number (header)
669 "Return article number in HEADER."
670 (` (aref (, header) 0)))
672 (defmacro nntp-set-header-number (header number)
673 "Set article number of HEADER to NUMBER."
674 (` (aset (, header) 0 (, number))))
676 (defmacro nntp-header-subject (header)
677 "Return subject string in HEADER."
678 (` (aref (, header) 1)))
680 (defmacro nntp-set-header-subject (header subject)
681 "Set article subject of HEADER to SUBJECT."
682 (` (aset (, header) 1 (, subject))))
684 (defmacro nntp-header-from (header)
685 "Return author string in HEADER."
686 (` (aref (, header) 2)))
688 (defmacro nntp-set-header-from (header from)
689 "Set article author of HEADER to FROM."
690 (` (aset (, header) 2 (, from))))
692 (defmacro nntp-header-xref (header)
693 "Return xref string in HEADER."
694 (` (aref (, header) 3)))
696 (defmacro nntp-set-header-xref (header xref)
697 "Set article xref of HEADER to xref."
698 (` (aset (, header) 3 (, xref))))
700 (defmacro nntp-header-lines (header)
701 "Return lines in HEADER."
702 (` (aref (, header) 4)))
704 (defmacro nntp-set-header-lines (header lines)
705 "Set article lines of HEADER to LINES."
706 (` (aset (, header) 4 (, lines))))
708 (defmacro nntp-header-date (header)
709 "Return date in HEADER."
710 (` (aref (, header) 5)))
712 (defmacro nntp-set-header-date (header date)
713 "Set article date of HEADER to DATE."
714 (` (aset (, header) 5 (, date))))
716 (defmacro nntp-header-id (header)
717 "Return Id in HEADER."
718 (` (aref (, header) 6)))
720 (defmacro nntp-set-header-id (header id)
721 "Set article Id of HEADER to ID."
722 (` (aset (, header) 6 (, id))))
724 (defmacro nntp-header-references (header)
725 "Return references in HEADER."
726 (` (aref (, header) 7)))
728 (defmacro nntp-set-header-references (header ref)
729 "Set article references of HEADER to REF."
730 (` (aset (, header) 7 (, ref))))
734 ;;; GNUS Group Mode
737 (if gnus-Group-mode-map
739 (setq gnus-Group-mode-map (make-keymap))
740 (suppress-keymap gnus-Group-mode-map)
741 (define-key gnus-Group-mode-map " " 'gnus-Group-read-group)
742 (define-key gnus-Group-mode-map "=" 'gnus-Group-select-group)
743 (define-key gnus-Group-mode-map "j" 'gnus-Group-jump-to-group)
744 (define-key gnus-Group-mode-map "n" 'gnus-Group-next-unread-group)
745 (define-key gnus-Group-mode-map "p" 'gnus-Group-prev-unread-group)
746 (define-key gnus-Group-mode-map "\177" 'gnus-Group-prev-unread-group)
747 (define-key gnus-Group-mode-map "N" 'gnus-Group-next-group)
748 (define-key gnus-Group-mode-map "P" 'gnus-Group-prev-group)
749 (define-key gnus-Group-mode-map "\C-n" 'gnus-Group-next-group)
750 (define-key gnus-Group-mode-map "\C-p" 'gnus-Group-prev-group)
751 (define-key gnus-Group-mode-map "\r" 'next-line)
752 (define-key gnus-Group-mode-map "/" 'isearch-forward)
753 (define-key gnus-Group-mode-map "<" 'beginning-of-buffer)
754 (define-key gnus-Group-mode-map ">" 'end-of-buffer)
755 (define-key gnus-Group-mode-map "u" 'gnus-Group-unsubscribe-current-group)
756 (define-key gnus-Group-mode-map "U" 'gnus-Group-unsubscribe-group)
757 (define-key gnus-Group-mode-map "c" 'gnus-Group-catch-up)
758 (define-key gnus-Group-mode-map "C" 'gnus-Group-catch-up-all)
759 (define-key gnus-Group-mode-map "l" 'gnus-Group-list-groups)
760 (define-key gnus-Group-mode-map "L" 'gnus-Group-list-all-groups)
761 (define-key gnus-Group-mode-map "g" 'gnus-Group-get-new-news)
762 (define-key gnus-Group-mode-map "R" 'gnus-Group-restart)
763 (define-key gnus-Group-mode-map "b" 'gnus-Group-check-bogus-groups)
764 (define-key gnus-Group-mode-map "r" 'gnus-Group-restrict-groups)
765 (define-key gnus-Group-mode-map "a" 'gnus-Group-post-news)
766 (define-key gnus-Group-mode-map "\ek" 'gnus-Group-edit-local-kill)
767 (define-key gnus-Group-mode-map "\eK" 'gnus-Group-edit-global-kill)
768 (define-key gnus-Group-mode-map "\C-k" 'gnus-Group-kill-group)
769 (define-key gnus-Group-mode-map "\C-y" 'gnus-Group-yank-group)
770 (define-key gnus-Group-mode-map "\C-c\C-y" 'gnus-Browse-killed-groups)
771 (define-key gnus-Group-mode-map "V" 'gnus-version)
772 (define-key gnus-Group-mode-map "x" 'gnus-Group-force-update)
773 (define-key gnus-Group-mode-map "s" 'gnus-Group-force-update)
774 (define-key gnus-Group-mode-map "z" 'gnus-Group-suspend)
775 (define-key gnus-Group-mode-map "q" 'gnus-Group-exit)
776 (define-key gnus-Group-mode-map "Q" 'gnus-Group-quit)
777 (define-key gnus-Group-mode-map "?" 'gnus-Group-describe-briefly)
778 (define-key gnus-Group-mode-map "\C-c\C-i" 'gnus-Info-find-node))
780 (defun gnus-Group-mode ()
781 "Major mode for reading network news.
782 All normal editing commands are turned off.
783 Instead, these commands are available:
784 \\{gnus-Group-mode-map}
786 The name of the host running NNTP server is asked for if no default
787 host is specified. It is also possible to choose another NNTP server
788 even when the default server is defined by giving a prefix argument to
789 the command `\\[gnus]'.
791 If an NNTP server is preceded by a colon such as `:Mail', the user's
792 private directory `~/Mail' is used as a news spool. This makes it
793 possible to read mail stored in MH folders or articles saved by GNUS.
794 File names of mail or articles must consist of only numeric
795 characters. Otherwise, they are ignored.
797 If there is a file named `~/.newsrc-SERVER', it is used as the
798 startup file instead of standard one when talking to SERVER. It is
799 possible to talk to many hosts by using different startup files for
800 each.
802 Option `-n' of the options line in the startup file is recognized
803 properly the same as the Bnews system. For example, if the options
804 line is `options -n !talk talk.rumors', newsgroups under the `talk'
805 hierarchy except for `talk.rumors' are ignored while checking new
806 newsgroups.
808 If there is a file named `~/.signature-DISTRIBUTION', it is used as
809 signature file instead of standard one when posting a news in
810 DISTRIBUTION.
812 If an Info file generated from `gnus.texinfo' is installed, you can
813 read an appropriate Info node of the Info file according to the
814 current major mode of GNUS by \\[gnus-Info-find-node].
816 The variable `gnus-version', `nntp-version', `nnspool-version', and
817 `mhspool-version' have the version numbers of this version of gnus.el,
818 nntp.el, nnspool.el, and mhspoo.el, respectively.
820 User customizable variables:
821 gnus-nntp-server
822 Specifies the name of the host running the NNTP server. If its
823 value is a string such as `:DIRECTORY', the user's private
824 DIRECTORY is used as a news spool. The variable is initialized
825 from the NNTPSERVER environment variable.
827 gnus-nntp-service
828 Specifies a NNTP service name. It is usually \"nntp\" or 119. Nil
829 forces GNUS to use a local news spool if the variable
830 `gnus-nntp-server' is set to the local host name.
832 gnus-startup-file
833 Specifies a startup file (.newsrc). If there is a file named
834 `.newsrc-SERVER', it's used instead when talking to SERVER. I
835 recommend you to use the server specific file, if you'd like to
836 talk to many servers. Especially if you'd like to read your
837 private directory, the name of the file must be
838 `.newsrc-:DIRECTORY'.
840 gnus-signature-file
841 Specifies a signature file (.signature). If there is a file named
842 `.signature-DISTRIBUTION', it's used instead when posting an
843 article in DISTRIBUTION. Set the variable to nil to prevent
844 appending the file automatically. If you use an NNTP inews which
845 comes with the NNTP package, you may have to set the variable to
846 nil.
848 gnus-use-cross-reference
849 Specifies what to do with cross references (Xref: field). If it
850 is nil, cross references are ignored. If it is t, articles in
851 subscribed newsgroups are only marked as read. Otherwise, if it
852 is not nil nor t, articles in all newsgroups are marked as read.
854 gnus-use-followup-to
855 Specifies what to do with followup-to: field. If it is nil, its
856 value is ignored. If it is non-nil, its value is used as followup
857 newsgroups. Especially, if it is t and field value is `poster',
858 your confirmation is required.
860 gnus-author-copy
861 Specifies a file name to save a copy of article you posted using
862 FCC: field. If the first character of the value is `|', the
863 contents of the article is piped out to a program specified by the
864 rest of the value. The variable is initialized from the
865 AUTHORCOPY environment variable.
867 gnus-author-copy-saver
868 Specifies a function to save an author copy. The function is
869 called with a file name. The default function `rmail-output'
870 saves in Unix mail format.
872 gnus-kill-file-name
873 Use specified file name as a KILL file (default to `KILL').
875 gnus-novice-user
876 Non-nil means that you are a novice to USENET. If non-nil,
877 verbose messages may be displayed or your confirmations may be
878 required.
880 gnus-interactive-post
881 Non-nil means that newsgroup, subject and distribution are asked
882 for interactively when posting a new article.
884 gnus-use-full-window
885 Non-nil means to take up the entire screen of Emacs.
887 gnus-window-configuration
888 Specifies the configuration of Group, Subject, and Article
889 windows. It is a list of (ACTION (G S A)), where G, S, and A are
890 the relative height of Group, Subject, and Article windows,
891 respectively. ACTION is `SelectNewsgroup', `ExitNewsgroup',
892 `SelectArticle', or `ExpandSubject'.
894 gnus-subscribe-newsgroup-method
895 Specifies a function called with a newsgroup name when new
896 newsgroup is found. The default definition adds new newsgroup at
897 the beginning of other newsgroups.
899 Various hooks for customization:
900 gnus-Group-mode-hook
901 Entry to this mode calls the value with no arguments, if that
902 value is non-nil. This hook is called before GNUS is connected to
903 the NNTP server. So, you can change or define the NNTP server in
904 this hook.
906 gnus-Startup-hook
907 Called with no arguments after the NNTP server is selected. It is
908 possible to change the behavior of GNUS or initialize the
909 variables according to the selected NNTP server.
911 gnus-Group-prepare-hook
912 Called with no arguments after a newsgroup list is created in the
913 Newsgroup buffer, if that value is non-nil.
915 gnus-Save-newsrc-hook
916 Called with no arguments when saving newsrc file if that value is
917 non-nil.
919 gnus-Inews-article-hook
920 Called with no arguments when posting an article if that value is
921 non-nil. This hook is called just before posting an article, while
922 `news-inews-hook' is called before preparing article headers. If
923 you'd like to convert kanji code of the article, this hook is recommended.
925 gnus-Suspend-gnus-hook
926 Called with no arguments when suspending (not exiting) GNUS, if
927 that value is non-nil.
929 gnus-Exit-gnus-hook
930 Called with no arguments when exiting (not suspending) GNUS, if
931 that value is non-nil."
932 (interactive)
933 (kill-all-local-variables)
934 ;; Gee. Why don't you upgrade?
935 (cond ((boundp 'mode-line-modified)
936 (setq mode-line-modified "--- "))
937 ((listp (default-value 'mode-line-format))
938 (setq mode-line-format
939 (cons "--- " (cdr (default-value 'mode-line-format)))))
941 (setq mode-line-format
942 "--- GNUS: List of Newsgroups %[(%m)%]----%3p-%-")))
943 (setq major-mode 'gnus-Group-mode)
944 (setq mode-name "Newsgroup")
945 (setq mode-line-buffer-identification "GNUS: List of Newsgroups")
946 (setq mode-line-process nil)
947 (use-local-map gnus-Group-mode-map)
948 (buffer-flush-undo (current-buffer))
949 (setq buffer-read-only t) ;Disable modification
950 (run-hooks 'gnus-Group-mode-hook))
952 ;;;###autoload
953 (defun gnus (&optional confirm)
954 "Read network news.
955 If optional argument CONFIRM is non-nil, ask NNTP server."
956 (interactive "P")
957 (unwind-protect
958 (progn
959 (switch-to-buffer (get-buffer-create gnus-Group-buffer))
960 (gnus-Group-mode)
961 (gnus-start-news-server confirm))
962 (if (not (gnus-server-opened))
963 (gnus-Group-quit)
964 ;; NNTP server is successfully open.
965 (setq mode-line-process (format " {%s}" gnus-nntp-server))
966 (let ((buffer-read-only nil))
967 (erase-buffer)
968 (gnus-Group-startup-message)
969 (sit-for 0))
970 (run-hooks 'gnus-Startup-hook)
971 (gnus-setup-news-info)
972 (if gnus-novice-user
973 (gnus-Group-describe-briefly)) ;Show brief help message.
974 (gnus-Group-list-groups nil)
977 (defun gnus-Group-startup-message ()
978 "Insert startup message in current buffer."
979 ;; Insert the message.
980 (insert "
981 GNUS Version 3.13
983 NNTP-based News Reader for GNU Emacs
986 If you have any trouble with this software, please let me
987 know. I will fix your problems in the next release.
989 Comments, suggestions, and bug fixes are welcome.
991 Masanobu UMEDA
992 umerin@tc.Nagasaki.GO.JP")
993 ;; And then hack it.
994 ;; 57 is the longest line.
995 (indent-rigidly (point-min) (point-max) (/ (max (- (window-width) 57) 0) 2))
996 (goto-char (point-min))
997 ;; +4 is fuzzy factor.
998 (insert-char ?\n (/ (max (- (window-height) 18) 0) 2)))
1000 (defun gnus-Group-list-groups (show-all)
1001 "List newsgroups in the Newsgroup buffer.
1002 If argument SHOW-ALL is non-nil, unsubscribed groups are also listed."
1003 (interactive "P")
1004 (let ((last-group ;Current newsgroup.
1005 (gnus-Group-group-name))
1006 (next-group ;Next possible newsgroup.
1007 (progn
1008 (gnus-Group-search-forward nil nil)
1009 (gnus-Group-group-name)))
1010 (prev-group ;Previous possible newsgroup.
1011 (progn
1012 (gnus-Group-search-forward t nil)
1013 (gnus-Group-group-name))))
1014 (gnus-Group-prepare show-all)
1015 (if (zerop (buffer-size))
1016 (message "No news is good news")
1017 ;; Go to last newsgroup if possible. If cannot, try next and
1018 ;; previous. If all fail, go to first unread newsgroup.
1019 (goto-char (point-min))
1020 (or (and last-group
1021 (re-search-forward
1022 (concat "^.+: " (regexp-quote last-group) "$") nil t))
1023 (and next-group
1024 (re-search-forward
1025 (concat "^.+: " (regexp-quote next-group) "$") nil t))
1026 (and prev-group
1027 (re-search-forward
1028 (concat "^.+: " (regexp-quote prev-group) "$") nil t))
1029 (re-search-forward "^[ \t]+[1-9][0-9]*:" nil t))
1030 ;; Adjust cursor point.
1031 (beginning-of-line)
1032 (search-forward ":" nil t)
1035 (defun gnus-Group-prepare (&optional all)
1036 "Prepare list of newsgroups in current buffer.
1037 If optional argument ALL is non-nil, unsubscribed groups are also listed."
1038 (let ((buffer-read-only nil)
1039 (newsrc gnus-newsrc-assoc)
1040 (group-info nil)
1041 (group-name nil)
1042 (unread-count 0)
1043 ;; This specifies the format of Group buffer.
1044 (cntl "%s%s%5d: %s\n"))
1045 (erase-buffer)
1046 ;; List newsgroups.
1047 (while newsrc
1048 (setq group-info (car newsrc))
1049 (setq group-name (car group-info))
1050 (setq unread-count (nth 1 (gnus-gethash group-name gnus-unread-hashtb)))
1051 (if (or all
1052 (and (nth 1 group-info) ;Subscribed.
1053 (> unread-count 0))) ;There are unread articles.
1054 ;; Yes, I can use gnus-Group-prepare-line, but this is faster.
1055 (insert
1056 (format cntl
1057 ;; Subscribed or not.
1058 (if (nth 1 group-info) " " "U")
1059 ;; Has new news?
1060 (if (and (> unread-count 0)
1061 (>= 0
1062 (- unread-count
1063 (length
1064 (cdr (assoc group-name
1065 gnus-marked-assoc))))))
1066 "*" " ")
1067 ;; Number of unread articles.
1068 unread-count
1069 ;; Newsgroup name.
1070 group-name))
1072 (setq newsrc (cdr newsrc))
1074 (setq gnus-have-all-newsgroups all)
1075 (goto-char (point-min))
1076 (run-hooks 'gnus-Group-prepare-hook)
1079 (defun gnus-Group-prepare-line (info)
1080 "Return a string for the Newsgroup buffer from INFO.
1081 INFO is an element of gnus-newsrc-assoc or gnus-killed-assoc."
1082 (let* ((group-name (car info))
1083 (unread-count
1084 (or (nth 1 (gnus-gethash group-name gnus-unread-hashtb))
1085 ;; Not in hash table, so compute it now.
1086 (gnus-number-of-articles
1087 (gnus-difference-of-range
1088 (nth 2 (gnus-gethash group-name gnus-active-hashtb))
1089 (nthcdr 2 info)))))
1090 ;; This specifies the format of Group buffer.
1091 (cntl "%s%s%5d: %s\n"))
1092 (format cntl
1093 ;; Subscribed or not.
1094 (if (nth 1 info) " " "U")
1095 ;; Has new news?
1096 (if (and (> unread-count 0)
1097 (>= 0
1098 (- unread-count
1099 (length
1100 (cdr (assoc group-name gnus-marked-assoc))))))
1101 "*" " ")
1102 ;; Number of unread articles.
1103 unread-count
1104 ;; Newsgroup name.
1105 group-name
1108 (defun gnus-Group-update-group (group &optional visible-only)
1109 "Update newsgroup info of GROUP.
1110 If optional argument VISIBLE-ONLY is non-nil, non displayed group is ignored."
1111 (let ((buffer-read-only nil)
1112 (visible nil))
1113 ;; Buffer may be narrowed.
1114 (save-restriction
1115 (widen)
1116 ;; Search point to modify.
1117 (goto-char (point-min))
1118 (if (re-search-forward (concat "^.+: " (regexp-quote group) "$") nil t)
1119 ;; GROUP is listed in current buffer. So, delete old line.
1120 (progn
1121 (setq visible t)
1122 (beginning-of-line)
1123 (delete-region (point) (progn (forward-line 1) (point)))
1125 (if (or visible (not visible-only))
1126 (progn
1127 (insert (gnus-Group-prepare-line (assoc group gnus-newsrc-assoc)))
1128 (forward-line -1) ;Move point on that line.
1132 ;; GNUS Group mode command
1134 (defun gnus-Group-group-name ()
1135 "Get newsgroup name around point."
1136 (save-excursion
1137 (beginning-of-line)
1138 (if (looking-at ".[* \t]*[0-9]+:[ \t]+\\([^ \t\n]+\\)$")
1139 (buffer-substring (match-beginning 1) (match-end 1))
1142 (defun gnus-Group-read-group (all &optional no-article)
1143 "Read news in this newsgroup.
1144 If argument ALL is non-nil, already read articles become readable.
1145 If optional argument NO-ARTICLE is non-nil, no article body is displayed."
1146 (interactive "P")
1147 (let ((group (gnus-Group-group-name))) ;Newsgroup name to read.
1148 (if group
1149 (gnus-Subject-read-group
1150 group
1151 (or all
1152 ;;(not (nth 1 (assoc group gnus-newsrc-assoc))) ;Unsubscribed
1153 (zerop
1154 (nth 1 (gnus-gethash group gnus-unread-hashtb)))) ;No unread
1155 no-article
1159 (defun gnus-Group-select-group (all)
1160 "Select this newsgroup.
1161 No article is selected automatically.
1162 If argument ALL is non-nil, already read articles become readable."
1163 (interactive "P")
1164 (gnus-Group-read-group all t))
1166 (defun gnus-Group-jump-to-group (group)
1167 "Jump to newsgroup GROUP."
1168 (interactive
1169 (list (completing-read "Newsgroup: " gnus-newsrc-assoc nil 'require-match)))
1170 (goto-char (point-min))
1171 (or (re-search-forward (concat "^.+: " (regexp-quote group) "$") nil t)
1172 (if (assoc group gnus-newsrc-assoc)
1173 ;; Add GROUP entry, then seach again.
1174 (gnus-Group-update-group group)))
1175 ;; Adjust cursor point.
1176 (beginning-of-line)
1177 (search-forward ":" nil t))
1179 (defun gnus-Group-search-forward (backward any-group)
1180 "Search for newsgroup forward.
1181 If first argument BACKWARD is non-nil, search backward instead.
1182 If second argument ANY-GROUP is non-nil, unsubscribed or empty
1183 group may be selected."
1184 (let ((func (if backward 're-search-backward 're-search-forward))
1185 (regexp
1186 (format "^%s[ \t]*\\(%s\\):"
1187 (if any-group ".." " [ \t]")
1188 (if any-group "[0-9]+" "[1-9][0-9]*")))
1189 (found nil))
1190 (if backward
1191 (beginning-of-line)
1192 (end-of-line))
1193 (setq found (funcall func regexp nil t))
1194 ;; Adjust cursor point.
1195 (beginning-of-line)
1196 (search-forward ":" nil t)
1197 ;; Return T if found.
1198 found
1201 (defun gnus-Group-next-group (n)
1202 "Go to next N'th newsgroup."
1203 (interactive "p")
1204 (while (and (> n 1)
1205 (gnus-Group-search-forward nil t))
1206 (setq n (1- n)))
1207 (or (gnus-Group-search-forward nil t)
1208 (message "No more newsgroups")))
1210 (defun gnus-Group-next-unread-group (n)
1211 "Go to next N'th unread newsgroup."
1212 (interactive "p")
1213 (while (and (> n 1)
1214 (gnus-Group-search-forward nil nil))
1215 (setq n (1- n)))
1216 (or (gnus-Group-search-forward nil nil)
1217 (message "No more unread newsgroups")))
1219 (defun gnus-Group-prev-group (n)
1220 "Go to previous N'th newsgroup."
1221 (interactive "p")
1222 (while (and (> n 1)
1223 (gnus-Group-search-forward t t))
1224 (setq n (1- n)))
1225 (or (gnus-Group-search-forward t t)
1226 (message "No more newsgroups")))
1228 (defun gnus-Group-prev-unread-group (n)
1229 "Go to previous N'th unread newsgroup."
1230 (interactive "p")
1231 (while (and (> n 1)
1232 (gnus-Group-search-forward t nil))
1233 (setq n (1- n)))
1234 (or (gnus-Group-search-forward t nil)
1235 (message "No more unread newsgroups")))
1237 (defun gnus-Group-catch-up (all &optional quietly)
1238 "Mark all articles not marked as unread in current newsgroup as read.
1239 If prefix argument ALL is non-nil, all articles are marked as read.
1240 Cross references (Xref: field) of articles are ignored."
1241 (interactive "P")
1242 (let* ((group (gnus-Group-group-name))
1243 (marked (if (not all)
1244 (cdr (assoc group gnus-marked-assoc)))))
1245 (and group
1246 (or quietly
1247 (y-or-n-p
1248 (if all
1249 "Do you really want to mark everything as read? "
1250 "Delete all articles not marked as read? ")))
1251 (progn
1252 (message "") ;Erase "Yes or No" question.
1253 ;; Any marked articles will be preserved.
1254 (gnus-update-unread-articles group marked marked)
1255 (gnus-Group-update-group group)
1256 (gnus-Group-next-group 1)))
1259 (defun gnus-Group-catch-up-all (&optional quietly)
1260 "Mark all articles in current newsgroup as read.
1261 Cross references (Xref: field) of articles are ignored."
1262 (interactive)
1263 (gnus-Group-catch-up t quietly))
1265 (defun gnus-Group-unsubscribe-current-group ()
1266 "Toggle subscribe from/to unsubscribe current group."
1267 (interactive)
1268 (gnus-Group-unsubscribe-group (gnus-Group-group-name))
1269 (gnus-Group-next-group 1))
1271 (defun gnus-Group-unsubscribe-group (group)
1272 "Toggle subscribe from/to unsubscribe GROUP.
1273 New newsgroup is added to .newsrc automatically."
1274 (interactive
1275 (list (completing-read "Newsgroup: "
1276 gnus-active-hashtb nil 'require-match)))
1277 (let ((newsrc (assoc group gnus-newsrc-assoc)))
1278 (cond ((not (null newsrc))
1279 ;; Toggle subscription flag.
1280 (setcar (nthcdr 1 newsrc) (not (nth 1 newsrc)))
1281 (gnus-update-newsrc-buffer group)
1282 (gnus-Group-update-group group)
1283 ;; Adjust cursor point.
1284 (beginning-of-line)
1285 (search-forward ":" nil t))
1286 ((and (stringp group)
1287 (gnus-gethash group gnus-active-hashtb))
1288 ;; Add new newsgroup.
1289 (gnus-add-newsgroup group)
1290 (gnus-Group-update-group group)
1291 ;; Adjust cursor point.
1292 (beginning-of-line)
1293 (search-forward ":" nil t))
1294 (t (error "No such newsgroup: %s" group)))
1297 (defun gnus-Group-list-all-groups ()
1298 "List all of newsgroups in the Newsgroup buffer."
1299 (interactive)
1300 (gnus-Group-list-groups t))
1302 (defun gnus-Group-get-new-news ()
1303 "Get newly arrived articles. In fact, read the active file again."
1304 (interactive)
1305 (gnus-setup-news-info)
1306 (gnus-Group-list-groups gnus-have-all-newsgroups))
1308 (defun gnus-Group-restart ()
1309 "Force GNUS to read the raw startup file."
1310 (interactive)
1311 (gnus-save-newsrc-file)
1312 (gnus-setup-news-info t) ;Force to read the raw startup file.
1313 (gnus-Group-list-groups gnus-have-all-newsgroups))
1315 (defun gnus-Group-check-bogus-groups ()
1316 "Check bogus newsgroups."
1317 (interactive)
1318 (gnus-check-bogus-newsgroups t) ;Require confirmation.
1319 (gnus-Group-list-groups gnus-have-all-newsgroups))
1321 (defun gnus-Group-restrict-groups (start end)
1322 "Restrict visible newsgroups to the current region (START and END).
1323 Type \\[widen] to remove restriction."
1324 (interactive "r")
1325 (save-excursion
1326 (narrow-to-region (progn
1327 (goto-char start)
1328 (beginning-of-line)
1329 (point))
1330 (progn
1331 (goto-char end)
1332 (forward-line 1)
1333 (point))))
1334 (message (substitute-command-keys "Type \\[widen] to remove restriction")))
1336 (defun gnus-Group-edit-global-kill ()
1337 "Edit a global KILL file."
1338 (interactive)
1339 (setq gnus-current-kill-article nil) ;No articles selected.
1340 (gnus-Kill-file-edit-file nil) ;Nil stands for global KILL file.
1341 (message
1342 (substitute-command-keys
1343 "Editing a global KILL file (Type \\[gnus-Kill-file-exit] to exit)")))
1345 (defun gnus-Group-edit-local-kill ()
1346 "Edit a local KILL file."
1347 (interactive)
1348 (setq gnus-current-kill-article nil) ;No articles selected.
1349 (gnus-Kill-file-edit-file (gnus-Group-group-name))
1350 (message
1351 (substitute-command-keys
1352 "Editing a local KILL file (Type \\[gnus-Kill-file-exit] to exit)")))
1354 (defun gnus-Group-force-update ()
1355 "Update .newsrc file."
1356 (interactive)
1357 (gnus-save-newsrc-file))
1359 (defun gnus-Group-suspend ()
1360 "Suspend the current GNUS session.
1361 In fact, cleanup buffers except for Group Mode buffer.
1362 The hook `gnus-Suspend-gnus-hook' is called before actually suspending."
1363 (interactive)
1364 (run-hooks 'gnus-Suspend-gnus-hook)
1365 ;; Kill GNUS buffers except for Group Mode buffer.
1366 (let ((buffers gnus-buffer-list))
1367 (while buffers
1368 (and (not (eq (car buffers) gnus-Group-buffer))
1369 (get-buffer (car buffers))
1370 (kill-buffer (car buffers)))
1371 (setq buffers (cdr buffers))
1373 (bury-buffer))
1375 (defun gnus-Group-exit ()
1376 "Quit reading news after updating .newsrc.
1377 The hook `gnus-Exit-gnus-hook' is called before actually quitting."
1378 (interactive)
1379 (if (or noninteractive ;For gnus-batch-kill
1380 (zerop (buffer-size)) ;No news is good news.
1381 (not (gnus-server-opened)) ;NNTP connection closed.
1382 (y-or-n-p "Are you sure you want to quit reading news? "))
1383 (progn
1384 (message "") ;Erase "Yes or No" question.
1385 (run-hooks 'gnus-Exit-gnus-hook)
1386 (gnus-save-newsrc-file)
1387 (gnus-clear-system)
1388 (gnus-close-server))
1391 (defun gnus-Group-quit ()
1392 "Quit reading news without updating .newsrc.
1393 The hook `gnus-Exit-gnus-hook' is called before actually quitting."
1394 (interactive)
1395 (if (or (zerop (buffer-size))
1396 (not (gnus-server-opened))
1397 (yes-or-no-p
1398 (format "Quit reading news without saving %s? "
1399 (file-name-nondirectory gnus-current-startup-file))))
1400 (progn
1401 (message "") ;Erase "Yes or No" question.
1402 (run-hooks 'gnus-Exit-gnus-hook)
1403 (gnus-clear-system)
1404 (gnus-close-server))
1407 (defun gnus-Group-describe-briefly ()
1408 "Describe Group mode commands briefly."
1409 (interactive)
1410 (message
1411 (concat
1412 (substitute-command-keys "\\[gnus-Group-read-group]:Select ")
1413 (substitute-command-keys "\\[gnus-Group-next-unread-group]:Forward ")
1414 (substitute-command-keys "\\[gnus-Group-prev-unread-group]:Backward ")
1415 (substitute-command-keys "\\[gnus-Group-exit]:Exit ")
1416 (substitute-command-keys "\\[gnus-Info-find-node]:Run Info ")
1417 (substitute-command-keys "\\[gnus-Group-describe-briefly]:This help")
1422 ;;; GNUS Subject Mode
1425 (if gnus-Subject-mode-map
1427 (setq gnus-Subject-mode-map (make-keymap))
1428 (suppress-keymap gnus-Subject-mode-map)
1429 (define-key gnus-Subject-mode-map " " 'gnus-Subject-next-page)
1430 (define-key gnus-Subject-mode-map "\177" 'gnus-Subject-prev-page)
1431 (define-key gnus-Subject-mode-map "\r" 'gnus-Subject-scroll-up)
1432 (define-key gnus-Subject-mode-map "n" 'gnus-Subject-next-unread-article)
1433 (define-key gnus-Subject-mode-map "p" 'gnus-Subject-prev-unread-article)
1434 (define-key gnus-Subject-mode-map "N" 'gnus-Subject-next-article)
1435 (define-key gnus-Subject-mode-map "P" 'gnus-Subject-prev-article)
1436 (define-key gnus-Subject-mode-map "\e\C-n" 'gnus-Subject-next-same-subject)
1437 (define-key gnus-Subject-mode-map "\e\C-p" 'gnus-Subject-prev-same-subject)
1438 ;;(define-key gnus-Subject-mode-map "\e\C-n" 'gnus-Subject-next-unread-same-subject)
1439 ;;(define-key gnus-Subject-mode-map "\e\C-p" 'gnus-Subject-prev-unread-same-subject)
1440 (define-key gnus-Subject-mode-map "\C-c\C-n" 'gnus-Subject-next-digest)
1441 (define-key gnus-Subject-mode-map "\C-c\C-p" 'gnus-Subject-prev-digest)
1442 (define-key gnus-Subject-mode-map "\C-n" 'gnus-Subject-next-subject)
1443 (define-key gnus-Subject-mode-map "\C-p" 'gnus-Subject-prev-subject)
1444 (define-key gnus-Subject-mode-map "\en" 'gnus-Subject-next-unread-subject)
1445 (define-key gnus-Subject-mode-map "\ep" 'gnus-Subject-prev-unread-subject)
1446 ;;(define-key gnus-Subject-mode-map "\C-cn" 'gnus-Subject-next-group)
1447 ;;(define-key gnus-Subject-mode-map "\C-cp" 'gnus-Subject-prev-group)
1448 (define-key gnus-Subject-mode-map "." 'gnus-Subject-first-unread-article)
1449 (define-key gnus-Subject-mode-map "/" 'isearch-forward)
1450 (define-key gnus-Subject-mode-map "s" 'gnus-Subject-isearch-article)
1451 (define-key gnus-Subject-mode-map "\es" 'gnus-Subject-search-article-forward)
1452 (define-key gnus-Subject-mode-map "\eS" 'gnus-Subject-search-article-backward)
1453 (define-key gnus-Subject-mode-map "<" 'gnus-Subject-beginning-of-article)
1454 (define-key gnus-Subject-mode-map ">" 'gnus-Subject-end-of-article)
1455 (define-key gnus-Subject-mode-map "j" 'gnus-Subject-goto-subject)
1456 (define-key gnus-Subject-mode-map "J" 'gnus-Subject-goto-article)
1457 (define-key gnus-Subject-mode-map "l" 'gnus-Subject-goto-last-article)
1458 (define-key gnus-Subject-mode-map "^" 'gnus-Subject-refer-parent-article)
1459 (define-key gnus-Subject-mode-map "\er" 'gnus-Subject-refer-article)
1460 (define-key gnus-Subject-mode-map "u" 'gnus-Subject-mark-as-unread-forward)
1461 (define-key gnus-Subject-mode-map "U" 'gnus-Subject-mark-as-unread-backward)
1462 (define-key gnus-Subject-mode-map "d" 'gnus-Subject-mark-as-read-forward)
1463 (define-key gnus-Subject-mode-map "D" 'gnus-Subject-mark-as-read-backward)
1464 (define-key gnus-Subject-mode-map "\eu" 'gnus-Subject-clear-mark-forward)
1465 (define-key gnus-Subject-mode-map "\eU" 'gnus-Subject-clear-mark-backward)
1466 (define-key gnus-Subject-mode-map "k" 'gnus-Subject-kill-same-subject-and-select)
1467 (define-key gnus-Subject-mode-map "\C-k" 'gnus-Subject-kill-same-subject)
1468 (define-key gnus-Subject-mode-map "\e\C-t" 'gnus-Subject-toggle-threads)
1469 (define-key gnus-Subject-mode-map "\e\C-s" 'gnus-Subject-show-thread)
1470 (define-key gnus-Subject-mode-map "\e\C-h" 'gnus-Subject-hide-thread)
1471 (define-key gnus-Subject-mode-map "\e\C-f" 'gnus-Subject-next-thread)
1472 (define-key gnus-Subject-mode-map "\e\C-b" 'gnus-Subject-prev-thread)
1473 (define-key gnus-Subject-mode-map "\e\C-u" 'gnus-Subject-up-thread)
1474 (define-key gnus-Subject-mode-map "\e\C-d" 'gnus-Subject-down-thread)
1475 (define-key gnus-Subject-mode-map "\e\C-k" 'gnus-Subject-kill-thread)
1476 (define-key gnus-Subject-mode-map "&" 'gnus-Subject-execute-command)
1477 ;;(define-key gnus-Subject-mode-map "c" 'gnus-Subject-catch-up)
1478 ;;(define-key gnus-Subject-mode-map "c" 'gnus-Subject-catch-up-all)
1479 (define-key gnus-Subject-mode-map "c" 'gnus-Subject-catch-up-and-exit)
1480 ;;(define-key gnus-Subject-mode-map "c" 'gnus-Subject-catch-up-all-and-exit)
1481 (define-key gnus-Subject-mode-map "\C-t" 'gnus-Subject-toggle-truncation)
1482 (define-key gnus-Subject-mode-map "x" 'gnus-Subject-delete-marked-as-read)
1483 (define-key gnus-Subject-mode-map "X" 'gnus-Subject-delete-marked-with)
1484 (define-key gnus-Subject-mode-map "\C-c\C-sn" 'gnus-Subject-sort-by-number)
1485 (define-key gnus-Subject-mode-map "\C-c\C-sa" 'gnus-Subject-sort-by-author)
1486 (define-key gnus-Subject-mode-map "\C-c\C-ss" 'gnus-Subject-sort-by-subject)
1487 (define-key gnus-Subject-mode-map "\C-c\C-sd" 'gnus-Subject-sort-by-date)
1488 (define-key gnus-Subject-mode-map "\C-c\C-s\C-n" 'gnus-Subject-sort-by-number)
1489 (define-key gnus-Subject-mode-map "\C-c\C-s\C-a" 'gnus-Subject-sort-by-author)
1490 (define-key gnus-Subject-mode-map "\C-c\C-s\C-s" 'gnus-Subject-sort-by-subject)
1491 (define-key gnus-Subject-mode-map "\C-c\C-s\C-d" 'gnus-Subject-sort-by-date)
1492 (define-key gnus-Subject-mode-map "=" 'gnus-Subject-expand-window)
1493 (define-key gnus-Subject-mode-map "G" 'gnus-Subject-reselect-current-group)
1494 (define-key gnus-Subject-mode-map "w" 'gnus-Subject-stop-page-breaking)
1495 (define-key gnus-Subject-mode-map "\C-c\C-r" 'gnus-Subject-caesar-message)
1496 (define-key gnus-Subject-mode-map "g" 'gnus-Subject-show-article)
1497 (define-key gnus-Subject-mode-map "t" 'gnus-Subject-toggle-header)
1498 (define-key gnus-Subject-mode-map "v" 'gnus-Subject-show-all-headers)
1499 (define-key gnus-Subject-mode-map "\C-d" 'gnus-Subject-rmail-digest)
1500 (define-key gnus-Subject-mode-map "a" 'gnus-Subject-post-news)
1501 (define-key gnus-Subject-mode-map "f" 'gnus-Subject-post-reply)
1502 (define-key gnus-Subject-mode-map "F" 'gnus-Subject-post-reply-with-original)
1503 (define-key gnus-Subject-mode-map "C" 'gnus-Subject-cancel-article)
1504 (define-key gnus-Subject-mode-map "r" 'gnus-Subject-mail-reply)
1505 (define-key gnus-Subject-mode-map "R" 'gnus-Subject-mail-reply-with-original)
1506 (define-key gnus-Subject-mode-map "m" 'gnus-Subject-mail-other-window)
1507 (define-key gnus-Subject-mode-map "o" 'gnus-Subject-save-article)
1508 (define-key gnus-Subject-mode-map "\C-o" 'gnus-Subject-save-in-mail)
1509 (define-key gnus-Subject-mode-map "|" 'gnus-Subject-pipe-output)
1510 (define-key gnus-Subject-mode-map "\ek" 'gnus-Subject-edit-local-kill)
1511 (define-key gnus-Subject-mode-map "\eK" 'gnus-Subject-edit-global-kill)
1512 (define-key gnus-Subject-mode-map "V" 'gnus-version)
1513 (define-key gnus-Subject-mode-map "q" 'gnus-Subject-exit)
1514 (define-key gnus-Subject-mode-map "Q" 'gnus-Subject-quit)
1515 (define-key gnus-Subject-mode-map "?" 'gnus-Subject-describe-briefly)
1516 (define-key gnus-Subject-mode-map "\C-c\C-i" 'gnus-Info-find-node))
1518 (defun gnus-Subject-mode ()
1519 "Major mode for reading articles in this newsgroup.
1520 All normal editing commands are turned off.
1521 Instead, these commands are available:
1522 \\{gnus-Subject-mode-map}
1524 User customizable variables:
1525 gnus-large-newsgroup
1526 The number of articles which indicates a large newsgroup. If the
1527 number of articles in a newsgroup is greater than the value, the
1528 number of articles to be selected is asked for. If the given value
1529 N is positive, the last N articles is selected. If N is negative,
1530 the first N articles are selected. An empty string means to select
1531 all articles.
1533 gnus-use-long-file-name
1534 Non-nil means that a newsgroup name is used as a default file name
1535 to save articles to. If it's nil, the directory form of a
1536 newsgroup is used instead.
1538 gnus-default-article-saver
1539 Specifies your favorite article saver which is interactively
1540 funcallable. Following functions are available:
1542 gnus-Subject-save-in-rmail (in Rmail format)
1543 gnus-Subject-save-in-mail (in Unix mail format)
1544 gnus-Subject-save-in-folder (in MH folder)
1545 gnus-Subject-save-in-file (in article format).
1547 gnus-rmail-save-name
1548 gnus-mail-save-name
1549 gnus-folder-save-name
1550 gnus-file-save-name
1551 Specifies a function generating a file name to save articles in
1552 specified format. The function is called with NEWSGROUP, HEADERS,
1553 and optional LAST-FILE. Access macros to the headers are defined
1554 as nntp-header-FIELD, and functions are defined as `gnus-header-FIELD'.
1556 gnus-article-save-directory
1557 Specifies a directory name to save articles to using the commands
1558 `gnus-Subject-save-in-rmail', `gnus-Subject-save-in-mail' and
1559 `gnus-Subject-save-in-file'. The variable is initialized from the
1560 SAVEDIR environment variable.
1562 gnus-show-all-headers
1563 Non-nil means that all headers of an article are shown.
1565 gnus-save-all-headers
1566 Non-nil means that all headers of an article are saved in a file.
1568 gnus-show-threads
1569 Non-nil means that conversation threads are shown in tree structure.
1571 gnus-thread-hide-subject
1572 Non-nil means that subjects for thread subtrees are hidden.
1574 gnus-thread-hide-subtree
1575 Non-nil means that thread subtrees are hidden initially.
1577 gnus-thread-hide-killed
1578 Non-nil means that killed thread subtrees are hidden automatically.
1580 gnus-thread-ignore-subject
1581 Non-nil means that subject differences are ignored in constructing
1582 thread trees.
1584 gnus-thread-indent-level
1585 Indentation of thread subtrees.
1587 gnus-optional-headers
1588 Specifies a function which generates an optional string displayed
1589 in the Subject buffer. The function is called with an article
1590 HEADERS. The result must be a string excluding `[' and `]'. The
1591 default function returns a string like NNN:AUTHOR, where NNN is
1592 the number of lines in an article and AUTHOR is the name of the
1593 author.
1595 gnus-auto-extend-newsgroup
1596 Non-nil means visible articles are extended to forward and
1597 backward automatically if possible.
1599 gnus-auto-select-first
1600 Non-nil means the first unread article is selected automagically
1601 when a newsgroup is selected normally (by gnus-Group-read-group).
1602 If you'd like to prevent automatic selection of the first unread
1603 article in some newsgroups, set the variable to nil in
1604 gnus-Select-group-hook or gnus-Apply-kill-hook.
1606 gnus-auto-select-next
1607 Non-nil means the next newsgroup is selected automagically at the
1608 end of the newsgroup. If the value is t and the next newsgroup is
1609 empty (no unread articles), GNUS will exit Subject mode and go
1610 back to Group mode. If the value is neither nil nor t, GNUS won't
1611 exit Subject mode but select the following unread newsgroup.
1612 Especially, if the value is the symbol `quietly', the next unread
1613 newsgroup will be selected without any confirmations.
1615 gnus-auto-select-same
1616 Non-nil means an article with the same subject as the current
1617 article is selected automagically like `rn -S'.
1619 gnus-auto-center-subject
1620 Non-nil means the point of Subject Mode window is always kept
1621 centered.
1623 gnus-break-pages
1624 Non-nil means an article is broken into pages at page delimiters.
1625 This may not work with some versions of GNU Emacs earlier than
1626 version 18.50.
1628 gnus-page-delimiter
1629 Specifies a regexp describing line-beginnings that separate pages
1630 of news article.
1632 [gnus-more-message is obsolete. overlay-arrow-string interfares
1633 with other subsystems, such as dbx mode.]
1635 gnus-digest-show-summary
1636 Non-nil means that a summary of digest messages is shown when
1637 reading a digest article using `gnus-Subject-rmail-digest' command.
1639 gnus-digest-separator
1640 Specifies a regexp separating messages in a digest article.
1642 gnus-mail-reply-method
1643 gnus-mail-other-window-method
1644 Specifies a function to begin composing mail message using
1645 commands gnus-Subject-mail-reply and
1646 gnus-Subject-mail-other-window. Functions
1647 gnus-mail-reply-using-mail and gnus-mail-reply-using-mhe are
1648 available for the value of gnus-mail-reply-method. And functions
1649 gnus-mail-other-window-using-mail and
1650 gnus-mail-other-window-using-mhe are available for the value of
1651 gnus-mail-other-window-method.
1653 Various hooks for customization:
1654 gnus-Subject-mode-hook
1655 Entry to this mode calls the value with no arguments, if that
1656 value is non-nil.
1658 gnus-Select-group-hook
1659 Called with no arguments when newsgroup is selected, if that value
1660 is non-nil. It is possible to sort subjects in this hook. See the
1661 documentation of this variable for more information.
1663 gnus-Subject-prepare-hook
1664 Called with no arguments after a subject list is created in the
1665 Subject buffer, if that value is non-nil. If you'd like to modify
1666 the buffer, you can use this hook.
1668 gnus-Select-article-hook
1669 Called with no arguments when an article is selected, if that
1670 value is non-nil. See the documentation of this variable for
1671 more information.
1673 gnus-Select-digest-hook
1674 Called with no arguments when reading digest messages using Rmail,
1675 if that value is non-nil. This hook can be used to modify an
1676 article so that Rmail can work with it. See the documentation of
1677 the variable for more information.
1679 gnus-Rmail-digest-hook
1680 Called with no arguments when reading digest messages using Rmail,
1681 if that value is non-nil. This hook is intended to customize Rmail
1682 mode.
1684 gnus-Apply-kill-hook
1685 Called with no arguments when a newsgroup is selected and the
1686 Subject buffer is prepared. This hook is intended to apply a KILL
1687 file to the selected newsgroup. The format of KILL file is
1688 completely different from that of version 3.8. You have to rewrite
1689 them in the new format. See the documentation of Kill file mode
1690 for more information.
1692 gnus-Mark-article-hook
1693 Called with no arguments when an article is selected at the first
1694 time. The hook is intended to mark an article as read (or unread)
1695 automatically when it is selected. See the documentation of the
1696 variable for more information.
1698 gnus-Exit-group-hook
1699 Called with no arguments when exiting the current newsgroup, if
1700 that value is non-nil. If your machine is so slow that exiting
1701 from Subject mode takes very long time, inhibit marking articles
1702 as read using cross-references by setting the variable
1703 `gnus-newsgroup-headers' to nil in this hook."
1704 (interactive)
1705 (kill-all-local-variables)
1706 ;; Gee. Why don't you upgrade?
1707 (cond ((boundp 'mode-line-modified)
1708 (setq mode-line-modified "--- "))
1709 ((listp (default-value 'mode-line-format))
1710 (setq mode-line-format
1711 (cons "--- " (cdr (default-value 'mode-line-format))))))
1712 (make-local-variable 'global-mode-string)
1713 (setq global-mode-string nil)
1714 (setq major-mode 'gnus-Subject-mode)
1715 (setq mode-name "Subject")
1716 ;;(setq mode-line-process '(" " gnus-newsgroup-name))
1717 (make-local-variable 'minor-mode-alist)
1718 (or (assq 'gnus-show-threads minor-mode-alist)
1719 (setq minor-mode-alist
1720 (cons (list 'gnus-show-threads " Thread") minor-mode-alist)))
1721 (gnus-Subject-set-mode-line)
1722 (use-local-map gnus-Subject-mode-map)
1723 (buffer-flush-undo (current-buffer))
1724 (setq buffer-read-only t) ;Disable modification
1725 (setq truncate-lines t) ;Stop line folding
1726 (setq selective-display t)
1727 (setq selective-display-ellipses t) ;Display `...'
1728 ;;(setq case-fold-search t)
1729 (run-hooks 'gnus-Subject-mode-hook))
1731 (defun gnus-Subject-setup-buffer ()
1732 "Initialize subject display buffer."
1733 (if (get-buffer gnus-Subject-buffer)
1734 (set-buffer gnus-Subject-buffer)
1735 (set-buffer (get-buffer-create gnus-Subject-buffer))
1736 (gnus-Subject-mode)
1739 (defun gnus-Subject-read-group (group &optional show-all no-article)
1740 "Start reading news in newsgroup GROUP.
1741 If optional first argument SHOW-ALL is non-nil, already read articles are
1742 also listed.
1743 If optional second argument NO-ARTICLE is non-nil, no article is selected
1744 initially."
1745 (message "Retrieving newsgroup: %s..." group)
1746 (if (gnus-select-newsgroup group show-all)
1747 (progn
1748 ;; Don't switch-to-buffer to prevent displaying old contents
1749 ;; of the buffer until new subjects list is created.
1750 ;; Suggested by Juha Heinanen <jh@tut.fi>
1751 (gnus-Subject-setup-buffer)
1752 ;; You can change the order of subjects in this hook.
1753 (run-hooks 'gnus-Select-group-hook)
1754 (gnus-Subject-prepare)
1755 ;; Function `gnus-apply-kill-file' must be called in this hook.
1756 (run-hooks 'gnus-Apply-kill-hook)
1757 (if (zerop (buffer-size))
1758 ;; This newsgroup is empty.
1759 (progn
1760 (gnus-Subject-catch-up-and-exit nil t) ;Without confirmations.
1761 (message "No unread news"))
1762 ;; Hide conversation thread subtrees. We cannot do this in
1763 ;; gnus-Subject-prepare-hook since kill processing may not
1764 ;; work with hidden articles.
1765 (and gnus-show-threads
1766 gnus-thread-hide-subtree
1767 (gnus-Subject-hide-all-threads))
1768 ;; Show first unread article if requested.
1769 (goto-char (point-min))
1770 (if (and (not no-article)
1771 gnus-auto-select-first
1772 (gnus-Subject-first-unread-article))
1773 ;; Window is configured automatically.
1774 ;; Current buffer may be changed as a result of hook
1775 ;; evaluation, especially by gnus-Subject-rmail-digest
1776 ;; command, so we should adjust cursor point carefully.
1777 (if (eq (current-buffer) (get-buffer gnus-Subject-buffer))
1778 (progn
1779 ;; Adjust cursor point.
1780 (beginning-of-line)
1781 (search-forward ":" nil t)))
1782 (gnus-configure-windows 'SelectNewsgroup)
1783 (pop-to-buffer gnus-Subject-buffer)
1784 (gnus-Subject-set-mode-line)
1785 ;; I sometime get confused with the old Article buffer.
1786 (if (get-buffer gnus-Article-buffer)
1787 (if (get-buffer-window gnus-Article-buffer)
1788 (save-excursion
1789 (set-buffer gnus-Article-buffer)
1790 (let ((buffer-read-only nil))
1791 (erase-buffer)))
1792 (kill-buffer gnus-Article-buffer)))
1793 ;; Adjust cursor point.
1794 (beginning-of-line)
1795 (search-forward ":" nil t))
1797 ;; Cannot select newsgroup GROUP.
1798 (if (gnus-gethash group gnus-active-hashtb)
1799 (progn
1800 ;; If NNTP is used, nntp_access file may not be installed
1801 ;; properly. Otherwise, may be active file problem.
1802 (ding)
1803 (message "Cannot select %s. May be security or active file problem." group)
1804 (sit-for 0))
1805 ;; Check bogus newsgroups.
1806 ;; We must be in Group Mode buffer.
1807 (gnus-Group-check-bogus-groups))
1810 (defun gnus-Subject-prepare ()
1811 "Prepare subject list of current newsgroup in Subject mode buffer."
1812 (let ((buffer-read-only nil))
1813 ;; Note: The next codes are not actually used because the user who
1814 ;; want it can define them in gnus-Select-group-hook.
1815 ;; Print verbose messages if too many articles are selected.
1816 ;; (and (numberp gnus-large-newsgroup)
1817 ;; (> (length gnus-newsgroup-headers) gnus-large-newsgroup)
1818 ;; (message "Preparing headers..."))
1819 (erase-buffer)
1820 (gnus-Subject-prepare-threads
1821 (if gnus-show-threads
1822 (gnus-make-threads gnus-newsgroup-headers)
1823 gnus-newsgroup-headers) 0)
1824 ;; Erase header retrieval message.
1825 (message "")
1826 ;; Call hooks for modifying Subject mode buffer.
1827 ;; Suggested by sven@tde.LTH.Se (Sven Mattisson).
1828 (goto-char (point-min))
1829 (run-hooks 'gnus-Subject-prepare-hook)
1832 ;; Basic ideas by Paul Dworkin <paul@media-lab.media.mit.edu>
1834 (defun gnus-Subject-prepare-threads (threads level)
1835 "Prepare Subject buffer from THREADS and indentation LEVEL.
1836 THREADS is a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...]).'"
1837 (let ((thread nil)
1838 (header nil)
1839 (number nil)
1840 ;; `M Indent NUM: [OPT] SUBJECT'
1841 (cntl (format "%%s %%s%%%dd: [%%s] %%s\n"
1842 (length (prin1-to-string gnus-newsgroup-end)))))
1843 (while threads
1844 (setq thread (car threads))
1845 (setq threads (cdr threads))
1846 ;; If thread is a cons, hierarchical threads is given.
1847 ;; Otherwise, thread itself is header.
1848 (if (consp thread)
1849 (setq header (car thread))
1850 (setq header thread))
1851 ;; Print valid header only.
1852 (if (vectorp header) ;Depends on nntp.el.
1853 (progn
1854 (setq number (nntp-header-number header))
1855 (insert
1856 (format cntl
1857 ;; Read or not.
1858 (cond ((memq number gnus-newsgroup-marked) "-")
1859 ((memq number gnus-newsgroup-unreads) " ")
1860 (t "D"))
1861 ;; Thread level.
1862 (make-string (* level gnus-thread-indent-level) ? )
1863 ;; Article number.
1864 number
1865 ;; Optional headers.
1866 (or (and gnus-optional-headers
1867 (funcall gnus-optional-headers header)) "")
1868 ;; Its subject string.
1869 (concat (if (or (zerop level)
1870 (not gnus-thread-hide-subject))
1872 (make-string (window-width) ? ))
1873 (nntp-header-subject header))
1876 ;; Print subthreads.
1877 (and (consp thread)
1878 (cdr thread)
1879 (gnus-Subject-prepare-threads (cdr thread) (1+ level)))
1882 (defun gnus-Subject-set-mode-line ()
1883 "Set Subject mode line string."
1884 ;; The value must be a string to escape %-constructs.
1885 (let ((subject
1886 (if gnus-current-headers
1887 (nntp-header-subject gnus-current-headers) gnus-newsgroup-name)))
1888 (setq mode-line-buffer-identification
1889 (concat "GNUS: "
1890 subject
1891 ;; Enough spaces to pad subject to 17 positions.
1892 (make-string (max 0 (- 17 (length subject))) ? ))))
1893 (set-buffer-modified-p t))
1895 ;; GNUS Subject mode command.
1897 (defun gnus-Subject-search-group (&optional backward)
1898 "Search for next unread newsgroup.
1899 If optional argument BACKWARD is non-nil, search backward instead."
1900 (save-excursion
1901 (set-buffer gnus-Group-buffer)
1902 (save-excursion
1903 ;; We don't want to alter current point of Group mode buffer.
1904 (if (gnus-Group-search-forward backward nil)
1905 (gnus-Group-group-name))
1908 (defun gnus-Subject-search-subject (backward unread subject)
1909 "Search for article forward.
1910 If first argument BACKWARD is non-nil, search backward.
1911 If second argument UNREAD is non-nil, only unread article is selected.
1912 If third argument SUBJECT is non-nil, the article which has
1913 the same subject will be searched for."
1914 (let ((func (if backward 're-search-backward 're-search-forward))
1915 (article nil)
1916 ;; We have to take care of hidden lines.
1917 (regexp
1918 (format "^%s[ \t]+\\([0-9]+\\):.\\[[^]\r\n]*\\][ \t]+%s"
1919 ;;(if unread " " ".")
1920 (cond ((eq unread t) " ") (unread "[ ---]") (t "."))
1921 (if subject
1922 (concat "\\([Rr][Ee]:[ \t]+\\)*"
1923 (regexp-quote (gnus-simplify-subject subject))
1924 ;; Ignore words in parentheses.
1925 "\\([ \t]*([^\r\n]*)\\)*[ \t]*\\(\r\\|$\\)")
1928 (if backward
1929 (beginning-of-line)
1930 (end-of-line))
1931 (if (funcall func regexp nil t)
1932 (setq article
1933 (string-to-int
1934 (buffer-substring (match-beginning 1) (match-end 1)))))
1935 ;; Adjust cursor point.
1936 (beginning-of-line)
1937 (search-forward ":" nil t)
1938 ;; This is the result.
1939 article
1942 (defun gnus-Subject-search-forward (&optional unread subject)
1943 "Search for article forward.
1944 If first optional argument UNREAD is non-nil, only unread article is selected.
1945 If second optional argument SUBJECT is non-nil, the article which has
1946 the same subject will be searched for."
1947 (gnus-Subject-search-subject nil unread subject))
1949 (defun gnus-Subject-search-backward (&optional unread subject)
1950 "Search for article backward.
1951 If first optional argument UNREAD is non-nil, only unread article is selected.
1952 If second optional argument SUBJECT is non-nil, the article which has
1953 the same subject will be searched for."
1954 (gnus-Subject-search-subject t unread subject))
1956 (defun gnus-Subject-article-number ()
1957 "Article number around point. If nothing, return current number."
1958 (save-excursion
1959 (beginning-of-line)
1960 (if (looking-at ".[ \t]+\\([0-9]+\\):")
1961 (string-to-int
1962 (buffer-substring (match-beginning 1) (match-end 1)))
1963 ;; If search fail, return current article number.
1964 gnus-current-article
1967 (defun gnus-Subject-subject-string ()
1968 "Return current subject string or nil if nothing."
1969 (save-excursion
1970 ;; It is possible to implement this function using
1971 ;; `gnus-Subject-article-number' and `gnus-newsgroup-headers'.
1972 (beginning-of-line)
1973 ;; We have to take care of hidden lines.
1974 (if (looking-at ".[ \t]+[0-9]+:.\\[[^]\r\n]*\\][ \t]+\\([^\r\n]*\\)[\r\n]")
1975 (buffer-substring (match-beginning 1) (match-end 1)))
1978 (defun gnus-Subject-goto-subject (article)
1979 "Move point to ARTICLE's subject."
1980 (interactive
1981 (list
1982 (string-to-int
1983 (completing-read "Article number: "
1984 (mapcar
1985 (function
1986 (lambda (headers)
1987 (list
1988 (int-to-string (nntp-header-number headers)))))
1989 gnus-newsgroup-headers)
1990 nil 'require-match))))
1991 (let ((current (point)))
1992 (goto-char (point-min))
1993 (or (and article (re-search-forward (format "^.[ \t]+%d:" article) nil t))
1994 (progn (goto-char current) nil))
1997 (defun gnus-Subject-recenter ()
1998 "Center point in Subject mode window."
1999 ;; Scroll window so as to cursor comes center of Subject mode window
2000 ;; only when article is displayed.
2001 ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
2002 ;; Recenter only when requested.
2003 ;; Suggested by popovich@park.cs.columbia.edu
2004 (and gnus-auto-center-subject
2005 (get-buffer-window gnus-Article-buffer)
2006 (< (/ (- (window-height) 1) 2)
2007 (count-lines (point) (point-max)))
2008 (recenter (/ (- (window-height) 2) 2))))
2010 ;; Walking around Group mode buffer.
2012 (defun gnus-Subject-jump-to-group (newsgroup)
2013 "Move point to NEWSGROUP in Group mode buffer."
2014 ;; Keep update point of Group mode buffer if visible.
2015 (if (eq (current-buffer)
2016 (get-buffer gnus-Group-buffer))
2017 (save-window-excursion
2018 ;; Take care of tree window mode.
2019 (if (get-buffer-window gnus-Group-buffer)
2020 (pop-to-buffer gnus-Group-buffer))
2021 (gnus-Group-jump-to-group newsgroup))
2022 (save-excursion
2023 ;; Take care of tree window mode.
2024 (if (get-buffer-window gnus-Group-buffer)
2025 (pop-to-buffer gnus-Group-buffer)
2026 (set-buffer gnus-Group-buffer))
2027 (gnus-Group-jump-to-group newsgroup))))
2029 (defun gnus-Subject-next-group (no-article)
2030 "Exit current newsgroup and then select next unread newsgroup.
2031 If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
2032 (interactive "P")
2033 ;; Make sure Group mode buffer point is on current newsgroup.
2034 (gnus-Subject-jump-to-group gnus-newsgroup-name)
2035 (let ((group (gnus-Subject-search-group)))
2036 (if (null group)
2037 (progn
2038 (message "Exiting %s..." gnus-newsgroup-name)
2039 (gnus-Subject-exit)
2040 (message ""))
2041 (message "Selecting %s..." group)
2042 (gnus-Subject-exit t) ;Exit Subject mode temporary.
2043 ;; We are now in Group mode buffer.
2044 ;; Make sure Group mode buffer point is on GROUP.
2045 (gnus-Subject-jump-to-group group)
2046 (gnus-Subject-read-group group nil no-article)
2047 (or (eq (current-buffer)
2048 (get-buffer gnus-Subject-buffer))
2049 (eq gnus-auto-select-next t)
2050 ;; Expected newsgroup has nothing to read since the articles
2051 ;; are marked as read by cross-referencing. So, try next
2052 ;; newsgroup. (Make sure we are in Group mode buffer now.)
2053 (and (eq (current-buffer)
2054 (get-buffer gnus-Group-buffer))
2055 (gnus-Group-group-name)
2056 (gnus-Subject-read-group
2057 (gnus-Group-group-name) nil no-article))
2061 (defun gnus-Subject-prev-group (no-article)
2062 "Exit current newsgroup and then select previous unread newsgroup.
2063 If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
2064 (interactive "P")
2065 ;; Make sure Group mode buffer point is on current newsgroup.
2066 (gnus-Subject-jump-to-group gnus-newsgroup-name)
2067 (let ((group (gnus-Subject-search-group t)))
2068 (if (null group)
2069 (progn
2070 (message "Exiting %s..." gnus-newsgroup-name)
2071 (gnus-Subject-exit)
2072 (message ""))
2073 (message "Selecting %s..." group)
2074 (gnus-Subject-exit t) ;Exit Subject mode temporary.
2075 ;; We are now in Group mode buffer.
2076 ;; We have to adjust point of Group mode buffer because current
2077 ;; point is moved to next unread newsgroup by exiting.
2078 (gnus-Subject-jump-to-group group)
2079 (gnus-Subject-read-group group nil no-article)
2080 (or (eq (current-buffer)
2081 (get-buffer gnus-Subject-buffer))
2082 (eq gnus-auto-select-next t)
2083 ;; Expected newsgroup has nothing to read since the articles
2084 ;; are marked as read by cross-referencing. So, try next
2085 ;; newsgroup. (Make sure we are in Group mode buffer now.)
2086 (and (eq (current-buffer)
2087 (get-buffer gnus-Group-buffer))
2088 (gnus-Subject-search-group t)
2089 (gnus-Subject-read-group
2090 (gnus-Subject-search-group t) nil no-article))
2094 ;; Walking around subject lines.
2096 (defun gnus-Subject-next-subject (n &optional unread)
2097 "Go to next N'th subject line.
2098 If optional argument UNREAD is non-nil, only unread article is selected."
2099 (interactive "p")
2100 (while (and (> n 1)
2101 (gnus-Subject-search-forward unread))
2102 (setq n (1- n)))
2103 (cond ((gnus-Subject-search-forward unread)
2104 (gnus-Subject-recenter))
2105 (unread
2106 (message "No more unread articles"))
2108 (message "No more articles"))
2111 (defun gnus-Subject-next-unread-subject (n)
2112 "Go to next N'th unread subject line."
2113 (interactive "p")
2114 (gnus-Subject-next-subject n t))
2116 (defun gnus-Subject-prev-subject (n &optional unread)
2117 "Go to previous N'th subject line.
2118 If optional argument UNREAD is non-nil, only unread article is selected."
2119 (interactive "p")
2120 (while (and (> n 1)
2121 (gnus-Subject-search-backward unread))
2122 (setq n (1- n)))
2123 (cond ((gnus-Subject-search-backward unread)
2124 (gnus-Subject-recenter))
2125 (unread
2126 (message "No more unread articles"))
2128 (message "No more articles"))
2131 (defun gnus-Subject-prev-unread-subject (n)
2132 "Go to previous N'th unread subject line."
2133 (interactive "p")
2134 (gnus-Subject-prev-subject n t))
2136 ;; Walking around subject lines with displaying articles.
2138 (defun gnus-Subject-expand-window ()
2139 "Expand Subject window to show headers full window."
2140 (interactive)
2141 (gnus-configure-windows 'ExpandSubject)
2142 (pop-to-buffer gnus-Subject-buffer))
2144 (defun gnus-Subject-display-article (article &optional all-header)
2145 "Display ARTICLE in Article buffer."
2146 (if (null article)
2148 (gnus-configure-windows 'SelectArticle)
2149 (pop-to-buffer gnus-Subject-buffer)
2150 (gnus-Article-prepare article all-header)
2151 (gnus-Subject-recenter)
2152 (gnus-Subject-set-mode-line)
2153 (run-hooks 'gnus-Select-article-hook)
2154 ;; Successfully display article.
2158 (defun gnus-Subject-select-article (&optional all-headers force)
2159 "Select the current article.
2160 Optional argument ALL-HEADERS is non-nil, show all headers."
2161 (let ((article (gnus-Subject-article-number)))
2162 (if (or (null gnus-current-article)
2163 (/= article gnus-current-article)
2164 (and force (not (eq all-headers gnus-have-all-headers))))
2165 ;; The selected subject is different from that of the current article.
2166 (gnus-Subject-display-article article all-headers)
2167 (gnus-configure-windows 'SelectArticle)
2168 (pop-to-buffer gnus-Subject-buffer))
2171 (defun gnus-Subject-set-current-mark (&optional current-mark)
2172 "Put `+' at the current article.
2173 Optional argument specifies CURRENT-MARK instead of `+'."
2174 (save-excursion
2175 (set-buffer gnus-Subject-buffer)
2176 (let ((buffer-read-only nil))
2177 (goto-char (point-min))
2178 ;; First of all clear mark at last article.
2179 (if (re-search-forward "^.[ \t]+[0-9]+:[^ \t]" nil t)
2180 (progn
2181 (delete-char -1)
2182 (insert " ")
2183 (goto-char (point-min))))
2184 (if (re-search-forward (format "^.[ \t]+%d:" gnus-current-article) nil t)
2185 (progn
2186 (delete-char 1)
2187 (insert (or current-mark "+"))))
2190 (defun gnus-Subject-next-article (unread &optional subject)
2191 "Select article after current one.
2192 If argument UNREAD is non-nil, only unread article is selected."
2193 (interactive "P")
2194 (let ((header nil))
2195 (cond ((gnus-Subject-display-article
2196 (gnus-Subject-search-forward unread subject)))
2197 ((and subject
2198 gnus-auto-select-same
2199 (gnus-set-difference gnus-newsgroup-unreads
2200 gnus-newsgroup-marked)
2201 (memq this-command
2202 '(gnus-Subject-next-unread-article
2203 gnus-Subject-next-page
2204 gnus-Subject-kill-same-subject-and-select
2205 ;;gnus-Subject-next-article
2206 ;;gnus-Subject-next-same-subject
2207 ;;gnus-Subject-next-unread-same-subject
2209 ;; Wrap article pointer if there are unread articles.
2210 ;; Hook function, such as gnus-Subject-rmail-digest, may
2211 ;; change current buffer, so need check.
2212 (let ((buffer (current-buffer))
2213 (last-point (point)))
2214 ;; No more articles with same subject, so jump to the first
2215 ;; unread article.
2216 (gnus-Subject-first-unread-article)
2217 ;;(and (eq buffer (current-buffer))
2218 ;; (= (point) last-point)
2219 ;; ;; Ignore given SUBJECT, and try again.
2220 ;; (gnus-Subject-next-article unread nil))
2221 (and (eq buffer (current-buffer))
2222 (< (point) last-point)
2223 (message "Wrapped"))
2225 ((and (not unread)
2226 gnus-auto-extend-newsgroup
2227 (setq header (gnus-more-header-forward)))
2228 ;; Extend to next article if possible.
2229 ;; Basic ideas by himacdonald@watdragon.waterloo.edu
2230 (gnus-extend-newsgroup header nil)
2231 ;; Threads feature must be turned off.
2232 (let ((buffer-read-only nil))
2233 (goto-char (point-max))
2234 (gnus-Subject-prepare-threads (list header) 0))
2235 (gnus-Subject-goto-article gnus-newsgroup-end))
2237 ;; Select next newsgroup automatically if requested.
2238 (let ((cmd (string-to-char (this-command-keys)))
2239 (group (gnus-Subject-search-group))
2240 (auto-select
2241 (and gnus-auto-select-next
2242 ;;(null (gnus-set-difference gnus-newsgroup-unreads
2243 ;; gnus-newsgroup-marked))
2244 (memq this-command
2245 '(gnus-Subject-next-unread-article
2246 gnus-Subject-next-article
2247 gnus-Subject-next-page
2248 gnus-Subject-next-same-subject
2249 gnus-Subject-next-unread-same-subject
2250 gnus-Subject-kill-same-subject
2251 gnus-Subject-kill-same-subject-and-select
2253 ;; Ignore characters typed ahead.
2254 (not (input-pending-p))
2256 (message "No more%s articles%s"
2257 (if unread " unread" "")
2258 (if (and auto-select
2259 (not (eq gnus-auto-select-next 'quietly)))
2260 (if group
2261 (format " (Type %s to %s [%d])"
2262 (key-description (char-to-string cmd))
2263 group
2264 (nth 1 (gnus-gethash group
2265 gnus-unread-hashtb)))
2266 (format " (Type %s to exit %s)"
2267 (key-description (char-to-string cmd))
2268 gnus-newsgroup-name
2270 ""))
2271 ;; Select next unread newsgroup automagically.
2272 (cond ((and auto-select
2273 (eq gnus-auto-select-next 'quietly))
2274 ;; Select quietly.
2275 (gnus-Subject-next-group nil))
2276 (auto-select
2277 ;; Confirm auto selection.
2278 (let ((char (read-char)))
2279 (if (= char cmd)
2280 (gnus-Subject-next-group nil)
2281 (setq unread-command-char char))))
2286 (defun gnus-Subject-next-unread-article ()
2287 "Select unread article after current one."
2288 (interactive)
2289 (gnus-Subject-next-article t (and gnus-auto-select-same
2290 (gnus-Subject-subject-string))))
2292 (defun gnus-Subject-prev-article (unread &optional subject)
2293 "Select article before current one.
2294 If argument UNREAD is non-nil, only unread article is selected."
2295 (interactive "P")
2296 (let ((header nil))
2297 (cond ((gnus-Subject-display-article
2298 (gnus-Subject-search-backward unread subject)))
2299 ((and subject
2300 gnus-auto-select-same
2301 (gnus-set-difference gnus-newsgroup-unreads
2302 gnus-newsgroup-marked)
2303 (memq this-command
2304 '(gnus-Subject-prev-unread-article
2305 ;;gnus-Subject-prev-page
2306 ;;gnus-Subject-prev-article
2307 ;;gnus-Subject-prev-same-subject
2308 ;;gnus-Subject-prev-unread-same-subject
2310 ;; Ignore given SUBJECT, and try again.
2311 (gnus-Subject-prev-article unread nil))
2312 (unread
2313 (message "No more unread articles"))
2314 ((and gnus-auto-extend-newsgroup
2315 (setq header (gnus-more-header-backward)))
2316 ;; Extend to previous article if possible.
2317 ;; Basic ideas by himacdonald@watdragon.waterloo.edu
2318 (gnus-extend-newsgroup header t)
2319 (let ((buffer-read-only nil))
2320 (goto-char (point-min))
2321 (gnus-Subject-prepare-threads (list header) 0))
2322 (gnus-Subject-goto-article gnus-newsgroup-begin))
2324 (message "No more articles"))
2327 (defun gnus-Subject-prev-unread-article ()
2328 "Select unred article before current one."
2329 (interactive)
2330 (gnus-Subject-prev-article t (and gnus-auto-select-same
2331 (gnus-Subject-subject-string))))
2333 (defun gnus-Subject-next-page (lines)
2334 "Show next page of selected article.
2335 If end of artile, select next article.
2336 Argument LINES specifies lines to be scrolled up."
2337 (interactive "P")
2338 (let ((article (gnus-Subject-article-number))
2339 (endp nil))
2340 (if (or (null gnus-current-article)
2341 (/= article gnus-current-article))
2342 ;; Selected subject is different from current article's.
2343 (gnus-Subject-display-article article)
2344 (gnus-configure-windows 'SelectArticle)
2345 (pop-to-buffer gnus-Subject-buffer)
2346 (gnus-eval-in-buffer-window gnus-Article-buffer
2347 (setq endp (gnus-Article-next-page lines)))
2348 (cond ((and endp lines)
2349 (message "End of message"))
2350 ((and endp (null lines))
2351 (gnus-Subject-next-unread-article)))
2354 (defun gnus-Subject-prev-page (lines)
2355 "Show previous page of selected article.
2356 Argument LINES specifies lines to be scrolled down."
2357 (interactive "P")
2358 (let ((article (gnus-Subject-article-number)))
2359 (if (or (null gnus-current-article)
2360 (/= article gnus-current-article))
2361 ;; Selected subject is different from current article's.
2362 (gnus-Subject-display-article article)
2363 (gnus-configure-windows 'SelectArticle)
2364 (pop-to-buffer gnus-Subject-buffer)
2365 (gnus-eval-in-buffer-window gnus-Article-buffer
2366 (gnus-Article-prev-page lines))
2369 (defun gnus-Subject-scroll-up (lines)
2370 "Scroll up (or down) one line current article.
2371 Argument LINES specifies lines to be scrolled up (or down if negative)."
2372 (interactive "p")
2373 (gnus-Subject-select-article)
2374 (gnus-eval-in-buffer-window gnus-Article-buffer
2375 (cond ((> lines 0)
2376 (if (gnus-Article-next-page lines)
2377 (message "End of message")))
2378 ((< lines 0)
2379 (gnus-Article-prev-page (- 0 lines))))
2382 (defun gnus-Subject-next-same-subject ()
2383 "Select next article which has the same subject as current one."
2384 (interactive)
2385 (gnus-Subject-next-article nil (gnus-Subject-subject-string)))
2387 (defun gnus-Subject-prev-same-subject ()
2388 "Select previous article which has the same subject as current one."
2389 (interactive)
2390 (gnus-Subject-prev-article nil (gnus-Subject-subject-string)))
2392 (defun gnus-Subject-next-unread-same-subject ()
2393 "Select next unread article which has the same subject as current one."
2394 (interactive)
2395 (gnus-Subject-next-article t (gnus-Subject-subject-string)))
2397 (defun gnus-Subject-prev-unread-same-subject ()
2398 "Select previous unread article which has the same subject as current one."
2399 (interactive)
2400 (gnus-Subject-prev-article t (gnus-Subject-subject-string)))
2402 (defun gnus-Subject-refer-parent-article (child)
2403 "Refer parent article of current article.
2404 If a prefix argument CHILD is non-nil, go back to the child article
2405 using internally maintained articles history.
2406 NOTE: This command may not work with nnspool.el."
2407 (interactive "P")
2408 (gnus-Subject-select-article t t) ;Request all headers.
2409 (let ((referenced-id nil)) ;Message-id of parent or child article.
2410 (if child
2411 ;; Go back to child article using history.
2412 (gnus-Subject-refer-article nil)
2413 (gnus-eval-in-buffer-window gnus-Article-buffer
2414 ;; Look for parent Message-ID.
2415 ;; We cannot use gnus-current-headers to get references
2416 ;; because we may be looking at parent or refered article.
2417 (let ((references (gnus-fetch-field "References")))
2418 ;; Get the last message-id in the references.
2419 (and references
2420 (string-match "\\(<[^<>]+>\\)[^>]*\\'" references)
2421 (setq referenced-id
2422 (substring references
2423 (match-beginning 1) (match-end 1))))
2425 (if (stringp referenced-id)
2426 (gnus-Subject-refer-article referenced-id)
2427 (error "No more parents"))
2430 (defun gnus-Subject-refer-article (message-id)
2431 "Refer article specified by MESSAGE-ID.
2432 If MESSAGE-ID is nil or an empty string, it is popped from an
2433 internally maintained articles history.
2434 NOTE: This command may not work with nnspool.el."
2435 (interactive "sMessage-ID: ")
2436 ;; Make sure that this command depends on the fact that article
2437 ;; related information is not updated when an article is retrieved
2438 ;; by Message-ID.
2439 (gnus-Subject-select-article t t) ;Request all headers.
2440 (if (and (stringp message-id)
2441 (> (length message-id) 0))
2442 (gnus-eval-in-buffer-window gnus-Article-buffer
2443 ;; Construct the correct Message-ID if necessary.
2444 ;; Suggested by tale@pawl.rpi.edu.
2445 (or (string-match "^<" message-id)
2446 (setq message-id (concat "<" message-id)))
2447 (or (string-match ">$" message-id)
2448 (setq message-id (concat message-id ">")))
2449 ;; Push current message-id on history.
2450 ;; We cannot use gnus-current-headers to get current
2451 ;; message-id because we may be looking at parent or refered
2452 ;; article.
2453 (let ((current (gnus-fetch-field "Message-ID")))
2454 (or (equal current message-id) ;Nothing to do.
2455 (equal current (car gnus-current-history))
2456 (setq gnus-current-history
2457 (cons current gnus-current-history)))
2459 ;; Pop message-id from history.
2460 (setq message-id (car gnus-current-history))
2461 (setq gnus-current-history (cdr gnus-current-history)))
2462 (if (stringp message-id)
2463 ;; Retrieve article by message-id. This may not work with nnspool.
2464 (gnus-Article-prepare message-id t)
2465 (error "No such references"))
2468 (defun gnus-Subject-next-digest (nth)
2469 "Move to head of NTH next digested message."
2470 (interactive "p")
2471 (gnus-Subject-select-article)
2472 (gnus-eval-in-buffer-window gnus-Article-buffer
2473 (gnus-Article-next-digest (or nth 1))
2476 (defun gnus-Subject-prev-digest (nth)
2477 "Move to head of NTH previous digested message."
2478 (interactive "p")
2479 (gnus-Subject-select-article)
2480 (gnus-eval-in-buffer-window gnus-Article-buffer
2481 (gnus-Article-prev-digest (or nth 1))
2484 (defun gnus-Subject-first-unread-article ()
2485 "Select first unread article. Return non-nil if successfully selected."
2486 (interactive)
2487 (let ((begin (point)))
2488 (goto-char (point-min))
2489 (if (re-search-forward "^ [ \t]+[0-9]+:" nil t)
2490 (gnus-Subject-display-article (gnus-Subject-article-number))
2491 ;; If there is no unread articles, stay there.
2492 (goto-char begin)
2493 ;;(gnus-Subject-display-article (gnus-Subject-article-number))
2494 (message "No more unread articles")
2499 (defun gnus-Subject-isearch-article ()
2500 "Do incremental search forward on current article."
2501 (interactive)
2502 (gnus-Subject-select-article)
2503 (gnus-eval-in-buffer-window gnus-Article-buffer
2504 (call-interactively 'isearch-forward)
2507 (defun gnus-Subject-search-article-forward (regexp)
2508 "Search for an article containing REGEXP forward.
2509 `gnus-Select-article-hook' is not called during the search."
2510 (interactive
2511 (list (read-string
2512 (concat "Search forward (regexp): "
2513 (if gnus-last-search-regexp
2514 (concat "(default " gnus-last-search-regexp ") "))))))
2515 (if (string-equal regexp "")
2516 (setq regexp (or gnus-last-search-regexp ""))
2517 (setq gnus-last-search-regexp regexp))
2518 (if (gnus-Subject-search-article regexp nil)
2519 (gnus-eval-in-buffer-window gnus-Article-buffer
2520 (recenter 0)
2521 ;;(sit-for 1)
2523 (error "Search failed: \"%s\"" regexp)
2526 (defun gnus-Subject-search-article-backward (regexp)
2527 "Search for an article containing REGEXP backward.
2528 `gnus-Select-article-hook' is not called during the search."
2529 (interactive
2530 (list (read-string
2531 (concat "Search backward (regexp): "
2532 (if gnus-last-search-regexp
2533 (concat "(default " gnus-last-search-regexp ") "))))))
2534 (if (string-equal regexp "")
2535 (setq regexp (or gnus-last-search-regexp ""))
2536 (setq gnus-last-search-regexp regexp))
2537 (if (gnus-Subject-search-article regexp t)
2538 (gnus-eval-in-buffer-window gnus-Article-buffer
2539 (recenter 0)
2540 ;;(sit-for 1)
2542 (error "Search failed: \"%s\"" regexp)
2545 (defun gnus-Subject-search-article (regexp &optional backward)
2546 "Search for an article containing REGEXP.
2547 Optional argument BACKWARD means do search for backward.
2548 `gnus-Select-article-hook' is not called during the search."
2549 (let ((gnus-Select-article-hook nil) ;Disable hook.
2550 (gnus-Mark-article-hook nil) ;Inhibit marking as read.
2551 (re-search
2552 (if backward
2553 (function re-search-backward) (function re-search-forward)))
2554 (found nil)
2555 (last nil))
2556 ;; Hidden thread subtrees must be searched for ,too.
2557 (gnus-Subject-show-all-threads)
2558 ;; First of all, search current article.
2559 ;; We don't want to read article again from NNTP server nor reset
2560 ;; current point.
2561 (gnus-Subject-select-article)
2562 (message "Searching article: %d..." gnus-current-article)
2563 (setq last gnus-current-article)
2564 (gnus-eval-in-buffer-window gnus-Article-buffer
2565 (save-restriction
2566 (widen)
2567 ;; Begin search from current point.
2568 (setq found (funcall re-search regexp nil t))))
2569 ;; Then search next articles.
2570 (while (and (not found)
2571 (gnus-Subject-display-article
2572 (gnus-Subject-search-subject backward nil nil)))
2573 (message "Searching article: %d..." gnus-current-article)
2574 (gnus-eval-in-buffer-window gnus-Article-buffer
2575 (save-restriction
2576 (widen)
2577 (goto-char (if backward (point-max) (point-min)))
2578 (setq found (funcall re-search regexp nil t)))
2580 (message "")
2581 ;; Adjust article pointer.
2582 (or (eq last gnus-current-article)
2583 (setq gnus-last-article last))
2584 ;; Return T if found such article.
2585 found
2588 (defun gnus-Subject-execute-command (field regexp command &optional backward)
2589 "If FIELD of article header matches REGEXP, execute COMMAND string.
2590 If FIELD is an empty string (or nil), entire article body is searched for.
2591 If optional (prefix) argument BACKWARD is non-nil, do backward instead."
2592 (interactive
2593 (list (let ((completion-ignore-case t))
2594 (completing-read "Field name: "
2595 '(("Number")("Subject")("From")
2596 ("Lines")("Date")("Id")
2597 ("Xref")("References"))
2598 nil 'require-match))
2599 (read-string "Regexp: ")
2600 (read-key-sequence "Command: ")
2601 current-prefix-arg))
2602 ;; Hidden thread subtrees must be searched for ,too.
2603 (gnus-Subject-show-all-threads)
2604 ;; We don't want to change current point nor window configuration.
2605 (save-excursion
2606 (save-window-excursion
2607 (message "Executing %s..." (key-description command))
2608 ;; We'd like to execute COMMAND interactively so as to give arguments.
2609 (gnus-execute field regexp
2610 (` (lambda ()
2611 (call-interactively '(, (key-binding command)))))
2612 backward)
2613 (message "Executing %s... done" (key-description command)))))
2615 (defun gnus-Subject-beginning-of-article ()
2616 "Go to beginning of article body"
2617 (interactive)
2618 (gnus-Subject-select-article)
2619 (gnus-eval-in-buffer-window gnus-Article-buffer
2620 (widen)
2621 (beginning-of-buffer)
2622 (if gnus-break-pages
2623 (gnus-narrow-to-page))
2626 (defun gnus-Subject-end-of-article ()
2627 "Go to end of article body"
2628 (interactive)
2629 (gnus-Subject-select-article)
2630 (gnus-eval-in-buffer-window gnus-Article-buffer
2631 (widen)
2632 (end-of-buffer)
2633 (if gnus-break-pages
2634 (gnus-narrow-to-page))
2637 (defun gnus-Subject-goto-article (article &optional all-headers)
2638 "Read ARTICLE if exists.
2639 Optional argument ALL-HEADERS means all headers are shown."
2640 (interactive
2641 (list
2642 (string-to-int
2643 (completing-read "Article number: "
2644 (mapcar
2645 (function
2646 (lambda (headers)
2647 (list
2648 (int-to-string (nntp-header-number headers)))))
2649 gnus-newsgroup-headers)
2650 nil 'require-match))))
2651 (if (gnus-Subject-goto-subject article)
2652 (gnus-Subject-display-article article all-headers)))
2654 (defun gnus-Subject-goto-last-article ()
2655 "Go to last subject line."
2656 (interactive)
2657 (if gnus-last-article
2658 (gnus-Subject-goto-article gnus-last-article)))
2660 (defun gnus-Subject-show-article ()
2661 "Force to show current article."
2662 (interactive)
2663 ;; The following is a trick to force to read the current article again.
2664 (setq gnus-have-all-headers (not gnus-have-all-headers))
2665 (gnus-Subject-select-article (not gnus-have-all-headers) t))
2667 (defun gnus-Subject-toggle-header (arg)
2668 "Show original header if pruned header currently shown, or vice versa.
2669 With arg, show original header iff arg is positive."
2670 (interactive "P")
2671 ;; Variable gnus-show-all-headers must be NIL to toggle really.
2672 (let ((gnus-show-all-headers nil)
2673 (all-headers
2674 (if (null arg) (not gnus-have-all-headers)
2675 (> (prefix-numeric-value arg) 0))))
2676 (gnus-Subject-select-article all-headers t)))
2678 (defun gnus-Subject-show-all-headers ()
2679 "Show original article header."
2680 (interactive)
2681 (gnus-Subject-select-article t t))
2683 (defun gnus-Subject-stop-page-breaking ()
2684 "Stop page breaking by linefeed temporary (Widen article buffer)."
2685 (interactive)
2686 (gnus-Subject-select-article)
2687 (gnus-eval-in-buffer-window gnus-Article-buffer
2688 (widen)))
2690 (defun gnus-Subject-kill-same-subject-and-select (unmark)
2691 "Mark articles which has the same subject as read, and then select next.
2692 If argument UNMARK is positive, remove any kinds of marks.
2693 If argument UNMARK is negative, mark articles as unread instead."
2694 (interactive "P")
2695 (if unmark
2696 (setq unmark (prefix-numeric-value unmark)))
2697 (let ((count
2698 (gnus-Subject-mark-same-subject
2699 (gnus-Subject-subject-string) unmark)))
2700 ;; Select next unread article. If auto-select-same mode, should
2701 ;; select the first unread article.
2702 (gnus-Subject-next-article t (and gnus-auto-select-same
2703 (gnus-Subject-subject-string)))
2704 (message "%d articles are marked as %s"
2705 count (if unmark "unread" "read"))
2708 (defun gnus-Subject-kill-same-subject (unmark)
2709 "Mark articles which has the same subject as read.
2710 If argument UNMARK is positive, remove any kinds of marks.
2711 If argument UNMARK is negative, mark articles as unread instead."
2712 (interactive "P")
2713 (if unmark
2714 (setq unmark (prefix-numeric-value unmark)))
2715 (let ((count
2716 (gnus-Subject-mark-same-subject
2717 (gnus-Subject-subject-string) unmark)))
2718 ;; If marked as read, go to next unread subject.
2719 (if (null unmark)
2720 ;; Go to next unread subject.
2721 (gnus-Subject-next-subject 1 t))
2722 (message "%d articles are marked as %s"
2723 count (if unmark "unread" "read"))
2726 (defun gnus-Subject-mark-same-subject (subject &optional unmark)
2727 "Mark articles with same SUBJECT as read, and return marked number.
2728 If optional argument UNMARK is positive, remove any kinds of marks.
2729 If optional argument UNMARK is negative, mark articles as unread instead."
2730 (let ((count 1))
2731 (save-excursion
2732 (cond ((null unmark)
2733 (gnus-Subject-mark-as-read nil "K"))
2734 ((> unmark 0)
2735 (gnus-Subject-mark-as-unread nil t))
2737 (gnus-Subject-mark-as-unread)))
2738 (while (and subject
2739 (gnus-Subject-search-forward nil subject))
2740 (cond ((null unmark)
2741 (gnus-Subject-mark-as-read nil "K"))
2742 ((> unmark 0)
2743 (gnus-Subject-mark-as-unread nil t))
2745 (gnus-Subject-mark-as-unread)))
2746 (setq count (1+ count))
2748 ;; Hide killed thread subtrees. Does not work properly always.
2749 ;;(and (null unmark)
2750 ;; gnus-thread-hide-killed
2751 ;; (gnus-Subject-hide-thread))
2752 ;; Return number of articles marked as read.
2753 count
2756 (defun gnus-Subject-mark-as-unread-forward (count)
2757 "Mark current article as unread, and then go forward.
2758 Argument COUNT specifies number of articles marked as unread."
2759 (interactive "p")
2760 (while (> count 0)
2761 (gnus-Subject-mark-as-unread nil nil)
2762 (gnus-Subject-next-subject 1 nil)
2763 (setq count (1- count))))
2765 (defun gnus-Subject-mark-as-unread-backward (count)
2766 "Mark current article as unread, and then go backward.
2767 Argument COUNT specifies number of articles marked as unread."
2768 (interactive "p")
2769 (while (> count 0)
2770 (gnus-Subject-mark-as-unread nil nil)
2771 (gnus-Subject-prev-subject 1 nil)
2772 (setq count (1- count))))
2774 (defun gnus-Subject-mark-as-unread (&optional article clear-mark)
2775 "Mark current article as unread.
2776 Optional first argument ARTICLE specifies article number to be
2777 marked as unread. Optional second argument CLEAR-MARK removes
2778 any kind of mark."
2779 (save-excursion
2780 (set-buffer gnus-Subject-buffer)
2781 ;; First of all, show hidden thread subtrees.
2782 (gnus-Subject-show-thread)
2783 (let* ((buffer-read-only nil)
2784 (current (gnus-Subject-article-number))
2785 (article (or article current)))
2786 (gnus-mark-article-as-unread article clear-mark)
2787 (if (or (eq article current)
2788 (gnus-Subject-goto-subject article))
2789 (progn
2790 (beginning-of-line)
2791 (delete-char 1)
2792 (insert (if clear-mark " " "-"))))
2795 (defun gnus-Subject-mark-as-read-forward (count)
2796 "Mark current article as read, and then go forward.
2797 Argument COUNT specifies number of articles marked as read"
2798 (interactive "p")
2799 (while (> count 0)
2800 (gnus-Subject-mark-as-read)
2801 (gnus-Subject-next-subject 1 'unread-only)
2802 (setq count (1- count))))
2804 (defun gnus-Subject-mark-as-read-backward (count)
2805 "Mark current article as read, and then go backward.
2806 Argument COUNT specifies number of articles marked as read"
2807 (interactive "p")
2808 (while (> count 0)
2809 (gnus-Subject-mark-as-read)
2810 (gnus-Subject-prev-subject 1 'unread-only)
2811 (setq count (1- count))))
2813 (defun gnus-Subject-mark-as-read (&optional article mark)
2814 "Mark current article as read.
2815 Optional first argument ARTICLE specifies article number to be marked as read.
2816 Optional second argument MARK specifies a string inserted at beginning of line.
2817 Any kind of string (length 1) except for a space and `-' is ok."
2818 (save-excursion
2819 (set-buffer gnus-Subject-buffer)
2820 ;; First of all, show hidden thread subtrees.
2821 (gnus-Subject-show-thread)
2822 (let* ((buffer-read-only nil)
2823 (mark (or mark "D")) ;Default mark is `D'.
2824 (current (gnus-Subject-article-number))
2825 (article (or article current)))
2826 (gnus-mark-article-as-read article)
2827 (if (or (eq article current)
2828 (gnus-Subject-goto-subject article))
2829 (progn
2830 (beginning-of-line)
2831 (delete-char 1)
2832 (insert mark)))
2835 (defun gnus-Subject-clear-mark-forward (count)
2836 "Remove current article's mark, and go forward.
2837 Argument COUNT specifies number of articles unmarked"
2838 (interactive "p")
2839 (while (> count 0)
2840 (gnus-Subject-mark-as-unread nil t)
2841 (gnus-Subject-next-subject 1 nil)
2842 (setq count (1- count))))
2844 (defun gnus-Subject-clear-mark-backward (count)
2845 "Remove current article's mark, and go backward.
2846 Argument COUNT specifies number of articles unmarked"
2847 (interactive "p")
2848 (while (> count 0)
2849 (gnus-Subject-mark-as-unread nil t)
2850 (gnus-Subject-prev-subject 1 nil)
2851 (setq count (1- count))))
2853 (defun gnus-Subject-delete-marked-as-read ()
2854 "Delete lines which are marked as read."
2855 (interactive)
2856 (if gnus-newsgroup-unreads
2857 (let ((buffer-read-only nil))
2858 (save-excursion
2859 (goto-char (point-min))
2860 (delete-non-matching-lines "^[ ---]"))
2861 ;; Adjust point.
2862 (if (eobp)
2863 (gnus-Subject-prev-subject 1)
2864 (beginning-of-line)
2865 (search-forward ":" nil t)))
2866 ;; It is not so good idea to make the buffer empty.
2867 (message "All articles are marked as read")
2870 (defun gnus-Subject-delete-marked-with (marks)
2871 "Delete lines which are marked with MARKS (e.g. \"DK\")."
2872 (interactive "sMarks: ")
2873 (let ((buffer-read-only nil))
2874 (save-excursion
2875 (goto-char (point-min))
2876 (delete-matching-lines (concat "^[" marks "]")))
2877 ;; Adjust point.
2878 (or (zerop (buffer-size))
2879 (if (eobp)
2880 (gnus-Subject-prev-subject 1)
2881 (beginning-of-line)
2882 (search-forward ":" nil t)))
2885 ;; Thread-based commands.
2887 (defun gnus-Subject-toggle-threads (arg)
2888 "Toggle showing conversation threads.
2889 With arg, turn showing conversation threads on iff arg is positive."
2890 (interactive "P")
2891 (let ((current (gnus-Subject-article-number)))
2892 (setq gnus-show-threads
2893 (if (null arg) (not gnus-show-threads)
2894 (> (prefix-numeric-value arg) 0)))
2895 (gnus-Subject-prepare)
2896 (gnus-Subject-goto-subject current)
2899 (defun gnus-Subject-show-all-threads ()
2900 "Show all thread subtrees."
2901 (interactive)
2902 (if gnus-show-threads
2903 (save-excursion
2904 (let ((buffer-read-only nil))
2905 (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
2906 ))))
2908 (defun gnus-Subject-show-thread ()
2909 "Show thread subtrees."
2910 (interactive)
2911 (if gnus-show-threads
2912 (save-excursion
2913 (let ((buffer-read-only nil))
2914 (subst-char-in-region (progn
2915 (beginning-of-line) (point))
2916 (progn
2917 (end-of-line) (point))
2918 ?\^M ?\n t)
2919 ))))
2921 (defun gnus-Subject-hide-all-threads ()
2922 "Hide all thread subtrees."
2923 (interactive)
2924 (if gnus-show-threads
2925 (save-excursion
2926 ;; Adjust cursor point.
2927 (goto-char (point-min))
2928 (search-forward ":" nil t)
2929 (let ((level (current-column)))
2930 (gnus-Subject-hide-thread)
2931 (while (gnus-Subject-search-forward)
2932 (and (>= level (current-column))
2933 (gnus-Subject-hide-thread)))
2934 ))))
2936 (defun gnus-Subject-hide-thread ()
2937 "Hide thread subtrees."
2938 (interactive)
2939 (if gnus-show-threads
2940 (save-excursion
2941 ;; Adjust cursor point.
2942 (beginning-of-line)
2943 (search-forward ":" nil t)
2944 (let ((buffer-read-only nil)
2945 (init (point))
2946 (last (point))
2947 (level (current-column)))
2948 (while (and (gnus-Subject-search-forward)
2949 (< level (current-column)))
2950 ;; Interested in lower levels.
2951 (if (< level (current-column))
2952 (progn
2953 (setq last (point))
2956 (subst-char-in-region init last ?\n ?\^M t)
2957 ))))
2959 (defun gnus-Subject-next-thread (n)
2960 "Go to the same level next thread.
2961 Argument N specifies the number of threads."
2962 (interactive "p")
2963 ;; Adjust cursor point.
2964 (beginning-of-line)
2965 (search-forward ":" nil t)
2966 (let ((init (point))
2967 (last (point))
2968 (level (current-column)))
2969 (while (and (> n 0)
2970 (gnus-Subject-search-forward)
2971 (<= level (current-column)))
2972 ;; We have to skip lower levels.
2973 (if (= level (current-column))
2974 (progn
2975 (setq last (point))
2976 (setq n (1- n))
2979 ;; Return non-nil if successfully move to the next.
2980 (prog1 (not (= init last))
2981 (goto-char last))
2984 (defun gnus-Subject-prev-thread (n)
2985 "Go to the same level previous thread.
2986 Argument N specifies the number of threads."
2987 (interactive "p")
2988 ;; Adjust cursor point.
2989 (beginning-of-line)
2990 (search-forward ":" nil t)
2991 (let ((init (point))
2992 (last (point))
2993 (level (current-column)))
2994 (while (and (> n 0)
2995 (gnus-Subject-search-backward)
2996 (<= level (current-column)))
2997 ;; We have to skip lower levels.
2998 (if (= level (current-column))
2999 (progn
3000 (setq last (point))
3001 (setq n (1- n))
3004 ;; Return non-nil if successfully move to the previous.
3005 (prog1 (not (= init last))
3006 (goto-char last))
3009 (defun gnus-Subject-down-thread (d)
3010 "Go downward current thread.
3011 Argument D specifies the depth goes down."
3012 (interactive "p")
3013 ;; Adjust cursor point.
3014 (beginning-of-line)
3015 (search-forward ":" nil t)
3016 (let ((last (point))
3017 (level (current-column)))
3018 (while (and (> d 0)
3019 (gnus-Subject-search-forward)
3020 (<= level (current-column))) ;<= can be <. Which do you like?
3021 ;; We have to skip the same levels.
3022 (if (< level (current-column))
3023 (progn
3024 (setq last (point))
3025 (setq level (current-column))
3026 (setq d (1- d))
3029 (goto-char last)
3032 (defun gnus-Subject-up-thread (d)
3033 "Go upward current thread.
3034 Argument D specifies the depth goes up."
3035 (interactive "p")
3036 ;; Adjust cursor point.
3037 (beginning-of-line)
3038 (search-forward ":" nil t)
3039 (let ((last (point))
3040 (level (current-column)))
3041 (while (and (> d 0)
3042 (gnus-Subject-search-backward))
3043 ;; We have to skip the same levels.
3044 (if (> level (current-column))
3045 (progn
3046 (setq last (point))
3047 (setq level (current-column))
3048 (setq d (1- d))
3051 (goto-char last)
3054 (defun gnus-Subject-kill-thread (unmark)
3055 "Mark articles under current thread as read.
3056 If argument UNMARK is positive, remove any kinds of marks.
3057 If argument UNMARK is negative, mark articles as unread instead."
3058 (interactive "P")
3059 (if unmark
3060 (setq unmark (prefix-numeric-value unmark)))
3061 ;; Adjust cursor point.
3062 (beginning-of-line)
3063 (search-forward ":" nil t)
3064 (save-excursion
3065 (let ((level (current-column)))
3066 ;; Mark current article.
3067 (cond ((null unmark)
3068 (gnus-Subject-mark-as-read nil "K"))
3069 ((> unmark 0)
3070 (gnus-Subject-mark-as-unread nil t))
3072 (gnus-Subject-mark-as-unread))
3074 ;; Mark following articles.
3075 (while (and (gnus-Subject-search-forward)
3076 (< level (current-column)))
3077 (cond ((null unmark)
3078 (gnus-Subject-mark-as-read nil "K"))
3079 ((> unmark 0)
3080 (gnus-Subject-mark-as-unread nil t))
3082 (gnus-Subject-mark-as-unread))
3085 ;; Hide killed subtrees.
3086 (and (null unmark)
3087 gnus-thread-hide-killed
3088 (gnus-Subject-hide-thread))
3089 ;; If marked as read, go to next unread subject.
3090 (if (null unmark)
3091 ;; Go to next unread subject.
3092 (gnus-Subject-next-subject 1 t))
3095 (defun gnus-Subject-toggle-truncation (arg)
3096 "Toggle truncation of subject lines.
3097 With ARG, turn line truncation on iff ARG is positive."
3098 (interactive "P")
3099 (setq truncate-lines
3100 (if (null arg) (not truncate-lines)
3101 (> (prefix-numeric-value arg) 0)))
3102 (redraw-display))
3104 (defun gnus-Subject-sort-by-number (reverse)
3105 "Sort subject display buffer by article number.
3106 Argument REVERSE means reverse order."
3107 (interactive "P")
3108 (gnus-Subject-sort-subjects
3109 (function
3110 (lambda (a b)
3111 (< (nntp-header-number a) (nntp-header-number b))))
3112 reverse
3115 (defun gnus-Subject-sort-by-author (reverse)
3116 "Sort subject display buffer by author name alphabetically.
3117 If case-fold-search is non-nil, case of letters is ignored.
3118 Argument REVERSE means reverse order."
3119 (interactive "P")
3120 (gnus-Subject-sort-subjects
3121 (function
3122 (lambda (a b)
3123 (gnus-string-lessp (nntp-header-from a) (nntp-header-from b))))
3124 reverse
3127 (defun gnus-Subject-sort-by-subject (reverse)
3128 "Sort subject display buffer by subject alphabetically. `Re:'s are ignored.
3129 If case-fold-search is non-nil, case of letters is ignored.
3130 Argument REVERSE means reverse order."
3131 (interactive "P")
3132 (gnus-Subject-sort-subjects
3133 (function
3134 (lambda (a b)
3135 (gnus-string-lessp
3136 (gnus-simplify-subject (nntp-header-subject a) 're-only)
3137 (gnus-simplify-subject (nntp-header-subject b) 're-only))))
3138 reverse
3141 (defun gnus-Subject-sort-by-date (reverse)
3142 "Sort subject display buffer by posted date.
3143 Argument REVERSE means reverse order."
3144 (interactive "P")
3145 (gnus-Subject-sort-subjects
3146 (function
3147 (lambda (a b)
3148 (gnus-date-lessp (nntp-header-date a) (nntp-header-date b))))
3149 reverse
3152 (defun gnus-Subject-sort-subjects (predicate &optional reverse)
3153 "Sort subject display buffer by PREDICATE.
3154 Optional argument REVERSE means reverse order."
3155 (let ((current (gnus-Subject-article-number)))
3156 (gnus-sort-headers predicate reverse)
3157 (gnus-Subject-prepare)
3158 (gnus-Subject-goto-subject current)
3161 (defun gnus-Subject-reselect-current-group (show-all)
3162 "Once exit and then reselect the current newsgroup.
3163 Prefix argument SHOW-ALL means to select all articles."
3164 (interactive "P")
3165 (let ((current-subject (gnus-Subject-article-number)))
3166 (gnus-Subject-exit t)
3167 ;; We have to adjust the point of Group mode buffer because the
3168 ;; current point was moved to the next unread newsgroup by
3169 ;; exiting.
3170 (gnus-Subject-jump-to-group gnus-newsgroup-name)
3171 (gnus-Group-read-group show-all t)
3172 (gnus-Subject-goto-subject current-subject)
3175 (defun gnus-Subject-caesar-message (rotnum)
3176 "Caesar rotates all letters of current message by 13/47 places.
3177 With prefix arg, specifies the number of places to rotate each letter forward.
3178 Caesar rotates Japanese letters by 47 places in any case."
3179 (interactive "P")
3180 (gnus-Subject-select-article)
3181 (gnus-overload-functions)
3182 (gnus-eval-in-buffer-window gnus-Article-buffer
3183 (save-restriction
3184 (widen)
3185 ;; We don't want to jump to the beginning of the message.
3186 ;; `save-excursion' does not do its job.
3187 (move-to-window-line 0)
3188 (let ((last (point)))
3189 (news-caesar-buffer-body rotnum)
3190 (goto-char last)
3191 (recenter 0)
3195 (defun gnus-Subject-rmail-digest ()
3196 "Run RMAIL on current digest article.
3197 `gnus-Select-digest-hook' will be called with no arguments, if that
3198 value is non-nil. It is possible to modify the article so that Rmail
3199 can work with it.
3201 `gnus-Rmail-digest-hook' will be called with no arguments, if that value
3202 is non-nil. The hook is intended to customize Rmail mode."
3203 (interactive)
3204 (gnus-Subject-select-article)
3205 (require 'rmail)
3206 (let ((artbuf gnus-Article-buffer)
3207 (digbuf (get-buffer-create gnus-Digest-buffer))
3208 (mail-header-separator ""))
3209 (set-buffer digbuf)
3210 (buffer-flush-undo (current-buffer))
3211 (setq buffer-read-only nil)
3212 (erase-buffer)
3213 (insert-buffer-substring artbuf)
3214 (run-hooks 'gnus-Select-digest-hook)
3215 (gnus-convert-article-to-rmail)
3216 (goto-char (point-min))
3217 ;; Rmail initializations.
3218 (rmail-insert-rmail-file-header)
3219 (rmail-mode)
3220 (rmail-set-message-counters)
3221 (rmail-show-message)
3222 (condition-case ()
3223 (progn
3224 (undigestify-rmail-message)
3225 (rmail-expunge) ;Delete original message.
3226 ;; File name is meaningless but `save-buffer' requires it.
3227 (setq buffer-file-name "GNUS Digest")
3228 (setq mode-line-buffer-identification
3229 (concat "Digest: "
3230 (nntp-header-subject gnus-current-headers)))
3231 ;; There is no need to write this buffer to a file.
3232 (make-local-variable 'write-file-hooks)
3233 (setq write-file-hooks
3234 (list (function
3235 (lambda ()
3236 (set-buffer-modified-p nil)
3237 (message "(No changes need to be saved)")
3238 'no-need-to-write-this-buffer))))
3239 ;; Default file name saving digest messages.
3240 (setq rmail-last-rmail-file
3241 (funcall gnus-rmail-save-name
3242 gnus-newsgroup-name
3243 gnus-current-headers
3244 gnus-newsgroup-last-rmail
3246 (setq rmail-last-file
3247 (funcall gnus-mail-save-name
3248 gnus-newsgroup-name
3249 gnus-current-headers
3250 gnus-newsgroup-last-mail
3252 ;; Prevent generating new buffer named ***<N> each time.
3253 (setq rmail-summary-buffer
3254 (get-buffer-create gnus-Digest-summary-buffer))
3255 (run-hooks 'gnus-Rmail-digest-hook)
3256 ;; Take all windows safely.
3257 (gnus-configure-windows '(1 0 0))
3258 (pop-to-buffer gnus-Group-buffer)
3259 ;; Use Subject and Article windows for Digest summary and
3260 ;; Digest buffers.
3261 (if gnus-digest-show-summary
3262 (let ((gnus-Subject-buffer gnus-Digest-summary-buffer)
3263 (gnus-Article-buffer gnus-Digest-buffer))
3264 (gnus-configure-windows 'SelectArticle)
3265 (pop-to-buffer gnus-Digest-buffer)
3266 (rmail-summary)
3267 (pop-to-buffer gnus-Digest-summary-buffer)
3268 (message (substitute-command-keys
3269 "Type \\[rmail-summary-quit] to return to GNUS")))
3270 (let ((gnus-Subject-buffer gnus-Digest-buffer))
3271 (gnus-configure-windows 'ExpandSubject)
3272 (pop-to-buffer gnus-Digest-buffer)
3273 (message (substitute-command-keys
3274 "Type \\[rmail-quit] to return to GNUS")))
3276 ;; Move the buffers to the end of buffer list.
3277 (bury-buffer gnus-Article-buffer)
3278 (bury-buffer gnus-Group-buffer)
3279 (bury-buffer gnus-Digest-summary-buffer)
3280 (bury-buffer gnus-Digest-buffer))
3281 (error (set-buffer-modified-p nil)
3282 (kill-buffer digbuf)
3283 ;; This command should not signal an error because the
3284 ;; command is called from hooks.
3285 (ding) (message "Article is not a digest")))
3288 (defun gnus-Subject-save-article ()
3289 "Save this article using default saver function.
3290 Variable `gnus-default-article-saver' specifies the saver function."
3291 (interactive)
3292 (gnus-Subject-select-article
3293 (not (null gnus-save-all-headers)) gnus-save-all-headers)
3294 (if gnus-default-article-saver
3295 (call-interactively gnus-default-article-saver)
3296 (error "No default saver is defined.")))
3298 (defun gnus-Subject-save-in-rmail (&optional filename)
3299 "Append this article to Rmail file.
3300 Optional argument FILENAME specifies file name.
3301 Directory to save to is default to `gnus-article-save-directory' which
3302 is initialized from the SAVEDIR environment variable."
3303 (interactive)
3304 (gnus-Subject-select-article
3305 (not (null gnus-save-all-headers)) gnus-save-all-headers)
3306 (gnus-eval-in-buffer-window gnus-Article-buffer
3307 (save-excursion
3308 (save-restriction
3309 (widen)
3310 (let ((default-name
3311 (funcall gnus-rmail-save-name
3312 gnus-newsgroup-name
3313 gnus-current-headers
3314 gnus-newsgroup-last-rmail
3316 (or filename
3317 (setq filename
3318 (read-file-name
3319 (concat "Save article in Rmail file: (default "
3320 (file-name-nondirectory default-name)
3321 ") ")
3322 (file-name-directory default-name)
3323 default-name)))
3324 (gnus-make-directory (file-name-directory filename))
3325 (gnus-output-to-rmail filename)
3326 ;; Remember the directory name to save articles.
3327 (setq gnus-newsgroup-last-rmail filename)
3331 (defun gnus-Subject-save-in-mail (&optional filename)
3332 "Append this article to Unix mail file.
3333 Optional argument FILENAME specifies file name.
3334 Directory to save to is default to `gnus-article-save-directory' which
3335 is initialized from the SAVEDIR environment variable."
3336 (interactive)
3337 (gnus-Subject-select-article
3338 (not (null gnus-save-all-headers)) gnus-save-all-headers)
3339 (gnus-eval-in-buffer-window gnus-Article-buffer
3340 (save-excursion
3341 (save-restriction
3342 (widen)
3343 (let ((default-name
3344 (funcall gnus-mail-save-name
3345 gnus-newsgroup-name
3346 gnus-current-headers
3347 gnus-newsgroup-last-mail
3349 (or filename
3350 (setq filename
3351 (read-file-name
3352 (concat "Save article in Unix mail file: (default "
3353 (file-name-nondirectory default-name)
3354 ") ")
3355 (file-name-directory default-name)
3356 default-name)))
3357 (gnus-make-directory (file-name-directory filename))
3358 (rmail-output filename)
3359 ;; Remember the directory name to save articles.
3360 (setq gnus-newsgroup-last-mail filename)
3364 (defun gnus-Subject-save-in-file (&optional filename)
3365 "Append this article to file.
3366 Optional argument FILENAME specifies file name.
3367 Directory to save to is default to `gnus-article-save-directory' which
3368 is initialized from the SAVEDIR environment variable."
3369 (interactive)
3370 (gnus-Subject-select-article
3371 (not (null gnus-save-all-headers)) gnus-save-all-headers)
3372 (gnus-eval-in-buffer-window gnus-Article-buffer
3373 (save-excursion
3374 (save-restriction
3375 (widen)
3376 (let ((default-name
3377 (funcall gnus-file-save-name
3378 gnus-newsgroup-name
3379 gnus-current-headers
3380 gnus-newsgroup-last-file
3382 (or filename
3383 (setq filename
3384 (read-file-name
3385 (concat "Save article in file: (default "
3386 (file-name-nondirectory default-name)
3387 ") ")
3388 (file-name-directory default-name)
3389 default-name)))
3390 (gnus-make-directory (file-name-directory filename))
3391 (gnus-output-to-file filename)
3392 ;; Remember the directory name to save articles.
3393 (setq gnus-newsgroup-last-file filename)
3397 (defun gnus-Subject-save-in-folder (&optional folder)
3398 "Save this article to MH folder (using `rcvstore' in MH library).
3399 Optional argument FOLDER specifies folder name."
3400 (interactive)
3401 (gnus-Subject-select-article
3402 (not (null gnus-save-all-headers)) gnus-save-all-headers)
3403 (gnus-eval-in-buffer-window gnus-Article-buffer
3404 (save-restriction
3405 (widen)
3406 ;; Thanks to yuki@flab.Fujitsu.JUNET and ohm@kaba.junet.
3407 (mh-find-path)
3408 (let ((folder
3409 (or folder
3410 (mh-prompt-for-folder "Save article in"
3411 (funcall gnus-folder-save-name
3412 gnus-newsgroup-name
3413 gnus-current-headers
3414 gnus-newsgroup-last-folder
3418 (errbuf (get-buffer-create " *GNUS rcvstore*")))
3419 (unwind-protect
3420 (call-process-region (point-min) (point-max)
3421 (expand-file-name "rcvstore" mh-lib)
3422 nil errbuf nil folder)
3423 (set-buffer errbuf)
3424 (if (zerop (buffer-size))
3425 (message "Article saved in folder: %s" folder)
3426 (message "%s" (buffer-string)))
3427 (kill-buffer errbuf)
3428 (setq gnus-newsgroup-last-folder folder))
3432 (defun gnus-Subject-pipe-output ()
3433 "Pipe this article to subprocess."
3434 (interactive)
3435 ;; Ignore `gnus-save-all-headers' since this is not save command.
3436 (gnus-Subject-select-article)
3437 (gnus-eval-in-buffer-window gnus-Article-buffer
3438 (save-restriction
3439 (widen)
3440 (let ((command (read-string "Shell command on article: "
3441 gnus-last-shell-command)))
3442 (if (string-equal command "")
3443 (setq command gnus-last-shell-command))
3444 (shell-command-on-region (point-min) (point-max) command nil)
3445 (setq gnus-last-shell-command command)
3449 (defun gnus-Subject-catch-up (all &optional quietly)
3450 "Mark all articles not marked as unread in this newsgroup as read.
3451 If prefix argument ALL is non-nil, all articles are marked as read."
3452 (interactive "P")
3453 (if (or quietly
3454 (y-or-n-p
3455 (if all
3456 "Do you really want to mark everything as read? "
3457 "Delete all articles not marked as unread? ")))
3458 (let ((unmarked
3459 (gnus-set-difference gnus-newsgroup-unreads
3460 (if (not all) gnus-newsgroup-marked))))
3461 (message "") ;Erase "Yes or No" question.
3462 (while unmarked
3463 (gnus-Subject-mark-as-read (car unmarked) "C")
3464 (setq unmarked (cdr unmarked))
3468 (defun gnus-Subject-catch-up-all (&optional quietly)
3469 "Mark all articles in this newsgroup as read."
3470 (interactive)
3471 (gnus-Subject-catch-up t quietly))
3473 (defun gnus-Subject-catch-up-and-exit (all &optional quietly)
3474 "Mark all articles not marked as unread in this newsgroup as read, then exit.
3475 If prefix argument ALL is non-nil, all articles are marked as read."
3476 (interactive "P")
3477 (if (or quietly
3478 (y-or-n-p
3479 (if all
3480 "Do you really want to mark everything as read? "
3481 "Delete all articles not marked as unread? ")))
3482 (let ((unmarked
3483 (gnus-set-difference gnus-newsgroup-unreads
3484 (if (not all) gnus-newsgroup-marked))))
3485 (message "") ;Erase "Yes or No" question.
3486 (while unmarked
3487 (gnus-mark-article-as-read (car unmarked))
3488 (setq unmarked (cdr unmarked)))
3489 ;; Select next newsgroup or exit.
3490 (cond ((eq gnus-auto-select-next 'quietly)
3491 ;; Select next newsgroup quietly.
3492 (gnus-Subject-next-group nil))
3494 (gnus-Subject-exit)))
3497 (defun gnus-Subject-catch-up-all-and-exit (&optional quietly)
3498 "Mark all articles in this newsgroup as read, and then exit."
3499 (interactive)
3500 (gnus-Subject-catch-up-and-exit t quietly))
3502 (defun gnus-Subject-edit-global-kill ()
3503 "Edit a global KILL file."
3504 (interactive)
3505 (setq gnus-current-kill-article (gnus-Subject-article-number))
3506 (gnus-Kill-file-edit-file nil) ;Nil stands for global KILL file.
3507 (message
3508 (substitute-command-keys
3509 "Editing a global KILL file (Type \\[gnus-Kill-file-exit] to exit)")))
3511 (defun gnus-Subject-edit-local-kill ()
3512 "Edit a local KILL file applied to the current newsgroup."
3513 (interactive)
3514 (setq gnus-current-kill-article (gnus-Subject-article-number))
3515 (gnus-Kill-file-edit-file gnus-newsgroup-name)
3516 (message
3517 (substitute-command-keys
3518 "Editing a local KILL file (Type \\[gnus-Kill-file-exit] to exit)")))
3520 (defun gnus-Subject-exit (&optional temporary)
3521 "Exit reading current newsgroup, and then return to group selection mode.
3522 gnus-Exit-group-hook is called with no arguments if that value is non-nil."
3523 (interactive)
3524 (let ((updated nil)
3525 (gnus-newsgroup-headers gnus-newsgroup-headers)
3526 (gnus-newsgroup-unreads gnus-newsgroup-unreads)
3527 (gnus-newsgroup-unselected gnus-newsgroup-unselected)
3528 (gnus-newsgroup-marked gnus-newsgroup-marked))
3529 ;; Important internal variables are save, so we can reenter
3530 ;; Subject Mode buffer even if hook changes them.
3531 (run-hooks 'gnus-Exit-group-hook)
3532 (gnus-update-unread-articles gnus-newsgroup-name
3533 (append gnus-newsgroup-unselected
3534 gnus-newsgroup-unreads)
3535 gnus-newsgroup-marked)
3536 ;; T means ignore unsubscribed newsgroups.
3537 (if gnus-use-cross-reference
3538 (setq updated
3539 (gnus-mark-as-read-by-xref gnus-newsgroup-name
3540 gnus-newsgroup-headers
3541 gnus-newsgroup-unreads
3542 (eq gnus-use-cross-reference t)
3544 ;; Do not switch windows but change the buffer to work.
3545 (set-buffer gnus-Group-buffer)
3546 ;; Update cross referenced group info.
3547 (while updated
3548 (gnus-Group-update-group (car updated) t) ;Ignore invisible group.
3549 (setq updated (cdr updated)))
3550 (gnus-Group-update-group gnus-newsgroup-name))
3551 ;; Make sure where I was, and go to next newsgroup.
3552 (gnus-Group-jump-to-group gnus-newsgroup-name)
3553 (gnus-Group-next-unread-group 1)
3554 (if temporary
3555 ;; If exiting temporary, caller should adjust Group mode
3556 ;; buffer point by itself.
3557 nil ;Nothing to do.
3558 ;; Return to Group mode buffer.
3559 (if (get-buffer gnus-Subject-buffer)
3560 (bury-buffer gnus-Subject-buffer))
3561 (if (get-buffer gnus-Article-buffer)
3562 (bury-buffer gnus-Article-buffer))
3563 (gnus-configure-windows 'ExitNewsgroup)
3564 (pop-to-buffer gnus-Group-buffer)))
3566 (defun gnus-Subject-quit ()
3567 "Quit reading current newsgroup without updating read article info."
3568 (interactive)
3569 (if (y-or-n-p "Do you really wanna quit reading this group? ")
3570 (progn
3571 (message "") ;Erase "Yes or No" question.
3572 ;; Return to Group selection mode.
3573 (if (get-buffer gnus-Subject-buffer)
3574 (bury-buffer gnus-Subject-buffer))
3575 (if (get-buffer gnus-Article-buffer)
3576 (bury-buffer gnus-Article-buffer))
3577 (gnus-configure-windows 'ExitNewsgroup)
3578 (pop-to-buffer gnus-Group-buffer)
3579 (gnus-Group-jump-to-group gnus-newsgroup-name) ;Make sure where I was.
3580 (gnus-Group-next-group 1) ;(gnus-Group-next-unread-group 1)
3583 (defun gnus-Subject-describe-briefly ()
3584 "Describe Subject mode commands briefly."
3585 (interactive)
3586 (message
3587 (concat
3588 (substitute-command-keys "\\[gnus-Subject-next-page]:Select ")
3589 (substitute-command-keys "\\[gnus-Subject-next-unread-article]:Forward ")
3590 (substitute-command-keys "\\[gnus-Subject-prev-unread-article]:Backward ")
3591 (substitute-command-keys "\\[gnus-Subject-exit]:Exit ")
3592 (substitute-command-keys "\\[gnus-Info-find-node]:Run Info ")
3593 (substitute-command-keys "\\[gnus-Subject-describe-briefly]:This help")
3598 ;;; GNUS Article Mode
3601 (if gnus-Article-mode-map
3603 (setq gnus-Article-mode-map (make-keymap))
3604 (suppress-keymap gnus-Article-mode-map)
3605 (define-key gnus-Article-mode-map " " 'gnus-Article-next-page)
3606 (define-key gnus-Article-mode-map "\177" 'gnus-Article-prev-page)
3607 (define-key gnus-Article-mode-map "r" 'gnus-Article-refer-article)
3608 (define-key gnus-Article-mode-map "o" 'gnus-Article-pop-article)
3609 (define-key gnus-Article-mode-map "h" 'gnus-Article-show-subjects)
3610 (define-key gnus-Article-mode-map "s" 'gnus-Article-show-subjects)
3611 (define-key gnus-Article-mode-map "?" 'gnus-Article-describe-briefly)
3612 (define-key gnus-Article-mode-map "\C-c\C-i" 'gnus-Info-find-node))
3614 (defun gnus-Article-mode ()
3615 "Major mode for browsing through an article.
3616 All normal editing commands are turned off.
3617 Instead, these commands are available:
3618 \\{gnus-Article-mode-map}
3620 Various hooks for customization:
3621 gnus-Article-mode-hook
3622 Entry to this mode calls the value with no arguments, if that
3623 value is non-nil.
3625 gnus-Article-prepare-hook
3626 Called with no arguments after an article is prepared for reading,
3627 if that value is non-nil."
3628 (interactive)
3629 (kill-all-local-variables)
3630 ;; Gee. Why don't you upgrade?
3631 (cond ((boundp 'mode-line-modified)
3632 (setq mode-line-modified "--- "))
3633 ((listp (default-value 'mode-line-format))
3634 (setq mode-line-format
3635 (cons "--- " (cdr (default-value 'mode-line-format))))))
3636 (make-local-variable 'global-mode-string)
3637 (setq global-mode-string nil)
3638 (setq major-mode 'gnus-Article-mode)
3639 (setq mode-name "Article")
3640 (gnus-Article-set-mode-line)
3641 (use-local-map gnus-Article-mode-map)
3642 (make-local-variable 'page-delimiter)
3643 (setq page-delimiter gnus-page-delimiter)
3644 (make-local-variable 'mail-header-separator)
3645 (setq mail-header-separator "") ;For caesar function.
3646 (buffer-flush-undo (current-buffer))
3647 (setq buffer-read-only t) ;Disable modification
3648 (run-hooks 'gnus-Article-mode-hook))
3650 (defun gnus-Article-setup-buffer ()
3651 "Initialize Article mode buffer."
3652 (or (get-buffer gnus-Article-buffer)
3653 (save-excursion
3654 (set-buffer (get-buffer-create gnus-Article-buffer))
3655 (gnus-Article-mode))
3658 (defun gnus-Article-prepare (article &optional all-headers)
3659 "Prepare ARTICLE in Article mode buffer.
3660 If optional argument ALL-HEADERS is non-nil, all headers are inserted."
3661 (save-excursion
3662 (set-buffer gnus-Article-buffer)
3663 (let ((buffer-read-only nil))
3664 (erase-buffer)
3665 (if (gnus-request-article article)
3666 (progn
3667 ;; Prepare article buffer
3668 (insert-buffer-substring nntp-server-buffer)
3669 (setq gnus-have-all-headers (or all-headers gnus-show-all-headers))
3670 (if (and (numberp article)
3671 (not (eq article gnus-current-article)))
3672 ;; Seems me that a new article is selected.
3673 (progn
3674 ;; gnus-current-article must be an article number.
3675 (setq gnus-last-article gnus-current-article)
3676 (setq gnus-current-article article)
3677 (setq gnus-current-headers
3678 (gnus-find-header-by-number gnus-newsgroup-headers
3679 gnus-current-article))
3680 ;; Clear articles history only when articles are
3681 ;; retrieved by article numbers.
3682 (setq gnus-current-history nil)
3683 (run-hooks 'gnus-Mark-article-hook)
3685 ;; Hooks for modifying contents of the article. This hook
3686 ;; must be called before being narrowed.
3687 (run-hooks 'gnus-Article-prepare-hook)
3688 ;; Delete unnecessary headers.
3689 (or gnus-have-all-headers
3690 (gnus-Article-delete-headers))
3691 ;; Do page break.
3692 (goto-char (point-min))
3693 (if gnus-break-pages
3694 (gnus-narrow-to-page))
3695 ;; Next function must be called after setting
3696 ;; `gnus-current-article' variable and narrowed to page.
3697 (gnus-Article-set-mode-line)
3699 (if (numberp article)
3700 (gnus-Subject-mark-as-read article))
3701 (ding) (message "No such article (may be canceled)"))
3704 (defun gnus-Article-show-all-headers ()
3705 "Show all article headers in Article mode buffer."
3706 (or gnus-have-all-headers
3707 (gnus-Article-prepare gnus-current-article t)))
3709 ;;(defun gnus-Article-set-mode-line ()
3710 ;; "Set Article mode line string."
3711 ;; (setq mode-line-buffer-identification
3712 ;; (list 17
3713 ;; (format "GNUS: %s {%d-%d} %d"
3714 ;; gnus-newsgroup-name
3715 ;; gnus-newsgroup-begin
3716 ;; gnus-newsgroup-end
3717 ;; gnus-current-article
3718 ;; )))
3719 ;; (set-buffer-modified-p t))
3721 (defun gnus-Article-set-mode-line ()
3722 "Set Article mode line string."
3723 (let ((unmarked
3724 (- (length gnus-newsgroup-unreads)
3725 (length (gnus-intersection
3726 gnus-newsgroup-unreads gnus-newsgroup-marked))))
3727 (unselected
3728 (- (length gnus-newsgroup-unselected)
3729 (length (gnus-intersection
3730 gnus-newsgroup-unselected gnus-newsgroup-marked)))))
3731 (setq mode-line-buffer-identification
3732 (list 17
3733 (format "GNUS: %s{%d} %s"
3734 gnus-newsgroup-name
3735 gnus-current-article
3736 ;; This is proposed by tale@pawl.rpi.edu.
3737 (cond ((and (zerop unmarked)
3738 (zerop unselected))
3739 " ")
3740 ((zerop unselected)
3741 (format "%d more" unmarked))
3743 (format "%d(+%d) more" unmarked unselected)))
3744 ))))
3745 (set-buffer-modified-p t))
3747 (defun gnus-Article-delete-headers ()
3748 "Delete unnecessary headers."
3749 (save-excursion
3750 (save-restriction
3751 (goto-char (point-min))
3752 (narrow-to-region (point-min)
3753 (progn (search-forward "\n\n" nil 'move) (point)))
3754 (goto-char (point-min))
3755 (and (stringp gnus-ignored-headers)
3756 (while (re-search-forward gnus-ignored-headers nil t)
3757 (beginning-of-line)
3758 (delete-region (point)
3759 (progn (re-search-forward "\n[^ \t]")
3760 (forward-char -1)
3761 (point)))))
3764 ;; Working on article's buffer
3766 (defun gnus-Article-next-page (lines)
3767 "Show next page of current article.
3768 If end of article, return non-nil. Otherwise return nil.
3769 Argument LINES specifies lines to be scrolled up."
3770 (interactive "P")
3771 (move-to-window-line -1)
3772 ;; Fixed by enami@ptgd.sony.co.jp (enami tsugutomo)
3773 (if (save-excursion
3774 (end-of-line)
3775 (and (pos-visible-in-window-p) ;Not continuation line.
3776 (eobp)))
3777 ;; Nothing in this page.
3778 (if (or (not gnus-break-pages)
3779 (save-excursion
3780 (save-restriction
3781 (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer?
3782 t ;Nothing more.
3783 (gnus-narrow-to-page 1) ;Go to next page.
3786 ;; More in this page.
3787 (condition-case ()
3788 (scroll-up lines)
3789 (end-of-buffer
3790 ;; Long lines may cause an end-of-buffer error.
3791 (goto-char (point-max))))
3795 (defun gnus-Article-prev-page (lines)
3796 "Show previous page of current article.
3797 Argument LINES specifies lines to be scrolled down."
3798 (interactive "P")
3799 (move-to-window-line 0)
3800 (if (and gnus-break-pages
3801 (bobp)
3802 (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer?
3803 (progn
3804 (gnus-narrow-to-page -1) ;Go to previous page.
3805 (goto-char (point-max))
3806 (recenter -1))
3807 (scroll-down lines)))
3809 (defun gnus-Article-next-digest (nth)
3810 "Move to head of NTH next digested message.
3811 Set mark at end of digested message."
3812 ;; Stop page breaking in digest mode.
3813 (widen)
3814 (end-of-line)
3815 ;; Skip NTH - 1 digest.
3816 ;; Suggested by Khalid Sattar <admin@cs.exeter.ac.uk>.
3817 ;; Digest separator is customizable.
3818 ;; Suggested by Skip Montanaro <montanaro@sprite.crd.ge.com>.
3819 (while (and (> nth 1)
3820 (re-search-forward gnus-digest-separator nil 'move))
3821 (setq nth (1- nth)))
3822 (if (re-search-forward gnus-digest-separator nil t)
3823 (let ((begin (point)))
3824 ;; Search for end of this message.
3825 (end-of-line)
3826 (if (re-search-forward gnus-digest-separator nil t)
3827 (progn
3828 (search-backward "\n\n") ;This may be incorrect.
3829 (forward-line 1))
3830 (goto-char (point-max)))
3831 (push-mark) ;Set mark at end of digested message.
3832 (goto-char begin)
3833 (beginning-of-line)
3834 ;; Show From: and Subject: fields.
3835 (recenter 1))
3836 (message "End of message")
3839 (defun gnus-Article-prev-digest (nth)
3840 "Move to head of NTH previous digested message."
3841 ;; Stop page breaking in digest mode.
3842 (widen)
3843 (beginning-of-line)
3844 ;; Skip NTH - 1 digest.
3845 ;; Suggested by Khalid Sattar <admin@cs.exeter.ac.uk>.
3846 ;; Digest separator is customizable.
3847 ;; Suggested by Skip Montanaro <montanaro@sprite.crd.ge.com>.
3848 (while (and (> nth 1)
3849 (re-search-backward gnus-digest-separator nil 'move))
3850 (setq nth (1- nth)))
3851 (if (re-search-backward gnus-digest-separator nil t)
3852 (let ((begin (point)))
3853 ;; Search for end of this message.
3854 (end-of-line)
3855 (if (re-search-forward gnus-digest-separator nil t)
3856 (progn
3857 (search-backward "\n\n") ;This may be incorrect.
3858 (forward-line 1))
3859 (goto-char (point-max)))
3860 (push-mark) ;Set mark at end of digested message.
3861 (goto-char begin)
3862 ;; Show From: and Subject: fields.
3863 (recenter 1))
3864 (goto-char (point-min))
3865 (message "Top of message")
3868 (defun gnus-Article-refer-article ()
3869 "Read article specified by message-id around point."
3870 (interactive)
3871 (save-window-excursion
3872 (save-excursion
3873 (re-search-forward ">" nil t) ;Move point to end of "<....>".
3874 (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t)
3875 (let ((message-id
3876 (buffer-substring (match-beginning 1) (match-end 1))))
3877 (set-buffer gnus-Subject-buffer)
3878 (gnus-Subject-refer-article message-id))
3879 (error "No references around point"))
3882 (defun gnus-Article-pop-article ()
3883 "Pop up article history."
3884 (interactive)
3885 (save-window-excursion
3886 (set-buffer gnus-Subject-buffer)
3887 (gnus-Subject-refer-article nil)))
3889 (defun gnus-Article-show-subjects ()
3890 "Reconfigure windows to show headers."
3891 (interactive)
3892 (gnus-configure-windows 'SelectArticle)
3893 (pop-to-buffer gnus-Subject-buffer)
3894 (gnus-Subject-goto-subject gnus-current-article))
3896 (defun gnus-Article-describe-briefly ()
3897 "Describe Article mode commands briefly."
3898 (interactive)
3899 (message
3900 (concat
3901 (substitute-command-keys "\\[gnus-Article-next-page]:Next page ")
3902 (substitute-command-keys "\\[gnus-Article-prev-page]:Prev page ")
3903 (substitute-command-keys "\\[gnus-Article-show-subjects]:Show headers ")
3904 (substitute-command-keys "\\[gnus-Info-find-node]:Run Info ")
3905 (substitute-command-keys "\\[gnus-Article-describe-briefly]:This help")
3910 ;;; GNUS KILL-File Mode
3913 (if gnus-Kill-file-mode-map
3915 (setq gnus-Kill-file-mode-map (copy-keymap emacs-lisp-mode-map))
3916 (define-key gnus-Kill-file-mode-map "\C-c\C-k\C-s" 'gnus-Kill-file-kill-by-subject)
3917 (define-key gnus-Kill-file-mode-map "\C-c\C-k\C-a" 'gnus-Kill-file-kill-by-author)
3918 (define-key gnus-Kill-file-mode-map "\C-c\C-a" 'gnus-Kill-file-apply-buffer)
3919 (define-key gnus-Kill-file-mode-map "\C-c\C-e" 'gnus-Kill-file-apply-last-sexp)
3920 (define-key gnus-Kill-file-mode-map "\C-c\C-c" 'gnus-Kill-file-exit)
3921 (define-key gnus-Kill-file-mode-map "\C-c\C-i" 'gnus-Info-find-node))
3923 (defun gnus-Kill-file-mode ()
3924 "Major mode for editing KILL file.
3926 In addition to Emacs-Lisp Mode, the following commands are available:
3928 \\[gnus-Kill-file-kill-by-subject] Insert KILL command for current subject.
3929 \\[gnus-Kill-file-kill-by-author] Insert KILL command for current author.
3930 \\[gnus-Kill-file-apply-buffer] Apply current buffer to selected newsgroup.
3931 \\[gnus-Kill-file-apply-last-sexp] Apply sexp before point to selected newsgroup.
3932 \\[gnus-Kill-file-exit] Save file and exit editing KILL file.
3933 \\[gnus-Info-find-node] Read Info about KILL file.
3935 A KILL file contains lisp expressions to be applied to a selected
3936 newsgroup. The purpose is to mark articles as read on the basis of
3937 some set of regexps. A global KILL file is applied to every newsgroup,
3938 and a local KILL file is applied to a specified newsgroup. Since a
3939 global KILL file is applied to every newsgroup, for better performance
3940 use a local one.
3942 A KILL file can contain any kind of Emacs lisp expressions expected
3943 to be evaluated in the Subject buffer. Writing lisp programs for this
3944 purpose is not so easy because the internal working of GNUS must be
3945 well-known. For this reason, GNUS provides a general function which
3946 does this easily for non-Lisp programmers.
3948 The `gnus-kill' function executes commands available in Subject Mode
3949 by their key sequences. `gnus-kill' should be called with FIELD,
3950 REGEXP and optional COMMAND and ALL. FIELD is a string representing
3951 the header field or an empty string. If FIELD is an empty string, the
3952 entire article body is searched for. REGEXP is a string which is
3953 compared with FIELD value. COMMAND is a string representing a valid
3954 key sequence in Subject Mode or Lisp expression. COMMAND is default to
3955 '(gnus-Subject-mark-as-read nil \"X\"). Make sure that COMMAND is
3956 executed in the Subject buffer. If the second optional argument ALL
3957 is non-nil, the COMMAND is applied to articles which are already
3958 marked as read or unread. Articles which are marked are skipped over
3959 by default.
3961 For example, if you want to mark articles of which subjects contain
3962 the string `AI' as read, a possible KILL file may look like:
3964 (gnus-kill \"Subject\" \"AI\")
3966 If you want to mark articles with `D' instead of `X', you can use
3967 the following expression:
3969 (gnus-kill \"Subject\" \"AI\" \"d\")
3971 In this example it is assumed that the command
3972 `gnus-Subject-mark-as-read-forward' is assigned to `d' in Subject Mode.
3974 It is possible to delete unnecessary headers which are marked with
3975 `X' in a KILL file as follows:
3977 (gnus-expunge \"X\")
3979 If the Subject buffer is empty after applying KILL files, GNUS will
3980 exit the selected newsgroup normally. If headers which are marked
3981 with `D' are deleted in a KILL file, it is impossible to read articles
3982 which are marked as read in the previous GNUS sessions. Marks other
3983 than `D' should be used for articles which should really be deleted.
3985 Entry to this mode calls emacs-lisp-mode-hook and
3986 gnus-Kill-file-mode-hook with no arguments, if that value is non-nil."
3987 (interactive)
3988 (kill-all-local-variables)
3989 (use-local-map gnus-Kill-file-mode-map)
3990 (set-syntax-table emacs-lisp-mode-syntax-table)
3991 (setq major-mode 'gnus-Kill-file-mode)
3992 (setq mode-name "KILL-File")
3993 (lisp-mode-variables nil)
3994 (run-hooks 'emacs-lisp-mode-hook 'gnus-Kill-file-mode-hook))
3996 (defun gnus-Kill-file-edit-file (newsgroup)
3997 "Begin editing a KILL file of NEWSGROUP.
3998 If NEWSGROUP is nil, the global KILL file is selected."
3999 (interactive "sNewsgroup: ")
4000 (let ((file (gnus-newsgroup-kill-file newsgroup)))
4001 (gnus-make-directory (file-name-directory file))
4002 ;; Save current window configuration if this is first invocation.
4003 (or (and (get-file-buffer file)
4004 (get-buffer-window (get-file-buffer file)))
4005 (setq gnus-winconf-kill-file (current-window-configuration)))
4006 ;; Hack windows.
4007 (let ((buffer (find-file-noselect file)))
4008 (cond ((get-buffer-window buffer)
4009 (pop-to-buffer buffer))
4010 ((eq major-mode 'gnus-Group-mode)
4011 (gnus-configure-windows '(1 0 0)) ;Take all windows.
4012 (pop-to-buffer gnus-Group-buffer)
4013 (let ((gnus-Subject-buffer buffer))
4014 (gnus-configure-windows '(1 1 0)) ;Split into two.
4015 (pop-to-buffer buffer)))
4016 ((eq major-mode 'gnus-Subject-mode)
4017 (gnus-configure-windows 'SelectArticle)
4018 (pop-to-buffer gnus-Article-buffer)
4019 (bury-buffer gnus-Article-buffer)
4020 (switch-to-buffer buffer))
4021 (t ;No good rules.
4022 (find-file-other-window file))
4024 (gnus-Kill-file-mode)
4027 (defun gnus-Kill-file-kill-by-subject ()
4028 "Insert KILL command for current subject."
4029 (interactive)
4030 (insert
4031 (format "(gnus-kill \"Subject\" %s)\n"
4032 (prin1-to-string
4033 (if gnus-current-kill-article
4034 (regexp-quote
4035 (nntp-header-subject
4036 (gnus-find-header-by-number gnus-newsgroup-headers
4037 gnus-current-kill-article)))
4038 "")))))
4040 (defun gnus-Kill-file-kill-by-author ()
4041 "Insert KILL command for current author."
4042 (interactive)
4043 (insert
4044 (format "(gnus-kill \"From\" %s)\n"
4045 (prin1-to-string
4046 (if gnus-current-kill-article
4047 (regexp-quote
4048 (nntp-header-from
4049 (gnus-find-header-by-number gnus-newsgroup-headers
4050 gnus-current-kill-article)))
4051 "")))))
4053 (defun gnus-Kill-file-apply-buffer ()
4054 "Apply current buffer to current newsgroup."
4055 (interactive)
4056 (if (and gnus-current-kill-article
4057 (get-buffer gnus-Subject-buffer))
4058 ;; Assume newsgroup is selected.
4059 (let ((string (concat "(progn \n" (buffer-string) "\n)" )))
4060 (save-excursion
4061 (save-window-excursion
4062 (pop-to-buffer gnus-Subject-buffer)
4063 (eval (car (read-from-string string))))))
4064 (ding) (message "No newsgroup is selected.")))
4066 (defun gnus-Kill-file-apply-last-sexp ()
4067 "Apply sexp before point in current buffer to current newsgroup."
4068 (interactive)
4069 (if (and gnus-current-kill-article
4070 (get-buffer gnus-Subject-buffer))
4071 ;; Assume newsgroup is selected.
4072 (let ((string
4073 (buffer-substring
4074 (save-excursion (forward-sexp -1) (point)) (point))))
4075 (save-excursion
4076 (save-window-excursion
4077 (pop-to-buffer gnus-Subject-buffer)
4078 (eval (car (read-from-string string))))))
4079 (ding) (message "No newsgroup is selected.")))
4081 (defun gnus-Kill-file-exit ()
4082 "Save a KILL file, then return to the previous buffer."
4083 (interactive)
4084 (save-buffer)
4085 (let ((killbuf (current-buffer)))
4086 ;; We don't want to return to Article buffer.
4087 (and (get-buffer gnus-Article-buffer)
4088 (bury-buffer (get-buffer gnus-Article-buffer)))
4089 ;; Delete the KILL file windows.
4090 (delete-windows-on killbuf)
4091 ;; Restore last window configuration if available.
4092 (and gnus-winconf-kill-file
4093 (set-window-configuration gnus-winconf-kill-file))
4094 (setq gnus-winconf-kill-file nil)
4095 ;; Kill the KILL file buffer. Suggested by tale@pawl.rpi.edu.
4096 (kill-buffer killbuf)))
4100 ;;; Utility functions
4103 ;; Basic ideas by emv@math.lsa.umich.edu (Edward Vielmetti)
4105 (defun gnus-batch-kill ()
4106 "Run batched KILL.
4107 Usage: emacs -batch -l gnus -f gnus-batch-kill NEWSGROUP ..."
4108 (if (not noninteractive)
4109 (error "gnus-batch-kill is to be used only with -batch"))
4110 (let* ((group nil)
4111 (subscribed nil)
4112 (newsrc nil)
4113 (yes-and-no
4114 (gnus-parse-n-options
4115 (apply (function concat)
4116 (mapcar (function (lambda (g) (concat g " ")))
4117 command-line-args-left))))
4118 (yes (car yes-and-no))
4119 (no (cdr yes-and-no))
4120 ;; Disable verbose message.
4121 (gnus-novice-user nil)
4122 (gnus-large-newsgroup nil)
4123 (nntp-large-newsgroup nil))
4124 ;; Eat all arguments.
4125 (setq command-line-args-left nil)
4126 ;; Startup GNUS.
4127 (gnus)
4128 ;; Apply kills to specified newsgroups in command line arguments.
4129 (setq newsrc (copy-sequence gnus-newsrc-assoc))
4130 (while newsrc
4131 (setq group (car (car newsrc)))
4132 (setq subscribed (nth 1 (car newsrc)))
4133 (setq newsrc (cdr newsrc))
4134 (if (and subscribed
4135 (not (zerop (nth 1 (gnus-gethash group gnus-unread-hashtb))))
4136 (if yes
4137 (string-match yes group) t)
4138 (or (null no)
4139 (not (string-match no group))))
4140 (progn
4141 (gnus-Subject-read-group group nil t)
4142 (if (eq (current-buffer) (get-buffer gnus-Subject-buffer))
4143 (gnus-Subject-exit t))
4146 ;; Finally, exit Emacs.
4147 (set-buffer gnus-Group-buffer)
4148 (gnus-Group-exit)
4151 (defun gnus-Numeric-save-name (newsgroup headers &optional last-file)
4152 "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
4153 If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group/num.
4154 Otherwise, it is like ~/News/news/group/num."
4155 (let ((default
4156 (expand-file-name
4157 (concat (if gnus-use-long-file-name
4158 (capitalize newsgroup)
4159 (gnus-newsgroup-directory-form newsgroup))
4160 "/" (int-to-string (nntp-header-number headers)))
4161 (or gnus-article-save-directory "~/News"))))
4162 (if (and last-file
4163 (string-equal (file-name-directory default)
4164 (file-name-directory last-file))
4165 (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
4166 default
4167 (or last-file default))))
4169 (defun gnus-numeric-save-name (newsgroup headers &optional last-file)
4170 "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
4171 If variable `gnus-use-long-file-name' is nil, it is ~/News/news.group/num.
4172 Otherwise, it is like ~/News/news/group/num."
4173 (let ((default
4174 (expand-file-name
4175 (concat (if gnus-use-long-file-name
4176 newsgroup
4177 (gnus-newsgroup-directory-form newsgroup))
4178 "/" (int-to-string (nntp-header-number headers)))
4179 (or gnus-article-save-directory "~/News"))))
4180 (if (and last-file
4181 (string-equal (file-name-directory default)
4182 (file-name-directory last-file))
4183 (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
4184 default
4185 (or last-file default))))
4187 (defun gnus-Plain-save-name (newsgroup headers &optional last-file)
4188 "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
4189 If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group.
4190 Otherwise, it is like ~/News/news/group/news."
4191 (or last-file
4192 (expand-file-name
4193 (if gnus-use-long-file-name
4194 (capitalize newsgroup)
4195 (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
4196 (or gnus-article-save-directory "~/News"))))
4198 (defun gnus-plain-save-name (newsgroup headers &optional last-file)
4199 "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
4200 If variable `gnus-use-long-file-name' is nil, it is ~/News/news.group.
4201 Otherwise, it is like ~/News/news/group/news."
4202 (or last-file
4203 (expand-file-name
4204 (if gnus-use-long-file-name
4205 newsgroup
4206 (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
4207 (or gnus-article-save-directory "~/News"))))
4209 (defun gnus-Folder-save-name (newsgroup headers &optional last-folder)
4210 "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER.
4211 If variable `gnus-use-long-file-name' is nil, it is +News.group.
4212 Otherwise, it is like +news/group."
4213 (or last-folder
4214 (concat "+"
4215 (if gnus-use-long-file-name
4216 (capitalize newsgroup)
4217 (gnus-newsgroup-directory-form newsgroup)))))
4219 (defun gnus-folder-save-name (newsgroup headers &optional last-folder)
4220 "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER.
4221 If variable `gnus-use-long-file-name' is nil, it is +news.group.
4222 Otherwise, it is like +news/group."
4223 (or last-folder
4224 (concat "+"
4225 (if gnus-use-long-file-name
4226 newsgroup
4227 (gnus-newsgroup-directory-form newsgroup)))))
4229 (defun gnus-apply-kill-file ()
4230 "Apply KILL file to the current newsgroup."
4231 ;; Apply the global KILL file.
4232 (load (gnus-newsgroup-kill-file nil) t nil t)
4233 ;; And then apply the local KILL file.
4234 (load (gnus-newsgroup-kill-file gnus-newsgroup-name) t nil t))
4236 (defun gnus-Newsgroup-kill-file (newsgroup)
4237 "Return the name of a KILL file of NEWSGROUP.
4238 If NEWSGROUP is nil, return the global KILL file instead."
4239 (cond ((or (null newsgroup)
4240 (string-equal newsgroup ""))
4241 ;; The global KILL file is placed at top of the directory.
4242 (expand-file-name gnus-kill-file-name
4243 (or gnus-article-save-directory "~/News")))
4244 (gnus-use-long-file-name
4245 ;; Append ".KILL" to capitalized newsgroup name.
4246 (expand-file-name (concat (capitalize newsgroup)
4247 "." gnus-kill-file-name)
4248 (or gnus-article-save-directory "~/News")))
4250 ;; Place "KILL" under the hierarchical directory.
4251 (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
4252 "/" gnus-kill-file-name)
4253 (or gnus-article-save-directory "~/News")))
4256 (defun gnus-newsgroup-kill-file (newsgroup)
4257 "Return the name of a KILL file of NEWSGROUP.
4258 If NEWSGROUP is nil, return the global KILL file instead."
4259 (cond ((or (null newsgroup)
4260 (string-equal newsgroup ""))
4261 ;; The global KILL file is placed at top of the directory.
4262 (expand-file-name gnus-kill-file-name
4263 (or gnus-article-save-directory "~/News")))
4264 (gnus-use-long-file-name
4265 ;; Append ".KILL" to newsgroup name.
4266 (expand-file-name (concat newsgroup "." gnus-kill-file-name)
4267 (or gnus-article-save-directory "~/News")))
4269 ;; Place "KILL" under the hierarchical directory.
4270 (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
4271 "/" gnus-kill-file-name)
4272 (or gnus-article-save-directory "~/News")))
4275 (defun gnus-newsgroup-directory-form (newsgroup)
4276 "Make hierarchical directory name from NEWSGROUP name."
4277 (let ((newsgroup (substring newsgroup 0)) ;Copy string.
4278 (len (length newsgroup))
4279 (idx 0))
4280 ;; Replace all occurence of `.' with `/'.
4281 (while (< idx len)
4282 (if (= (aref newsgroup idx) ?.)
4283 (aset newsgroup idx ?/))
4284 (setq idx (1+ idx)))
4285 newsgroup
4288 (defun gnus-make-directory (directory)
4289 "Make DIRECTORY recursively."
4290 (let ((directory (expand-file-name directory default-directory)))
4291 (or (file-exists-p directory)
4292 (gnus-make-directory-1 "" directory))
4295 (defun gnus-make-directory-1 (head tail)
4296 (cond ((string-match "^/\\([^/]+\\)" tail)
4297 (setq head
4298 (concat (file-name-as-directory head)
4299 (substring tail (match-beginning 1) (match-end 1))))
4300 (or (file-exists-p head)
4301 (call-process "mkdir" nil nil nil head))
4302 (gnus-make-directory-1 head (substring tail (match-end 1))))
4303 ((string-equal tail "") t)
4306 (defun gnus-simplify-subject (subject &optional re-only)
4307 "Remove `Re:' and words in parentheses.
4308 If optional argument RE-ONLY is non-nil, strip `Re:' only."
4309 (let ((case-fold-search t)) ;Ignore case.
4310 ;; Remove `Re:' and `Re^N:'.
4311 (if (string-match "\\`\\(re\\(\\^[0-9]+\\)?:[ \t]+\\)+" subject)
4312 (setq subject (substring subject (match-end 0))))
4313 ;; Remove words in parentheses from end.
4314 (or re-only
4315 (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject)
4316 (setq subject (substring subject 0 (match-beginning 0)))))
4317 ;; Return subject string.
4318 subject
4321 (defun gnus-optional-lines-and-from (header)
4322 "Return a string like `NNN:AUTHOR' from HEADER."
4323 (let ((name-length (length "umerin@photon")))
4324 (substring (format "%3d:%s"
4325 ;; Lines of the article.
4326 ;; Suggested by dana@bellcore.com.
4327 (nntp-header-lines header)
4328 ;; Its author.
4329 (concat (mail-strip-quoted-names
4330 (nntp-header-from header))
4331 (make-string name-length ? )))
4332 ;; 4 stands for length of `NNN:'.
4333 0 (+ 4 name-length))))
4335 (defun gnus-optional-lines (header)
4336 "Return a string like `NNN' from HEADER."
4337 (format "%4d" (nntp-header-lines header)))
4339 (defun gnus-sort-headers (predicate &optional reverse)
4340 "Sort current group headers by PREDICATE safely.
4341 *Safely* means C-g quitting is disabled during sorting.
4342 Optional argument REVERSE means reverse order."
4343 (let ((inhibit-quit t))
4344 (setq gnus-newsgroup-headers
4345 (if reverse
4346 (nreverse (sort (nreverse gnus-newsgroup-headers) predicate))
4347 (sort gnus-newsgroup-headers predicate)))
4350 (defun gnus-string-lessp (a b)
4351 "Return T if first arg string is less than second in lexicographic order.
4352 If case-fold-search is non-nil, case of letters is ignored."
4353 (if case-fold-search
4354 (string-lessp (downcase a) (downcase b)) (string-lessp a b)))
4356 (defun gnus-date-lessp (date1 date2)
4357 "Return T if DATE1 is earlyer than DATE2."
4358 (string-lessp (gnus-comparable-date date1)
4359 (gnus-comparable-date date2)))
4361 (defun gnus-comparable-date (date)
4362 "Make comparable string by string-lessp from DATE."
4363 (let ((month '(("JAN" . " 1")("FEB" . " 2")("MAR" . " 3")
4364 ("APR" . " 4")("MAY" . " 5")("JUN" . " 6")
4365 ("JUL" . " 7")("AUG" . " 8")("SEP" . " 9")
4366 ("OCT" . "10")("NOV" . "11")("DEC" . "12")))
4367 (date (or date "")))
4368 ;; Can understand the following styles:
4369 ;; (1) 14 Apr 89 03:20:12 GMT
4370 ;; (2) Fri, 17 Mar 89 4:01:33 GMT
4371 (if (string-match
4372 "\\([0-9]+\\) \\([^ ,]+\\) \\([0-9]+\\) \\([0-9:]+\\)" date)
4373 (concat
4374 ;; Year
4375 (substring date (match-beginning 3) (match-end 3))
4376 ;; Month
4377 (cdr
4378 (assoc
4379 (upcase (substring date (match-beginning 2) (match-end 2))) month))
4380 ;; Day
4381 (format "%2d" (string-to-int
4382 (substring date
4383 (match-beginning 1) (match-end 1))))
4384 ;; Time
4385 (substring date (match-beginning 4) (match-end 4)))
4386 ;; Cannot understand DATE string.
4387 date
4391 (defun gnus-fetch-field (field)
4392 "Return the value of the header FIELD of current article."
4393 (save-excursion
4394 (save-restriction
4395 (widen)
4396 (goto-char (point-min))
4397 (narrow-to-region (point-min)
4398 (progn (search-forward "\n\n" nil 'move) (point)))
4399 (mail-fetch-field field))))
4401 (fset 'gnus-expunge 'gnus-Subject-delete-marked-with)
4403 (defun gnus-kill (field regexp &optional command all)
4404 "If FIELD of an article matches REGEXP, execute COMMAND.
4405 Optional third argument COMMAND is default to
4406 (gnus-Subject-mark-as-read nil \"X\").
4407 If optional fourth argument ALL is non-nil, articles marked are also applied
4408 to. If FIELD is an empty string (or nil), entire article body is searched for.
4409 COMMAND must be a lisp expression or a string representing a key sequence."
4410 ;; We don't want to change current point nor window configuration.
4411 (save-excursion
4412 (save-window-excursion
4413 ;; Selected window must be Subject mode buffer to execute
4414 ;; keyboard macros correctly. See command_loop_1.
4415 (switch-to-buffer gnus-Subject-buffer 'norecord)
4416 (goto-char (point-min)) ;From the beginning.
4417 (if (null command)
4418 (setq command '(gnus-Subject-mark-as-read nil "X")))
4419 (gnus-execute field regexp command nil (not all))
4422 (defun gnus-execute (field regexp form &optional backward ignore-marked)
4423 "If FIELD of article header matches REGEXP, execute lisp FORM (or a string).
4424 If FIELD is an empty string (or nil), entire article body is searched for.
4425 If optional fifth argument BACKWARD is non-nil, do backward instead.
4426 If optional sixth argument IGNORE-MARKED is non-nil, articles which are
4427 marked as read or unread are ignored."
4428 (let ((function nil)
4429 (header nil)
4430 (article nil))
4431 (if (string-equal field "")
4432 (setq field nil))
4433 (if (null field)
4435 (or (stringp field)
4436 (setq field (symbol-name field)))
4437 ;; Get access function of header filed.
4438 (setq function (intern-soft (concat "gnus-header-" (downcase field))))
4439 (if (and function (fboundp function))
4440 (setq function (symbol-function function))
4441 (error "Unknown header field: \"%s\"" field)))
4442 ;; Make FORM funcallable.
4443 (if (and (listp form) (not (eq (car form) 'lambda)))
4444 (setq form (list 'lambda nil form)))
4445 ;; Starting from the current article.
4446 (or (and ignore-marked
4447 ;; Articles marked as read and unread should be ignored.
4448 (setq article (gnus-Subject-article-number))
4449 (or (not (memq article gnus-newsgroup-unreads)) ;Marked as read.
4450 (memq article gnus-newsgroup-marked) ;Marked as unread.
4452 (gnus-execute-1 function regexp form))
4453 (while (gnus-Subject-search-subject backward ignore-marked nil)
4454 (gnus-execute-1 function regexp form))
4457 (defun gnus-execute-1 (function regexp form)
4458 (save-excursion
4459 ;; The point of Subject mode buffer must be saved during execution.
4460 (let ((article (gnus-Subject-article-number)))
4461 (if (null article)
4462 nil ;Nothing to do.
4463 (if function
4464 ;; Compare with header field.
4465 (let ((header (gnus-find-header-by-number
4466 gnus-newsgroup-headers article))
4467 (value nil))
4468 (and header
4469 (progn
4470 (setq value (funcall function header))
4471 ;; Number (Lines:) or symbol must be converted to string.
4472 (or (stringp value)
4473 (setq value (prin1-to-string value)))
4474 (string-match regexp value))
4475 (if (stringp form) ;Keyboard macro.
4476 (execute-kbd-macro form)
4477 (funcall form))))
4478 ;; Search article body.
4479 (let ((gnus-current-article nil) ;Save article pointer.
4480 (gnus-last-article nil)
4481 (gnus-break-pages nil) ;No need to break pages.
4482 (gnus-Mark-article-hook nil)) ;Inhibit marking as read.
4483 (message "Searching for article: %d..." article)
4484 (gnus-Article-setup-buffer)
4485 (gnus-Article-prepare article t)
4486 (if (save-excursion
4487 (set-buffer gnus-Article-buffer)
4488 (goto-char (point-min))
4489 (re-search-forward regexp nil t))
4490 (if (stringp form) ;Keyboard macro.
4491 (execute-kbd-macro form)
4492 (funcall form))))
4496 ;;; caesar-region written by phr@prep.ai.mit.edu Nov 86
4497 ;;; modified by tower@prep Nov 86
4498 ;;; Modified by umerin@flab.flab.Fujitsu.JUNET for ROT47.
4500 (defun gnus-caesar-region (&optional n)
4501 "Caesar rotation of region by N, default 13, for decrypting netnews.
4502 ROT47 will be performed for Japanese text in any case."
4503 (interactive (if current-prefix-arg ; Was there a prefix arg?
4504 (list (prefix-numeric-value current-prefix-arg))
4505 (list nil)))
4506 (cond ((not (numberp n)) (setq n 13))
4507 ((< n 0) (setq n (- 26 (% (- n) 26))))
4508 (t (setq n (% n 26)))) ;canonicalize N
4509 (if (not (zerop n)) ; no action needed for a rot of 0
4510 (progn
4511 (if (or (not (boundp 'caesar-translate-table))
4512 (/= (aref caesar-translate-table ?a) (+ ?a n)))
4513 (let ((i 0) (lower "abcdefghijklmnopqrstuvwxyz") upper)
4514 (message "Building caesar-translate-table...")
4515 (setq caesar-translate-table (make-vector 256 0))
4516 (while (< i 256)
4517 (aset caesar-translate-table i i)
4518 (setq i (1+ i)))
4519 (setq lower (concat lower lower) upper (upcase lower) i 0)
4520 (while (< i 26)
4521 (aset caesar-translate-table (+ ?a i) (aref lower (+ i n)))
4522 (aset caesar-translate-table (+ ?A i) (aref upper (+ i n)))
4523 (setq i (1+ i)))
4524 ;; ROT47 for Japanese text.
4525 ;; Thanks to ichikawa@flab.fujitsu.junet.
4526 (setq i 161)
4527 (let ((t1 (logior ?O 128))
4528 (t2 (logior ?! 128))
4529 (t3 (logior ?~ 128)))
4530 (while (< i 256)
4531 (aset caesar-translate-table i
4532 (let ((v (aref caesar-translate-table i)))
4533 (if (<= v t1) (if (< v t2) v (+ v 47))
4534 (if (<= v t3) (- v 47) v))))
4535 (setq i (1+ i))))
4536 (message "Building caesar-translate-table... done")))
4537 (let ((from (region-beginning))
4538 (to (region-end))
4539 (i 0) str len)
4540 (setq str (buffer-substring from to))
4541 (setq len (length str))
4542 (while (< i len)
4543 (aset str i (aref caesar-translate-table (aref str i)))
4544 (setq i (1+ i)))
4545 (goto-char from)
4546 (delete-region from to)
4547 (insert str)))))
4549 ;; Functions accessing headers.
4550 ;; Functions are more convenient than macros in some case.
4552 (defun gnus-header-number (header)
4553 "Return article number in HEADER."
4554 (nntp-header-number header))
4556 (defun gnus-header-subject (header)
4557 "Return subject string in HEADER."
4558 (nntp-header-subject header))
4560 (defun gnus-header-from (header)
4561 "Return author string in HEADER."
4562 (nntp-header-from header))
4564 (defun gnus-header-xref (header)
4565 "Return xref string in HEADER."
4566 (nntp-header-xref header))
4568 (defun gnus-header-lines (header)
4569 "Return lines in HEADER."
4570 (nntp-header-lines header))
4572 (defun gnus-header-date (header)
4573 "Return date in HEADER."
4574 (nntp-header-date header))
4576 (defun gnus-header-id (header)
4577 "Return Id in HEADER."
4578 (nntp-header-id header))
4580 (defun gnus-header-references (header)
4581 "Return references in HEADER."
4582 (nntp-header-references header))
4586 ;;; Article savers.
4589 (defun gnus-output-to-rmail (file-name)
4590 "Append the current article to an Rmail file named FILE-NAME."
4591 (require 'rmail)
4592 ;; Most of these codes are borrowed from rmailout.el.
4593 (setq file-name (expand-file-name file-name))
4594 (setq rmail-last-rmail-file file-name)
4595 (let ((artbuf (current-buffer))
4596 (tmpbuf (get-buffer-create " *GNUS-output*")))
4597 (save-excursion
4598 (or (get-file-buffer file-name)
4599 (file-exists-p file-name)
4600 (if (yes-or-no-p
4601 (concat "\"" file-name "\" does not exist, create it? "))
4602 (let ((file-buffer (create-file-buffer file-name)))
4603 (save-excursion
4604 (set-buffer file-buffer)
4605 (rmail-insert-rmail-file-header)
4606 (let ((require-final-newline nil))
4607 (write-region (point-min) (point-max) file-name t 1)))
4608 (kill-buffer file-buffer))
4609 (error "Output file does not exist")))
4610 (set-buffer tmpbuf)
4611 (buffer-flush-undo (current-buffer))
4612 (erase-buffer)
4613 (insert-buffer-substring artbuf)
4614 (gnus-convert-article-to-rmail)
4615 ;; Decide whether to append to a file or to an Emacs buffer.
4616 (let ((outbuf (get-file-buffer file-name)))
4617 (if (not outbuf)
4618 (append-to-file (point-min) (point-max) file-name)
4619 ;; File has been visited, in buffer OUTBUF.
4620 (set-buffer outbuf)
4621 (let ((buffer-read-only nil)
4622 (msg (and (boundp 'rmail-current-message)
4623 rmail-current-message)))
4624 ;; If MSG is non-nil, buffer is in RMAIL mode.
4625 (if msg
4626 (progn (widen)
4627 (narrow-to-region (point-max) (point-max))))
4628 (insert-buffer-substring tmpbuf)
4629 (if msg
4630 (progn
4631 (goto-char (point-min))
4632 (widen)
4633 (search-backward "\^_")
4634 (narrow-to-region (point) (point-max))
4635 (goto-char (1+ (point-min)))
4636 (rmail-count-new-messages t)
4637 (rmail-show-message msg))))))
4639 (kill-buffer tmpbuf)
4642 (defun gnus-output-to-file (file-name)
4643 "Append the current article to a file named FILE-NAME."
4644 (setq file-name (expand-file-name file-name))
4645 (let ((artbuf (current-buffer))
4646 (tmpbuf (get-buffer-create " *GNUS-output*")))
4647 (save-excursion
4648 (set-buffer tmpbuf)
4649 (buffer-flush-undo (current-buffer))
4650 (erase-buffer)
4651 (insert-buffer-substring artbuf)
4652 ;; Append newline at end of the buffer as separator, and then
4653 ;; save it to file.
4654 (goto-char (point-max))
4655 (insert "\n")
4656 (append-to-file (point-min) (point-max) file-name))
4657 (kill-buffer tmpbuf)
4660 (defun gnus-convert-article-to-rmail ()
4661 "Convert article in current buffer to Rmail message format."
4662 (let ((buffer-read-only nil))
4663 ;; Convert article directly into Babyl format.
4664 ;; Suggested by Rob Austein <sra@lcs.mit.edu>
4665 (goto-char (point-min))
4666 (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
4667 (while (search-forward "\n\^_" nil t) ;single char
4668 (replace-match "\n^_")) ;2 chars: "^" and "_"
4669 (goto-char (point-max))
4670 (insert "\^_")))
4672 ;;(defun gnus-convert-article-to-rmail ()
4673 ;; "Convert article in current buffer to Rmail message format."
4674 ;; (let ((buffer-read-only nil))
4675 ;; ;; Insert special header of Unix mail.
4676 ;; (goto-char (point-min))
4677 ;; (insert "From "
4678 ;; (or (mail-strip-quoted-names (mail-fetch-field "from"))
4679 ;; "unknown")
4680 ;; " " (current-time-string) "\n")
4681 ;; ;; Stop quoting `From' since this seems unnecessary in most cases.
4682 ;; ;; ``Quote'' "\nFrom " as "\n>From "
4683 ;; ;;(while (search-forward "\nFrom " nil t)
4684 ;; ;; (forward-char -5)
4685 ;; ;; (insert ?>))
4686 ;; ;; Convert article to babyl format.
4687 ;; (rmail-convert-to-babyl-format)
4688 ;; ))
4692 ;;; Internal functions.
4695 (defun gnus-start-news-server (&optional confirm)
4696 "Open network stream to remote NNTP server.
4697 If optional argument CONFIRM is non-nil, ask you host that NNTP server
4698 is running even if it is defined.
4699 Run gnus-Open-server-hook just before opening news server."
4700 (if (gnus-server-opened)
4701 ;; Stream is already opened.
4703 ;; Open NNTP server.
4704 (if (or confirm
4705 (null gnus-nntp-server))
4706 (if (and (boundp 'gnus-secondary-servers) gnus-secondary-servers)
4707 ;; Read server name with completion.
4708 (setq gnus-nntp-server
4709 (completing-read "NNTP server: "
4710 (cons (list gnus-nntp-server)
4711 gnus-secondary-servers)
4712 nil nil gnus-nntp-server))
4713 (setq gnus-nntp-server
4714 (read-string "NNTP server: " gnus-nntp-server))))
4715 ;; If no server name is given, local host is assumed.
4716 (if (string-equal gnus-nntp-server "")
4717 (setq gnus-nntp-server (system-name)))
4718 (cond ((string-match ":" gnus-nntp-server)
4719 ;; :DIRECTORY
4720 (require 'mhspool)
4721 (gnus-define-access-method 'mhspool)
4722 (message "Looking up private directory..."))
4723 ((and (null gnus-nntp-service)
4724 (string-equal gnus-nntp-server (system-name)))
4725 (require 'nnspool)
4726 (gnus-define-access-method 'nnspool)
4727 (message "Looking up local news spool..."))
4729 (gnus-define-access-method 'nntp)
4730 (message "Connecting to NNTP server on %s..." gnus-nntp-server)))
4731 (run-hooks 'gnus-Open-server-hook)
4732 (cond ((gnus-open-server gnus-nntp-server gnus-nntp-service))
4733 ((and (stringp (gnus-status-message))
4734 (> (length (gnus-status-message)) 0))
4735 ;; Show valuable message if available.
4736 (error (gnus-status-message)))
4737 (t (error "Cannot open NNTP server on %s" gnus-nntp-server)))
4740 ;; Dummy functions used only once. Should return nil.
4741 (defun gnus-server-opened () nil)
4742 (defun gnus-close-server () nil)
4744 (defun gnus-define-access-method (method &optional access-methods)
4745 "Define access functions for the access METHOD.
4746 Methods defintion is taken from optional argument ACCESS-METHODS or
4747 the variable gnus-access-methods."
4748 (let ((bindings
4749 (cdr (assoc method (or access-methods gnus-access-methods)))))
4750 (if (null bindings)
4751 (error "Unknown access method: %s" method)
4752 ;; Should not use symbol-function here since overload does not work.
4753 (while bindings
4754 (fset (car (car bindings)) (cdr (car bindings)))
4755 (setq bindings (cdr bindings)))
4758 (defun gnus-select-newsgroup (group &optional show-all)
4759 "Select newsgroup GROUP.
4760 If optional argument SHOW-ALL is non-nil, all of articles in the group
4761 are selected."
4762 (if (gnus-request-group group)
4763 (let ((articles nil))
4764 (setq gnus-newsgroup-name group)
4765 (setq gnus-newsgroup-unreads
4766 (gnus-uncompress-sequence
4767 (nthcdr 2 (gnus-gethash group gnus-unread-hashtb))))
4768 (cond (show-all
4769 ;; Select all active articles.
4770 (setq articles
4771 (gnus-uncompress-sequence
4772 (nthcdr 2 (gnus-gethash group gnus-active-hashtb)))))
4774 ;; Select unread articles only.
4775 (setq articles gnus-newsgroup-unreads)))
4776 ;; Require confirmation if selecting large newsgroup.
4777 (setq gnus-newsgroup-unselected nil)
4778 (if (not (numberp gnus-large-newsgroup))
4780 (let ((selected nil)
4781 (number (length articles)))
4782 (if (> number gnus-large-newsgroup)
4783 (progn
4784 (condition-case ()
4785 (let ((input
4786 (read-string
4787 (format
4788 "How many articles from %s (default %d): "
4789 gnus-newsgroup-name number))))
4790 (setq selected
4791 (if (string-equal input "")
4792 number (string-to-int input))))
4793 (quit
4794 (setq selected 0)))
4795 (cond ((and (> selected 0)
4796 (< selected number))
4797 ;; Select last N articles.
4798 (setq articles (nthcdr (- number selected) articles)))
4799 ((and (< selected 0)
4800 (< (- 0 selected) number))
4801 ;; Select first N articles.
4802 (setq selected (- 0 selected))
4803 (setq articles (copy-sequence articles))
4804 (setcdr (nthcdr (1- selected) articles) nil))
4805 ((zerop selected)
4806 (setq articles nil))
4807 ;; Otherwise select all.
4809 ;; Get unselected unread articles.
4810 (setq gnus-newsgroup-unselected
4811 (gnus-set-difference gnus-newsgroup-unreads articles))
4814 ;; Get headers list.
4815 (setq gnus-newsgroup-headers (gnus-retrieve-headers articles))
4816 ;; UNREADS may contain expired articles, so we have to remove
4817 ;; them from the list.
4818 (setq gnus-newsgroup-unreads
4819 (gnus-intersection gnus-newsgroup-unreads
4820 (mapcar
4821 (function
4822 (lambda (header)
4823 (nntp-header-number header)))
4824 gnus-newsgroup-headers)))
4825 ;; Marked article must be a subset of unread articles.
4826 (setq gnus-newsgroup-marked
4827 (gnus-intersection (append gnus-newsgroup-unselected
4828 gnus-newsgroup-unreads)
4829 (cdr (assoc group gnus-marked-assoc))))
4830 ;; First and last article in this newsgroup.
4831 (setq gnus-newsgroup-begin
4832 (if gnus-newsgroup-headers
4833 (nntp-header-number (car gnus-newsgroup-headers))
4836 (setq gnus-newsgroup-end
4837 (if gnus-newsgroup-headers
4838 (nntp-header-number
4839 (gnus-last-element gnus-newsgroup-headers))
4842 ;; File name that an article was saved last.
4843 (setq gnus-newsgroup-last-rmail nil)
4844 (setq gnus-newsgroup-last-mail nil)
4845 (setq gnus-newsgroup-last-folder nil)
4846 (setq gnus-newsgroup-last-file nil)
4847 ;; Reset article pointer etc.
4848 (setq gnus-current-article nil)
4849 (setq gnus-current-headers nil)
4850 (setq gnus-current-history nil)
4851 (setq gnus-have-all-headers nil)
4852 (setq gnus-last-article nil)
4853 ;; GROUP is successfully selected.
4858 (defun gnus-more-header-backward ()
4859 "Find new header backward."
4860 (let ((first
4861 (car (nth 2 (gnus-gethash gnus-newsgroup-name gnus-active-hashtb))))
4862 (artnum gnus-newsgroup-begin)
4863 (header nil))
4864 (while (and (not header)
4865 (> artnum first))
4866 (setq artnum (1- artnum))
4867 (setq header (car (gnus-retrieve-headers (list artnum)))))
4868 header
4871 (defun gnus-more-header-forward ()
4872 "Find new header forward."
4873 (let ((last
4874 (cdr (nth 2 (gnus-gethash gnus-newsgroup-name gnus-active-hashtb))))
4875 (artnum gnus-newsgroup-end)
4876 (header nil))
4877 (while (and (not header)
4878 (< artnum last))
4879 (setq artnum (1+ artnum))
4880 (setq header (car (gnus-retrieve-headers (list artnum)))))
4881 header
4884 (defun gnus-extend-newsgroup (header &optional backward)
4885 "Extend newsgroup selection with HEADER.
4886 Optional argument BACKWARD means extend toward backward."
4887 (if header
4888 (let ((artnum (nntp-header-number header)))
4889 (setq gnus-newsgroup-headers
4890 (if backward
4891 (cons header gnus-newsgroup-headers)
4892 (append gnus-newsgroup-headers (list header))))
4893 ;; We have to update unreads and unselected, but don't have to
4894 ;; care about gnus-newsgroup-marked.
4895 (if (memq artnum gnus-newsgroup-unselected)
4896 (setq gnus-newsgroup-unreads
4897 (cons artnum gnus-newsgroup-unreads)))
4898 (setq gnus-newsgroup-unselected
4899 (delq artnum gnus-newsgroup-unselected))
4900 (setq gnus-newsgroup-begin (min gnus-newsgroup-begin artnum))
4901 (setq gnus-newsgroup-end (max gnus-newsgroup-end artnum))
4904 (defun gnus-mark-article-as-read (article)
4905 "Remember that ARTICLE is marked as read."
4906 ;; Remove from unread and marked list.
4907 (setq gnus-newsgroup-unreads
4908 (delq article gnus-newsgroup-unreads))
4909 (setq gnus-newsgroup-marked
4910 (delq article gnus-newsgroup-marked)))
4912 (defun gnus-mark-article-as-unread (article &optional clear-mark)
4913 "Remember that ARTICLE is marked as unread.
4914 Optional argument CLEAR-MARK means ARTICLE should not be remembered
4915 that it was marked as read once."
4916 ;; Add to unread list.
4917 (or (memq article gnus-newsgroup-unreads)
4918 (setq gnus-newsgroup-unreads
4919 (cons article gnus-newsgroup-unreads)))
4920 ;; If CLEAR-MARK is non-nil, the article must be removed from marked
4921 ;; list. Otherwise, it must be added to the list.
4922 (if clear-mark
4923 (setq gnus-newsgroup-marked
4924 (delq article gnus-newsgroup-marked))
4925 (or (memq article gnus-newsgroup-marked)
4926 (setq gnus-newsgroup-marked
4927 (cons article gnus-newsgroup-marked)))))
4929 (defun gnus-clear-system ()
4930 "Clear all variables and buffer."
4931 ;; Clear GNUS variables.
4932 (let ((variables gnus-variable-list))
4933 (while variables
4934 (set (car variables) nil)
4935 (setq variables (cdr variables))))
4936 ;; Clear other internal variables.
4937 (setq gnus-active-hashtb nil)
4938 (setq gnus-unread-hashtb nil)
4939 ;; Kill the startup file.
4940 (and gnus-current-startup-file
4941 (get-file-buffer gnus-current-startup-file)
4942 (kill-buffer (get-file-buffer gnus-current-startup-file)))
4943 (setq gnus-current-startup-file nil)
4944 ;; Kill GNUS buffers.
4945 (let ((buffers gnus-buffer-list))
4946 (while buffers
4947 (if (get-buffer (car buffers))
4948 (kill-buffer (car buffers)))
4949 (setq buffers (cdr buffers))
4952 (defun gnus-configure-windows (action)
4953 "Configure GNUS windows according to the next ACTION.
4954 The ACTION is either a symbol, such as `SelectNewsgroup', or a
4955 configuration list such as `(1 1 2)'. If ACTION is not a list,
4956 configuration list is got from the variable gnus-window-configuration."
4957 (let* ((windows
4958 (if (listp action)
4959 action (car (cdr (assq action gnus-window-configuration)))))
4960 (grpwin (get-buffer-window gnus-Group-buffer))
4961 (subwin (get-buffer-window gnus-Subject-buffer))
4962 (artwin (get-buffer-window gnus-Article-buffer))
4963 (winsum nil)
4964 (height nil)
4965 (grpheight 0)
4966 (subheight 0)
4967 (artheight 0))
4968 (if (or (null windows) ;No configuration is specified.
4969 (and (eq (null grpwin)
4970 (zerop (nth 0 windows)))
4971 (eq (null subwin)
4972 (zerop (nth 1 windows)))
4973 (eq (null artwin)
4974 (zerop (nth 2 windows)))))
4975 ;; No need to change window configuration.
4977 (select-window (or grpwin subwin artwin (selected-window)))
4978 ;; First of all, compute the height of each window.
4979 (cond (gnus-use-full-window
4980 ;; Take up the entire screen.
4981 (delete-other-windows)
4982 (setq height (window-height (selected-window))))
4984 (setq height (+ (if grpwin (window-height grpwin) 0)
4985 (if subwin (window-height subwin) 0)
4986 (if artwin (window-height artwin) 0)))))
4987 ;; The Newsgroup buffer exits always. So, use it to extend the
4988 ;; Group window so as to get enough window space.
4989 (switch-to-buffer gnus-Group-buffer 'norecord)
4990 (and (get-buffer gnus-Subject-buffer)
4991 (delete-windows-on gnus-Subject-buffer))
4992 (and (get-buffer gnus-Article-buffer)
4993 (delete-windows-on gnus-Article-buffer))
4994 ;; Compute expected window height.
4995 (setq winsum (apply (function +) windows))
4996 (if (not (zerop (nth 0 windows)))
4997 (setq grpheight (max window-min-height
4998 (/ (* height (nth 0 windows)) winsum))))
4999 (if (not (zerop (nth 1 windows)))
5000 (setq subheight (max window-min-height
5001 (/ (* height (nth 1 windows)) winsum))))
5002 (if (not (zerop (nth 2 windows)))
5003 (setq artheight (max window-min-height
5004 (/ (* height (nth 2 windows)) winsum))))
5005 (setq height (+ grpheight subheight artheight))
5006 (enlarge-window (max 0 (- height (window-height (selected-window)))))
5007 ;; Then split the window.
5008 (and (not (zerop artheight))
5009 (or (not (zerop grpheight))
5010 (not (zerop subheight)))
5011 (split-window-vertically (+ grpheight subheight)))
5012 (and (not (zerop grpheight))
5013 (not (zerop subheight))
5014 (split-window-vertically grpheight))
5015 ;; Then select buffers in each window.
5016 (and (not (zerop grpheight))
5017 (progn
5018 (switch-to-buffer gnus-Group-buffer 'norecord)
5019 (other-window 1)))
5020 (and (not (zerop subheight))
5021 (progn
5022 (switch-to-buffer gnus-Subject-buffer 'norecord)
5023 (other-window 1)))
5024 (and (not (zerop artheight))
5025 (progn
5026 ;; If Article buffer does not exist, it will be created
5027 ;; and initialized.
5028 (gnus-Article-setup-buffer)
5029 (switch-to-buffer gnus-Article-buffer 'norecord)))
5033 (defun gnus-find-header-by-number (headers number)
5034 "Return a header which is a element of HEADERS and has NUMBER."
5035 (let ((found nil))
5036 (while (and headers (not found))
5037 ;; We cannot use `=' to accept non-numeric NUMBER.
5038 (if (eq number (nntp-header-number (car headers)))
5039 (setq found (car headers)))
5040 (setq headers (cdr headers)))
5041 found
5044 (defun gnus-find-header-by-id (headers id)
5045 "Return a header which is a element of HEADERS and has Message-ID."
5046 (let ((found nil))
5047 (while (and headers (not found))
5048 (if (string-equal id (nntp-header-id (car headers)))
5049 (setq found (car headers)))
5050 (setq headers (cdr headers)))
5051 found
5054 (defun gnus-version ()
5055 "Version numbers of this version of GNUS."
5056 (interactive)
5057 (cond ((and (boundp 'mhspool-version) (boundp 'nnspool-version))
5058 (message "%s; %s; %s; %s"
5059 gnus-version nntp-version nnspool-version mhspool-version))
5060 ((boundp 'mhspool-version)
5061 (message "%s; %s; %s"
5062 gnus-version nntp-version mhspool-version))
5063 ((boundp 'nnspool-version)
5064 (message "%s; %s; %s"
5065 gnus-version nntp-version nnspool-version))
5067 (message "%s; %s" gnus-version nntp-version))))
5069 (defun gnus-Info-find-node ()
5070 "Find Info documentation of GNUS."
5071 (interactive)
5072 (require 'info)
5073 ;; Enlarge info window if needed.
5074 (cond ((eq major-mode 'gnus-Group-mode)
5075 (gnus-configure-windows '(1 0 0)) ;Take all windows.
5076 (pop-to-buffer gnus-Group-buffer))
5077 ((eq major-mode 'gnus-Subject-mode)
5078 (gnus-configure-windows '(0 1 0)) ;Take all windows.
5079 (pop-to-buffer gnus-Subject-buffer)))
5080 (Info-goto-node (cdr (assq major-mode gnus-Info-nodes))))
5082 (defun gnus-overload-functions (&optional overloads)
5083 "Overload functions specified by optional argument OVERLOADS.
5084 If nothing is specified, use the variable gnus-overload-functions."
5085 (let ((defs nil)
5086 (overloads (or overloads gnus-overload-functions)))
5087 (while overloads
5088 (setq defs (car overloads))
5089 (setq overloads (cdr overloads))
5090 ;; Load file before overloading function if necessary. Make
5091 ;; sure we cannot use `requre' always.
5092 (and (not (fboundp (car defs)))
5093 (car (cdr (cdr defs)))
5094 (load (car (cdr (cdr defs))) nil 'nomessage))
5095 (fset (car defs) (car (cdr defs)))
5098 (defun gnus-make-threads (newsgroup-headers)
5099 "Make conversation threads tree from NEWSGROUP-HEADERS."
5100 (let ((headers newsgroup-headers)
5101 (h nil)
5102 (d nil)
5103 (roots nil)
5104 (dependencies nil))
5105 ;; Make message dependency alist.
5106 (while headers
5107 (setq h (car headers))
5108 (setq headers (cdr headers))
5109 ;; Ignore invalid headers.
5110 (if (vectorp h) ;Depends on nntp.el.
5111 (progn
5112 ;; Ignore broken references, e.g "<123@a.b.c".
5113 (setq d (and (nntp-header-references h)
5114 (string-match "\\(<[^<>]+>\\)[^>]*$"
5115 (nntp-header-references h))
5116 (gnus-find-header-by-id
5117 newsgroup-headers
5118 (substring (nntp-header-references h)
5119 (match-beginning 1) (match-end 1)))))
5120 ;; Check subject equality.
5121 (or gnus-thread-ignore-subject
5122 (null d)
5123 (string-equal (gnus-simplify-subject
5124 (nntp-header-subject h) 're)
5125 (gnus-simplify-subject
5126 (nntp-header-subject d) 're))
5127 ;; H should be a thread root.
5128 (setq d nil))
5129 ;; H depends on D.
5130 (setq dependencies
5131 (cons (cons h d) dependencies))
5132 ;; H is a thread root.
5133 (if (null d)
5134 (setq roots (cons h roots)))
5137 ;; Make complete threads from the roots.
5138 ;; Note: dependencies are in reverse order, but
5139 ;; gnus-make-threads-1 processes it in reverse order again. So,
5140 ;; we don't have to worry about it.
5141 (mapcar
5142 (function
5143 (lambda (root)
5144 (gnus-make-threads-1 root dependencies))) (nreverse roots))
5147 (defun gnus-make-threads-1 (parent dependencies)
5148 (let ((children nil)
5149 (d nil)
5150 (depends dependencies))
5151 ;; Find children.
5152 (while depends
5153 (setq d (car depends))
5154 (setq depends (cdr depends))
5155 (and (cdr d)
5156 (eq (nntp-header-id parent) (nntp-header-id (cdr d)))
5157 (setq children (cons (car d) children))))
5158 ;; Go down.
5159 (cons parent
5160 (mapcar
5161 (function
5162 (lambda (child)
5163 (gnus-make-threads-1 child dependencies))) children))
5166 (defun gnus-narrow-to-page (&optional arg)
5167 "Make text outside current page invisible except for page delimiter.
5168 A numeric arg specifies to move forward or backward by that many pages,
5169 thus showing a page other than the one point was originally in."
5170 (interactive "P")
5171 (setq arg (if arg (prefix-numeric-value arg) 0))
5172 (save-excursion
5173 (forward-page -1) ;Beginning of current page.
5174 (widen)
5175 (if (> arg 0)
5176 (forward-page arg)
5177 (if (< arg 0)
5178 (forward-page (1- arg))))
5179 ;; Find the end of the page.
5180 (forward-page)
5181 ;; If we stopped due to end of buffer, stay there.
5182 ;; If we stopped after a page delimiter, put end of restriction
5183 ;; at the beginning of that line.
5184 ;; These are commented out.
5185 ;; (if (save-excursion (beginning-of-line)
5186 ;; (looking-at page-delimiter))
5187 ;; (beginning-of-line))
5188 (narrow-to-region (point)
5189 (progn
5190 ;; Find the top of the page.
5191 (forward-page -1)
5192 ;; If we found beginning of buffer, stay there.
5193 ;; If extra text follows page delimiter on same line,
5194 ;; include it.
5195 ;; Otherwise, show text starting with following line.
5196 (if (and (eolp) (not (bobp)))
5197 (forward-line 1))
5198 (point)))
5201 (defun gnus-last-element (list)
5202 "Return last element of LIST."
5203 (let ((last nil))
5204 (while list
5205 (if (null (cdr list))
5206 (setq last (car list)))
5207 (setq list (cdr list)))
5208 last
5211 (defun gnus-set-difference (list1 list2)
5212 "Return a list of elements of LIST1 that do not appear in LIST2."
5213 (let ((list1 (copy-sequence list1)))
5214 (while list2
5215 (setq list1 (delq (car list2) list1))
5216 (setq list2 (cdr list2)))
5217 list1
5220 (defun gnus-intersection (list1 list2)
5221 "Return a list of elements that appear in both LIST1 and LIST2."
5222 (let ((result nil))
5223 (while list2
5224 (if (memq (car list2) list1)
5225 (setq result (cons (car list2) result)))
5226 (setq list2 (cdr list2)))
5227 result
5232 ;;; Get information about active articles, already read articles, and
5233 ;;; still unread articles.
5236 ;; GNUS internal format of gnus-newsrc-assoc and gnus-killed-assoc:
5237 ;; (("general" t (1 . 1))
5238 ;; ("misc" t (1 . 10) (12 . 15))
5239 ;; ("test" nil (1 . 99)) ...)
5240 ;; GNUS internal format of gnus-marked-assoc:
5241 ;; (("general" 1 2 3)
5242 ;; ("misc" 2) ...)
5243 ;; GNUS internal format of gnus-active-hashtb:
5244 ;; (("general" t (1 . 1))
5245 ;; ("misc" t (1 . 10))
5246 ;; ("test" nil (1 . 99)) ...)
5247 ;; GNUS internal format of gnus-unread-hashtb:
5248 ;; (("general" 1 (1 . 1))
5249 ;; ("misc" 14 (1 . 10) (12 . 15))
5250 ;; ("test" 99 (1 . 99)) ...)
5252 (defun gnus-setup-news-info (&optional rawfile)
5253 "Setup news information.
5254 If optional argument RAWFILE is non-nil, force to read raw startup file."
5255 (let ((init (not (and gnus-newsrc-assoc
5256 gnus-active-hashtb
5257 gnus-unread-hashtb
5258 (not rawfile)
5259 ))))
5260 ;; We have to clear some variables to re-initialize news info.
5261 (if init
5262 (setq gnus-newsrc-assoc nil
5263 gnus-active-hashtb nil
5264 gnus-unread-hashtb nil))
5265 (if init
5266 (gnus-read-newsrc-file rawfile))
5267 (gnus-read-active-file)
5268 (gnus-expire-marked-articles)
5269 (gnus-get-unread-articles)
5270 ;; Check new newsgroups and subscribe them.
5271 (if init
5272 (let ((new-newsgroups (gnus-find-new-newsgroups)))
5273 (while new-newsgroups
5274 (funcall gnus-subscribe-newsgroup-method (car new-newsgroups))
5275 (setq new-newsgroups (cdr new-newsgroups))
5279 (defun gnus-subscribe-newsgroup (newsgroup &optional next)
5280 "Subscribe new NEWSGROUP.
5281 If optional argument NEXT is non-nil, it is inserted before NEXT."
5282 (gnus-insert-newsgroup (list newsgroup t) next)
5283 (message "Newsgroup %s is subscribed" newsgroup))
5285 (defun gnus-add-newsgroup (newsgroup)
5286 "Subscribe new NEWSGROUP safely and put it at top."
5287 (and (null (assoc newsgroup gnus-newsrc-assoc)) ;Really new?
5288 (gnus-gethash newsgroup gnus-active-hashtb) ;Really exist?
5289 (gnus-insert-newsgroup (or (assoc newsgroup gnus-killed-assoc)
5290 (list newsgroup t))
5291 (car (car gnus-newsrc-assoc)))))
5293 (defun gnus-find-new-newsgroups ()
5294 "Looking for new newsgroups and return names.
5295 `-n' option of options line in .newsrc file is recognized."
5296 (let ((group nil)
5297 (new-newsgroups nil))
5298 (mapatoms
5299 (function
5300 (lambda (sym)
5301 (setq group (symbol-name sym))
5302 ;; Taking account of `-n' option.
5303 (and (or (null gnus-newsrc-options-n-no)
5304 (not (string-match gnus-newsrc-options-n-no group))
5305 (and gnus-newsrc-options-n-yes
5306 (string-match gnus-newsrc-options-n-yes group)))
5307 (null (assoc group gnus-killed-assoc)) ;Ignore killed.
5308 (null (assoc group gnus-newsrc-assoc)) ;Really new.
5309 ;; Find new newsgroup.
5310 (setq new-newsgroups
5311 (cons group new-newsgroups)))
5313 gnus-active-hashtb)
5314 ;; Return new newsgroups.
5315 new-newsgroups
5318 (defun gnus-kill-newsgroup (group)
5319 "Kill GROUP from gnus-newsrc-assoc, .newsrc and gnus-unread-hashtb."
5320 (let ((info (assoc group gnus-newsrc-assoc)))
5321 (if (null info)
5323 ;; Delete from gnus-newsrc-assoc
5324 (setq gnus-newsrc-assoc (delq info gnus-newsrc-assoc))
5325 ;; Add to gnus-killed-assoc.
5326 (setq gnus-killed-assoc
5327 (cons info
5328 (delq (assoc group gnus-killed-assoc) gnus-killed-assoc)))
5329 ;; Clear unread hashtable.
5330 ;; Thanks cwitty@csli.Stanford.EDU (Carl Witty).
5331 (gnus-sethash group nil gnus-unread-hashtb)
5332 ;; Then delete from .newsrc
5333 (gnus-update-newsrc-buffer group 'delete)
5334 ;; Return the deleted newsrc entry.
5335 info
5338 (defun gnus-insert-newsgroup (info &optional next)
5339 "Insert newsrc INFO entry before NEXT.
5340 If optional argument NEXT is nil, appended to the last."
5341 (if (null info)
5342 (error "Invalid argument: %s" info))
5343 (let* ((group (car info)) ;Newsgroup name.
5344 (range
5345 (gnus-difference-of-range
5346 (nth 2 (gnus-gethash group gnus-active-hashtb)) (nthcdr 2 info))))
5347 ;; Check duplication.
5348 (if (assoc group gnus-newsrc-assoc)
5349 (error "Duplicated: %s" group))
5350 ;; Insert to gnus-newsrc-assoc.
5351 (if (string-equal next (car (car gnus-newsrc-assoc)))
5352 (setq gnus-newsrc-assoc
5353 (cons info gnus-newsrc-assoc))
5354 (let ((found nil)
5355 (rest gnus-newsrc-assoc)
5356 (tail (cons nil gnus-newsrc-assoc)))
5357 ;; Seach insertion point.
5358 (while (and (not found) rest)
5359 (if (string-equal next (car (car rest)))
5360 (setq found t)
5361 (setq rest (cdr rest))
5362 (setq tail (cdr tail))
5364 ;; Find it.
5365 (setcdr tail nil)
5366 (setq gnus-newsrc-assoc
5367 (append gnus-newsrc-assoc (cons info rest)))
5369 ;; Delete from gnus-killed-assoc.
5370 (setq gnus-killed-assoc
5371 (delq (assoc group gnus-killed-assoc) gnus-killed-assoc))
5372 ;; Then insert to .newsrc.
5373 (gnus-update-newsrc-buffer group nil next)
5374 ;; Add to gnus-unread-hashtb.
5375 (gnus-sethash group
5376 (cons group ;Newsgroup name.
5377 (cons (gnus-number-of-articles range) range))
5378 gnus-unread-hashtb)
5381 (defun gnus-check-killed-newsgroups ()
5382 "Check consistency between gnus-newsrc-assoc and gnus-killed-assoc."
5383 (let ((group nil)
5384 (new-killed nil)
5385 (old-killed gnus-killed-assoc))
5386 (while old-killed
5387 (setq group (car (car old-killed)))
5388 (and (or (null gnus-newsrc-options-n-no)
5389 (not (string-match gnus-newsrc-options-n-no group))
5390 (and gnus-newsrc-options-n-yes
5391 (string-match gnus-newsrc-options-n-yes group)))
5392 (null (assoc group gnus-newsrc-assoc)) ;No duplication.
5393 ;; Subscribed in options line and not in gnus-newsrc-assoc.
5394 (setq new-killed
5395 (cons (car old-killed) new-killed)))
5396 (setq old-killed (cdr old-killed))
5398 (setq gnus-killed-assoc (nreverse new-killed))
5401 (defun gnus-check-bogus-newsgroups (&optional confirm)
5402 "Delete bogus newsgroups.
5403 If optional argument CONFIRM is non-nil, confirm deletion of newsgroups."
5404 (let ((group nil) ;Newsgroup name temporary used.
5405 (old-newsrc gnus-newsrc-assoc)
5406 (new-newsrc nil)
5407 (bogus nil) ;List of bogus newsgroups.
5408 (old-killed gnus-killed-assoc)
5409 (new-killed nil)
5410 (old-marked gnus-marked-assoc)
5411 (new-marked nil))
5412 (message "Checking bogus newsgroups...")
5413 ;; Update gnus-newsrc-assoc.
5414 (while old-newsrc
5415 (setq group (car (car old-newsrc)))
5416 (if (or (gnus-gethash group gnus-active-hashtb)
5417 (and confirm
5418 (not (y-or-n-p
5419 (format "Delete bogus newsgroup: %s " group)))))
5420 ;; Active newsgroup.
5421 (setq new-newsrc (cons (car old-newsrc) new-newsrc))
5422 ;; Found a bogus newsgroup.
5423 (setq bogus (cons group bogus)))
5424 (setq old-newsrc (cdr old-newsrc))
5426 (setq gnus-newsrc-assoc (nreverse new-newsrc))
5427 ;; Update gnus-killed-assoc.
5428 ;; The killed newsgroups are deleted without any confirmations.
5429 (while old-killed
5430 (setq group (car (car old-killed)))
5431 (and (gnus-gethash group gnus-active-hashtb)
5432 (null (assoc group gnus-newsrc-assoc))
5433 ;; Active and really killed newsgroup.
5434 (setq new-killed (cons (car old-killed) new-killed)))
5435 (setq old-killed (cdr old-killed))
5437 (setq gnus-killed-assoc (nreverse new-killed))
5438 ;; Remove BOGUS from .newsrc file.
5439 (while bogus
5440 (gnus-update-newsrc-buffer (car bogus) 'delete)
5441 (setq bogus (cdr bogus)))
5442 ;; Update gnus-marked-assoc.
5443 (while old-marked
5444 (setq group (car (car old-marked)))
5445 (if (and (cdr (car old-marked)) ;Non-empty?
5446 (assoc group gnus-newsrc-assoc)) ;Not bogus?
5447 (setq new-marked (cons (car old-marked) new-marked)))
5448 (setq old-marked (cdr old-marked)))
5449 (setq gnus-marked-assoc new-marked)
5450 (message "Checking bogus newsgroups... done")
5453 (defun gnus-get-unread-articles ()
5454 "Compute diffs between active and read articles."
5455 (let ((read gnus-newsrc-assoc)
5456 (group-info nil)
5457 (group-name nil)
5458 (active nil)
5459 (range nil))
5460 (message "Checking new news...")
5461 (or gnus-unread-hashtb
5462 (setq gnus-unread-hashtb (gnus-make-hashtable)))
5463 (while read
5464 (setq group-info (car read)) ;About one newsgroup
5465 (setq group-name (car group-info))
5466 (setq active (nth 2 (gnus-gethash group-name gnus-active-hashtb)))
5467 (if (and gnus-octive-hashtb
5468 ;; Is nothing changed?
5469 (equal active
5470 (nth 2 (gnus-gethash group-name gnus-octive-hashtb)))
5471 ;; Is this newsgroup in the unread hash table?
5472 (gnus-gethash group-name gnus-unread-hashtb)
5474 nil ;Nothing to do.
5475 (setq range (gnus-difference-of-range active (nthcdr 2 group-info)))
5476 (gnus-sethash group-name
5477 (cons group-name ;Group name
5478 (cons (gnus-number-of-articles range)
5479 range)) ;Range of unread articles
5480 gnus-unread-hashtb)
5482 (setq read (cdr read))
5484 (message "Checking new news... done")
5487 (defun gnus-expire-marked-articles ()
5488 "Check expired article which is marked as unread."
5489 (let ((marked-assoc gnus-marked-assoc)
5490 (updated-assoc nil)
5491 (marked nil) ;Current marked info.
5492 (articles nil) ;List of marked articles.
5493 (updated nil) ;List of real marked.
5494 (begin nil))
5495 (while marked-assoc
5496 (setq marked (car marked-assoc))
5497 (setq articles (cdr marked))
5498 (setq updated nil)
5499 (setq begin
5500 (car (nth 2 (gnus-gethash (car marked) gnus-active-hashtb))))
5501 (while (and begin articles)
5502 (if (>= (car articles) begin)
5503 ;; This article is still active.
5504 (setq updated (cons (car articles) updated)))
5505 (setq articles (cdr articles)))
5506 (if updated
5507 (setq updated-assoc
5508 (cons (cons (car marked) updated) updated-assoc)))
5509 (setq marked-assoc (cdr marked-assoc)))
5510 (setq gnus-marked-assoc updated-assoc)
5513 (defun gnus-mark-as-read-by-xref
5514 (group headers unreads &optional subscribed-only)
5515 "Mark articles as read using cross references and return updated newsgroups.
5516 Arguments are GROUP, HEADERS, UNREADS, and optional SUBSCRIBED-ONLY."
5517 (let ((xref-list nil)
5518 (header nil)
5519 (xrefs nil) ;One Xref: field info.
5520 (xref nil) ;(NEWSGROUP . ARTICLE)
5521 (gname nil) ;Newsgroup name
5522 (article nil)) ;Article number
5523 (while headers
5524 (setq header (car headers))
5525 (if (memq (nntp-header-number header) unreads)
5526 ;; This article is not yet marked as read.
5528 (setq xrefs (gnus-parse-xref-field (nntp-header-xref header)))
5529 ;; For each cross reference info. in one Xref: field.
5530 (while xrefs
5531 (setq xref (car xrefs))
5532 (setq gname (car xref)) ;Newsgroup name
5533 (setq article (cdr xref)) ;Article number
5534 (or (string-equal group gname) ;Ignore current newsgroup.
5535 ;; Ignore unsubscribed newsgroup if requested.
5536 (and subscribed-only
5537 (not (nth 1 (assoc gname gnus-newsrc-assoc))))
5538 ;; Ignore article marked as unread.
5539 (memq article (cdr (assoc gname gnus-marked-assoc)))
5540 (let ((group-xref (assoc gname xref-list)))
5541 (if group-xref
5542 (if (memq article (cdr group-xref))
5543 nil ;Alread marked.
5544 (setcdr group-xref (cons article (cdr group-xref))))
5545 ;; Create new assoc entry for GROUP.
5546 (setq xref-list (cons (list gname article) xref-list)))
5548 (setq xrefs (cdr xrefs))
5550 (setq headers (cdr headers)))
5551 ;; Mark cross referenced articles as read.
5552 (gnus-mark-xrefed-as-read xref-list)
5553 ;;(message "%s %s" (prin1-to-string unreads) (prin1-to-string xref-list))
5554 ;; Return list of updated group name.
5555 (mapcar (function car) xref-list)
5558 (defun gnus-parse-xref-field (xref-value)
5559 "Parse Xref: field value, and return list of `(group . article-id)'."
5560 (let ((xref-list nil)
5561 (xref-value (or xref-value "")))
5562 ;; Remove server host name.
5563 (if (string-match "^[ \t]*[^ \t,]+[ \t,]+\\(.*\\)$" xref-value)
5564 (setq xref-value (substring xref-value (match-beginning 1)))
5565 (setq xref-value nil))
5566 ;; Process each xref info.
5567 (while xref-value
5568 (if (string-match
5569 "^[ \t,]*\\([^ \t,]+\\):\\([0-9]+\\)[^0-9]*" xref-value)
5570 (progn
5571 (setq xref-list
5572 (cons
5573 (cons
5574 ;; Group name
5575 (substring xref-value (match-beginning 1) (match-end 1))
5576 ;; Article-ID
5577 (string-to-int
5578 (substring xref-value (match-beginning 2) (match-end 2))))
5579 xref-list))
5580 (setq xref-value (substring xref-value (match-end 2))))
5581 (setq xref-value nil)))
5582 ;; Return alist.
5583 xref-list
5586 (defun gnus-mark-xrefed-as-read (xrefs)
5587 "Update unread article information using XREFS alist."
5588 (let ((group nil)
5589 (idlist nil)
5590 (unread nil))
5591 (while xrefs
5592 (setq group (car (car xrefs)))
5593 (setq idlist (cdr (car xrefs)))
5594 (setq unread (gnus-uncompress-sequence
5595 (nthcdr 2 (gnus-gethash group gnus-unread-hashtb))))
5596 (while idlist
5597 (setq unread (delq (car idlist) unread))
5598 (setq idlist (cdr idlist)))
5599 (gnus-update-unread-articles group unread 'ignore)
5600 (setq xrefs (cdr xrefs))
5603 (defun gnus-update-unread-articles (group unread-list marked-list)
5604 "Update unread articles of GROUP using UNREAD-LIST and MARKED-LIST."
5605 (let ((active (nth 2 (gnus-gethash group gnus-active-hashtb)))
5606 (unread (gnus-gethash group gnus-unread-hashtb)))
5607 (if (or (null active) (null unread))
5608 ;; Ignore unknown newsgroup.
5610 ;; Update gnus-unread-hashtb.
5611 (if unread-list
5612 (setcdr (cdr unread)
5613 (gnus-compress-sequence unread-list))
5614 ;; All of the articles are read.
5615 (setcdr (cdr unread) '((0 . 0))))
5616 ;; Number of unread articles.
5617 (setcar (cdr unread)
5618 (gnus-number-of-articles (nthcdr 2 unread)))
5619 ;; Update gnus-newsrc-assoc.
5620 (if (> (car active) 0)
5621 ;; Articles from 1 to N are not active.
5622 (setq active (cons 1 (cdr active))))
5623 (setcdr (cdr (assoc group gnus-newsrc-assoc))
5624 (gnus-difference-of-range active (nthcdr 2 unread)))
5625 ;; Update .newsrc buffer.
5626 (gnus-update-newsrc-buffer group)
5627 ;; Update gnus-marked-assoc.
5628 (if (listp marked-list) ;Includes NIL.
5629 (let ((marked (assoc group gnus-marked-assoc)))
5630 (cond (marked
5631 (setcdr marked marked-list))
5632 (marked-list ;Non-NIL.
5633 (setq gnus-marked-assoc
5634 (cons (cons group marked-list)
5635 gnus-marked-assoc)))
5639 (defun gnus-read-active-file ()
5640 "Get active file from NNTP server."
5641 (message "Reading active file...")
5642 (if (gnus-request-list) ;Get active file from server
5643 (save-excursion
5644 (set-buffer nntp-server-buffer)
5645 ;; Save OLD active info.
5646 (setq gnus-octive-hashtb gnus-active-hashtb)
5647 (setq gnus-active-hashtb (gnus-make-hashtable))
5648 (gnus-active-to-gnus-format)
5649 (message "Reading active file... done"))
5650 (error "Cannot read active file from NNTP server.")))
5652 (defun gnus-active-to-gnus-format ()
5653 "Convert active file format to internal format."
5654 ;; Delete unnecessary lines.
5655 (goto-char (point-min))
5656 (delete-matching-lines "^to\\..*$")
5657 ;; Store active file in hashtable.
5658 (goto-char (point-min))
5659 (while
5660 (re-search-forward
5661 "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([ymn]\\).*$"
5662 nil t)
5663 (gnus-sethash
5664 (buffer-substring (match-beginning 1) (match-end 1))
5665 (list (buffer-substring (match-beginning 1) (match-end 1))
5666 (string-equal
5667 "y" (buffer-substring (match-beginning 4) (match-end 4)))
5668 (cons (string-to-int
5669 (buffer-substring (match-beginning 3) (match-end 3)))
5670 (string-to-int
5671 (buffer-substring (match-beginning 2) (match-end 2)))))
5672 gnus-active-hashtb)))
5674 (defun gnus-read-newsrc-file (&optional rawfile)
5675 "Read startup FILE.
5676 If optional argument RAWFILE is non-nil, the raw startup file is read."
5677 (setq gnus-current-startup-file
5678 (let* ((file (expand-file-name gnus-startup-file nil))
5679 (real-file (concat file "-" gnus-nntp-server)))
5680 (if (file-exists-p real-file)
5681 real-file file)))
5682 ;; Reset variables which may be included in the quick startup file.
5683 (let ((variables gnus-variable-list))
5684 (while variables
5685 (set (car variables) nil)
5686 (setq variables (cdr variables))))
5687 (let* ((newsrc-file gnus-current-startup-file)
5688 (quick-file (concat newsrc-file ".el"))
5689 (quick-loaded nil)
5690 (newsrc-mod (nth 5 (file-attributes newsrc-file)))
5691 (quick-mod (nth 5 (file-attributes quick-file))))
5692 (save-excursion
5693 ;; Prepare .newsrc buffer.
5694 (set-buffer (find-file-noselect newsrc-file))
5695 ;; It is not so good idea turning off undo.
5696 ;;(buffer-flush-undo (current-buffer))
5697 ;; Load quick .newsrc to restore gnus-marked-assoc and
5698 ;; gnus-killed-assoc even if gnus-newsrc-assoc is out of date.
5699 (condition-case nil
5700 (setq quick-loaded (load quick-file t t t))
5701 (error nil))
5702 (cond ((and (not rawfile) ;Not forced to read the raw file.
5703 (or (and (fboundp 'file-newer-than-file-p)
5704 (file-newer-than-file-p quick-file newsrc-file))
5705 (and newsrc-mod quick-mod
5706 ;; .newsrc.el is newer than .newsrc.
5707 ;; Some older version does not support function
5708 ;; `file-newer-than-file-p'.
5709 (or (< (car newsrc-mod) (car quick-mod))
5710 (and (= (car newsrc-mod) (car quick-mod))
5711 (<= (nth 1 newsrc-mod) (nth 1 quick-mod))))
5713 quick-loaded
5714 gnus-newsrc-assoc ;Really loaded?
5716 ;; We don't have to read the raw startup file.
5719 ;; Since .newsrc file is newer than quick file, read it.
5720 (message "Reading %s..." newsrc-file)
5721 (gnus-newsrc-to-gnus-format)
5722 (gnus-check-killed-newsgroups)
5723 (message "Reading %s... Done" newsrc-file)))
5726 (defun gnus-make-newsrc-file (file)
5727 "Make server dependent file name by catenating FILE and server host name."
5728 (let* ((file (expand-file-name file nil))
5729 (real-file (concat file "-" gnus-nntp-server)))
5730 (if (file-exists-p real-file)
5731 real-file file)
5734 (defun gnus-newsrc-to-gnus-format ()
5735 "Parse current buffer as .newsrc file."
5736 (let ((newsgroup nil)
5737 (subscribe nil)
5738 (ranges nil)
5739 (subrange nil)
5740 (read-list nil))
5741 ;; We have to re-initialize these variable (except for
5742 ;; gnus-marked-assoc and gnus-killed-assoc) because quick startup
5743 ;; file may contain bogus values.
5744 (setq gnus-newsrc-options nil)
5745 (setq gnus-newsrc-options-n-yes nil)
5746 (setq gnus-newsrc-options-n-no nil)
5747 (setq gnus-newsrc-assoc nil)
5748 ;; Save options line to variable.
5749 ;; Lines beginning with white spaces are treated as continuation
5750 ;; line. Refer man page of newsrc(5).
5751 (goto-char (point-min))
5752 (if (re-search-forward
5753 "^[ \t]*options[ \t]*\\(.*\\(\n[ \t]+.*\\)*\\)[ \t]*$" nil t)
5754 (progn
5755 ;; Save entire options line.
5756 (setq gnus-newsrc-options
5757 (buffer-substring (match-beginning 1) (match-end 1)))
5758 ;; Compile "-n" option.
5759 (if (string-match "\\(^\\|[ \t\n]\\)-n" gnus-newsrc-options)
5760 (let ((yes-and-no
5761 (gnus-parse-n-options
5762 (substring gnus-newsrc-options (match-end 0)))))
5763 (setq gnus-newsrc-options-n-yes (car yes-and-no))
5764 (setq gnus-newsrc-options-n-no (cdr yes-and-no))
5767 ;; Parse body of .newsrc file
5768 ;; Options line continuation lines must be also considered here.
5769 ;; Before supporting continuation lines, " newsgroup ! 1-5" was
5770 ;; okay, but now it is invalid. It should be "newsgroup! 1-5".
5771 (goto-char (point-min))
5772 ;; Due to overflows in regex.c, change the following regexp:
5773 ;; "^\\([^:! \t\n]+\\)\\([:!]\\)[ \t]*\\(.*\\)$"
5774 ;; Suggested by composer@bucsf.bu.edu (Jeff Kellem).
5775 (while (re-search-forward
5776 "^\\([^:! \t\n]+\\)\\([:!]\\)[ \t]*\\(\\(...\\)*.*\\)$" nil t)
5777 (setq newsgroup (buffer-substring (match-beginning 1) (match-end 1)))
5778 ;; Check duplications of newsgroups.
5779 ;; Note: Checking the duplications takes very long time.
5780 (if (assoc newsgroup gnus-newsrc-assoc)
5781 (message "Ignore duplicated newsgroup: %s" newsgroup)
5782 (setq subscribe
5783 (string-equal
5784 ":" (buffer-substring (match-beginning 2) (match-end 2))))
5785 (setq ranges (buffer-substring (match-beginning 3) (match-end 3)))
5786 (setq read-list nil)
5787 (while (string-match "^[, \t]*\\([0-9-]+\\)" ranges)
5788 (setq subrange (substring ranges (match-beginning 1) (match-end 1)))
5789 (setq ranges (substring ranges (match-end 1)))
5790 (cond ((string-match "^\\([0-9]+\\)-\\([0-9]+\\)$" subrange)
5791 (setq read-list
5792 (cons
5793 (cons (string-to-int
5794 (substring subrange
5795 (match-beginning 1) (match-end 1)))
5796 (string-to-int
5797 (substring subrange
5798 (match-beginning 2) (match-end 2))))
5799 read-list)))
5800 ((string-match "^[0-9]+$" subrange)
5801 (setq read-list
5802 (cons (cons (string-to-int subrange)
5803 (string-to-int subrange))
5804 read-list)))
5806 (ding) (message "Ignoring bogus lines of %s" newsgroup)
5807 (sit-for 0))
5809 (setq gnus-newsrc-assoc
5810 (cons (cons newsgroup (cons subscribe (nreverse read-list)))
5811 gnus-newsrc-assoc))
5813 (setq gnus-newsrc-assoc
5814 (nreverse gnus-newsrc-assoc))
5817 (defun gnus-parse-n-options (options)
5818 "Parse -n NEWSGROUPS options and return a cons of YES and NO regexps."
5819 (let ((yes nil)
5820 (no nil)
5821 (yes-or-no nil) ;`!' or not.
5822 (newsgroup nil))
5823 ;; Parse each newsgroup description such as "comp.all". Commas
5824 ;; and white spaces can be a newsgroup separator.
5825 (while
5826 (string-match "^[ \t\n,]*\\(!?\\)\\([^--- \t\n,][^ \t\n,]*\\)" options)
5827 (setq yes-or-no
5828 (substring options (match-beginning 1) (match-end 1)))
5829 (setq newsgroup
5830 (regexp-quote
5831 (substring options
5832 (match-beginning 2) (match-end 2))))
5833 (setq options (substring options (match-end 2)))
5834 ;; Rewrite "all" to ".+" not ".*". ".+" requires at least one
5835 ;; character.
5836 (while (string-match "\\(^\\|\\\\[.]\\)all\\(\\\\[.]\\|$\\)" newsgroup)
5837 (setq newsgroup
5838 (concat (substring newsgroup 0 (match-end 1))
5839 ".+"
5840 (substring newsgroup (match-beginning 2)))))
5841 (cond ((string-equal yes-or-no "!")
5842 (setq no (cons newsgroup no)))
5843 ((string-equal newsgroup ".+")) ;Ignore `all'.
5845 (setq yes (cons newsgroup yes)))
5847 ;; Make a cons of regexps from parsing result.
5848 (cons (if yes
5849 (concat "^\\("
5850 (apply (function concat)
5851 (mapcar
5852 (function
5853 (lambda (newsgroup)
5854 (concat newsgroup "\\|")))
5855 (cdr yes)))
5856 (car yes) "\\)"))
5857 (if no
5858 (concat "^\\("
5859 (apply (function concat)
5860 (mapcar
5861 (function
5862 (lambda (newsgroup)
5863 (concat newsgroup "\\|")))
5864 (cdr no)))
5865 (car no) "\\)")))
5868 (defun gnus-save-newsrc-file ()
5869 "Save to .newsrc FILE."
5870 ;; Note: We cannot save .newsrc file if all newsgroups are removed
5871 ;; from the variable gnus-newsrc-assoc.
5872 (and (or gnus-newsrc-assoc gnus-killed-assoc)
5873 gnus-current-startup-file
5874 (save-excursion
5875 ;; A buffer containing .newsrc file may be deleted.
5876 (set-buffer (find-file-noselect gnus-current-startup-file))
5877 (if (not (buffer-modified-p))
5878 (message "(No changes need to be saved)")
5879 (message "Saving %s..." gnus-current-startup-file)
5880 (let ((make-backup-files t)
5881 (version-control nil)
5882 (require-final-newline t)) ;Don't ask even if requested.
5883 ;; Make backup file of master newsrc.
5884 ;; You can stop or change version control of backup file.
5885 ;; Suggested by jason@violet.berkeley.edu.
5886 (run-hooks 'gnus-Save-newsrc-hook)
5887 (save-buffer))
5888 ;; Quickly loadable .newsrc.
5889 (set-buffer (get-buffer-create " *GNUS-newsrc*"))
5890 (buffer-flush-undo (current-buffer))
5891 (erase-buffer)
5892 (gnus-gnus-to-quick-newsrc-format)
5893 (let ((make-backup-files nil)
5894 (version-control nil)
5895 (require-final-newline t)) ;Don't ask even if requested.
5896 (write-file (concat gnus-current-startup-file ".el")))
5897 (kill-buffer (current-buffer))
5898 (message "Saving %s... Done" gnus-current-startup-file)
5902 (defun gnus-update-newsrc-buffer (group &optional delete next)
5903 "Incrementally update .newsrc buffer about GROUP.
5904 If optional second argument DELETE is non-nil, delete the group.
5905 If optional third argument NEXT is non-nil, inserted before it."
5906 (save-excursion
5907 ;; Taking account of the killed startup file.
5908 ;; Suggested by tale@pawl.rpi.edu.
5909 (set-buffer (or (get-file-buffer gnus-current-startup-file)
5910 (find-file-noselect gnus-current-startup-file)))
5911 ;; Options line continuation lines must be also considered here.
5912 ;; Before supporting continuation lines, " newsgroup ! 1-5" was
5913 ;; okay, but now it is invalid. It should be "newsgroup! 1-5".
5914 (let ((deleted nil)
5915 (buffer-read-only nil)) ;May be not modifiable.
5916 ;; Delete ALL entries which match for GROUP.
5917 (goto-char (point-min))
5918 (while (re-search-forward
5919 (concat "^" (regexp-quote group) "[:!]") nil t)
5920 (beginning-of-line)
5921 (delete-region (point) (progn (forward-line 1) (point)))
5922 (setq deleted t) ;Old entry is deleted.
5924 (if delete
5926 ;; Insert group entry.
5927 (let ((newsrc (assoc group gnus-newsrc-assoc)))
5928 (if (null newsrc)
5930 ;; Find insertion point.
5931 (cond (deleted nil) ;Insert here.
5932 ((and (stringp next)
5933 (progn
5934 (goto-char (point-min))
5935 (re-search-forward
5936 (concat "^" (regexp-quote next) "[:!]") nil t)))
5937 (beginning-of-line))
5939 (goto-char (point-max))
5940 (or (bolp)
5941 (insert "\n"))))
5942 ;; Insert after options line.
5943 (if (looking-at "^[ \t]*options\\([ \t]\\|$\\)")
5944 (progn
5945 (forward-line 1)
5946 ;; Skip continuation lines.
5947 (while (and (not (eobp))
5948 (looking-at "^[ \t]+"))
5949 (forward-line 1))))
5950 (insert group ;Group name
5951 (if (nth 1 newsrc) ": " "! ")) ;Subscribed?
5952 (gnus-ranges-to-newsrc-format (nthcdr 2 newsrc)) ;Read articles
5953 (insert "\n")
5957 (defun gnus-gnus-to-quick-newsrc-format ()
5958 "Insert GNUS variables such as `gnus-newsrc-assoc' in Lisp format."
5959 (insert ";; GNUS internal format of .newsrc.\n")
5960 (insert ";; Touch .newsrc instead if you think to remove this file.\n")
5961 (let ((variable nil)
5962 (variables gnus-variable-list)
5963 ;; Temporary rebind to make changes invisible.
5964 (gnus-killed-assoc gnus-killed-assoc))
5965 ;; Remove duplicated or unsubscribed newsgroups in gnus-killed-assoc.
5966 (gnus-check-killed-newsgroups)
5967 ;; Then, insert lisp expressions.
5968 (while variables
5969 (setq variable (car variables))
5970 (and (boundp variable)
5971 (symbol-value variable)
5972 (insert "(setq " (symbol-name variable) " '"
5973 (prin1-to-string (symbol-value variable))
5974 ")\n"))
5975 (setq variables (cdr variables)))
5978 (defun gnus-ranges-to-newsrc-format (ranges)
5979 "Insert ranges of read articles."
5980 (let ((range nil)) ;Range is a pair of BEGIN and END.
5981 (while ranges
5982 (setq range (car ranges))
5983 (setq ranges (cdr ranges))
5984 (cond ((= (car range) (cdr range))
5985 (if (= (car range) 0)
5986 (setq ranges nil) ;No unread articles.
5987 (insert (int-to-string (car range)))
5988 (if ranges (insert ","))
5991 (insert (int-to-string (car range))
5993 (int-to-string (cdr range)))
5994 (if ranges (insert ","))
5998 (defun gnus-compress-sequence (numbers)
5999 "Convert list of sorted numbers to ranges."
6000 (let* ((numbers (sort (copy-sequence numbers) (function <)))
6001 (first (car numbers))
6002 (last (car numbers))
6003 (result nil))
6004 (while numbers
6005 (cond ((= last (car numbers)) nil) ;Omit duplicated number
6006 ((= (1+ last) (car numbers)) ;Still in sequence
6007 (setq last (car numbers)))
6008 (t ;End of one sequence
6009 (setq result (cons (cons first last) result))
6010 (setq first (car numbers))
6011 (setq last (car numbers)))
6013 (setq numbers (cdr numbers))
6015 (nreverse (cons (cons first last) result))
6018 (defun gnus-uncompress-sequence (ranges)
6019 "Expand compressed format of sequence."
6020 (let ((first nil)
6021 (last nil)
6022 (result nil))
6023 (while ranges
6024 (setq first (car (car ranges)))
6025 (setq last (cdr (car ranges)))
6026 (while (< first last)
6027 (setq result (cons first result))
6028 (setq first (1+ first)))
6029 (setq result (cons first result))
6030 (setq ranges (cdr ranges))
6032 (nreverse result)
6035 (defun gnus-number-of-articles (range)
6036 "Compute number of articles from RANGE `((beg1 . end1) (beg2 . end2) ...)'."
6037 (let ((count 0))
6038 (while range
6039 (if (/= (cdr (car range)) 0)
6040 ;; If end1 is 0, it must be skipped. Usually no articles in
6041 ;; this group.
6042 (setq count (+ count 1 (- (cdr (car range)) (car (car range))))))
6043 (setq range (cdr range))
6045 count ;Result
6048 (defun gnus-difference-of-range (src obj)
6049 "Compute (SRC - OBJ) on range.
6050 Range of SRC is expressed as `(beg . end)'.
6051 Range of OBJ is expressed as `((beg1 . end1) (beg2 . end2) ...)."
6052 (let ((beg (car src))
6053 (end (cdr src))
6054 (range nil)) ;This is result.
6055 ;; Src may be nil.
6056 (while (and src obj)
6057 (let ((beg1 (car (car obj)))
6058 (end1 (cdr (car obj))))
6059 (cond ((> beg end)
6060 (setq obj nil)) ;Terminate loop
6061 ((< beg beg1)
6062 (setq range (cons (cons beg (min (1- beg1) end)) range))
6063 (setq beg (1+ end1)))
6064 ((>= beg beg1)
6065 (setq beg (max beg (1+ end1))))
6067 (setq obj (cdr obj)) ;Next OBJ
6069 ;; Src may be nil.
6070 (if (and src (<= beg end))
6071 (setq range (cons (cons beg end) range)))
6072 ;; Result
6073 (if range
6074 (nreverse range)
6075 (list (cons 0 0)))
6079 ;;Local variables:
6080 ;;eval: (put 'gnus-eval-in-buffer-window 'lisp-indent-function 1)
6081 ;;end:
6083 (provide 'gnus)
6085 ;;; gnus.el ends here