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