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