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