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