1 ;;; (ding) Gnus: a newsreader for GNU Emacs
2 ;; Copyright (C) 1987,88,89,90,93,94,95 Free Software Foundation, Inc.
4 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
5 ;; Lars Ingebrigtsen <larsi@ifi.uio.no>
8 ;; This file is part of GNU Emacs.
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)
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.
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.
26 ;; Although (ding) Gnus looks suspiciously like GNUS, it isn't quite
27 ;; the same beast. Most internal structures have been changed. If you
28 ;; have written packages that depend on any of the hash tables,
29 ;; `gnus-newsrc-assoc', `gnus-killed-assoc', marked lists, the .newsrc
30 ;; buffer, or internal knowledge of the `nntp-header-' macros, or
31 ;; dependence on the buffers having a certain format, your code will
43 ;; Customization variables
45 (defvar gnus-select-method
46 (list 'nntp (or (getenv "NNTPSERVER")
47 (if (and gnus-default-nntp-server
48 (not (string= gnus-default-nntp-server "")))
49 gnus-default-nntp-server)
52 "Default method for selecting a newsgroup.
53 This variable should be a list, where the first element is how the
54 news is to be fetched, the second is the address, and the optional
55 third element is the \"port number\", if nntp is used.
57 For instance, if you want to get your news via NNTP from
58 \"flab.flab.edu\" on port 23, you could say:
60 (setq gnus-select-method '(nntp \"flab.flab.edu\" 23))
62 If you want to use your local spool, say:
64 (setq gnus-select-method (list 'nnspool (system-name)))
66 If you use this variable, you must set `gnus-nntp-server' to nil.")
68 ;; Added by Sudish Joseph <joseph@cis.ohio-state.edu>.
69 (defvar gnus-post-method nil
70 "Preferred method for posting USENET news.
71 If this variable is nil, GNUS will use the current method to decide
72 which method to use when posting. If it is non-nil, it will override
73 the current method. This method will not be used in mail groups and
74 the like, only in \"real\" newsgroups.
76 The value must be a valid method as discussed in the documentation of
77 `gnus-select-method'.")
79 (defvar gnus-secondary-select-methods nil
80 "A list of secondary methods that will be used for reading news.")
82 (defvar gnus-default-nntp-server nil
83 "Specify a default NNTP server.
84 This variable should be defined in paths.el, and should never be set
86 If you want to change servers, you should use `gnus-select-method'.
87 See the documentation to that variable.")
89 (defvar gnus-secondary-servers nil
90 "List of NNTP servers that the user can choose between interactively.
91 To make Gnus query you for a server, you have to give `gnus' a
92 non-numeric prefix - `C-u M-x gnus', in short.")
94 (defvar gnus-nntp-server nil
95 "*The name of the host running the NNTP server.
96 This variable is semi-obsolete. Use the `gnus-select-method'
99 (defvar gnus-nntp-service "nntp"
100 "NNTP service name (\"nntp\" or 119).
101 This is an obsolete variable, which is scarcely used. If you use an
102 nntp server for your newsgroup and want to change the port number
103 used to 899, you would say something along these lines:
105 (setq gnus-select-method '(nntp \"my.nntp.server\" 899))")
107 (defvar gnus-startup-file "~/.newsrc"
108 "Your `.newsrc' file. Use `.newsrc-SERVER' instead if it exists.")
110 (defvar gnus-signature-file "~/.signature"
111 "Your signature file.
112 If the variable is a string that doesn't correspond to a file, the
113 string itself is inserted.")
115 (defvar gnus-signature-function nil
116 "A function that should return a signature file name.
117 The function will be called with the name of the newsgroup being
119 If the function returns a string that doesn't correspond to a file, the
120 string itself is inserted.
121 If the function returns nil, the `gnus-signature-file' variable will
124 (defvar gnus-init-file "~/.gnus"
125 "Your Gnus elisp startup file.
126 If a file with the .el or .elc suffixes exist, they will be read
129 (defvar gnus-default-subscribed-newsgroups nil
130 "This variable lists what newsgroups should be susbcribed the first time Gnus is used.
131 It should be a list of strings.
132 If it is `t', Gnus will not do anything special the first time it is
133 started; it'll just use the normal newsgroups subscription methods.")
135 (defconst gnus-backup-default-subscribed-newsgroups
136 '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus")
137 "Default default new newsgroups the first time Gnus is run.")
139 (defvar gnus-post-prepare-function nil
140 "Function that is run after a post buffer has been prepared.
141 It is called with the name of the newsgroup that is posted to. It
142 might be use, for instance, for inserting signatures based on the
143 newsgroup name. (In that case, `gnus-signature-file' and
144 `mail-signature' should both be set to nil).")
146 (defvar gnus-use-cross-reference t
147 "Non-nil means that cross referenced articles will be marked as read.
148 If nil, ignore cross references. If t, mark articles as read in
151 (defvar gnus-use-followup-to 'use
152 "Specifies what to do with Followup-To header.
153 If nil, ignore the header. If it is t, use its value, but ignore
154 `poster'. If it is neither nil nor t, always use the value.")
156 (defvar gnus-followup-to-function nil
157 "A variable that contains a function that returns a followup address.
158 The function will be called in the buffer of the article that is being
159 followed up. The buffer will be narrowed to the headers of the
160 article. To pick header headers, one might use `mail-fetch-field'. The
161 function will be called with the name of the current newsgroup as the
164 Here's an example `gnus-followup-to-function':
166 (setq gnus-followup-to-function
168 (cond ((string= group \"mail.list\")
169 (or (mail-fetch-field \"sender\")
170 (mail-fetch-field \"from\")))
172 (or (mail-fetch-field \"reply-to\")
173 (mail-fetch-field \"from\"))))))")
175 (defvar gnus-reply-to-function nil
176 "A variable that contains a function that returns a reply address.
177 See the `gnus-followup-to-function' variable for an explanation of how
178 this variable is used.")
180 (defvar gnus-large-newsgroup 200
181 "The number of articles which indicates a large newsgroup.
182 If the number of articles in a newsgroup is greater than the value,
183 confirmation is required for selecting the newsgroup.")
185 (defvar gnus-author-copy (getenv "AUTHORCOPY")
186 "Name of the file the article will be saved before it is posted using the FCC header.
187 Initialized from the AUTHORCOPY environment variable.
189 Articles are saved using a function specified by the the variable
190 `gnus-author-copy-saver' (`rmail-output' is default) if a file name is
191 given. Instead, if the first character of the name is `|', the
192 contents of the article is piped out to the named program. It is
193 possible to save an article in an MH folder as follows:
195 \(setq gnus-author-copy \"|/usr/local/lib/mh/rcvstore +Article\")")
197 (defvar gnus-mail-self-blind nil
198 "Non-nil means insert BCC to self in messages to be sent.
199 This is done when the message is initialized,
200 so you can remove or alter the BCC header to override the default.")
202 (defvar gnus-author-copy-saver (function rmail-output)
203 "A function called with a file name to save an author copy to.
204 The default function is `rmail-output' which saves in Unix mailbox format.")
206 (defvar gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix)))
207 "Non-nil means that the default name of a file to save articles in is the newsgroup name.
208 If it's nil, the directory form of the newsgroup name is used instead.")
210 (defvar gnus-article-save-directory (or (getenv "SAVEDIR") "~/News/")
211 "Name of the directory articles will be saved in (default \"~/News\").
212 Initialized from the SAVEDIR environment variable.")
214 (defvar gnus-kill-files-directory (or (getenv "SAVEDIR") "~/News/")
215 "Name of the directory where kill files will be stored (default \"~/News\").
216 Initialized from the SAVEDIR environment variable.")
218 (defvar gnus-kill-expiry-days 7
219 "*Number of days before unused kill file entries are expired.")
221 (defvar gnus-default-article-saver (function gnus-summary-save-in-rmail)
222 "A function to save articles in your favorite format.
223 The function must be interactively callable (in other words, it must
224 be an Emacs command).
226 Gnus provides the following functions:
228 * gnus-summary-save-in-rmail (Rmail format)
229 * gnus-summary-save-in-mail (Unix mail format)
230 * gnus-summary-save-in-folder (MH folder)
231 * gnus-summary-save-in-file (article format).")
233 (defvar gnus-rmail-save-name (function gnus-plain-save-name)
234 "A function generating a file name to save articles in Rmail format.
235 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
237 (defvar gnus-mail-save-name (function gnus-plain-save-name)
238 "A function generating a file name to save articles in Unix mail format.
239 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
241 (defvar gnus-folder-save-name (function gnus-folder-save-name)
242 "A function generating a file name to save articles in MH folder.
243 The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER.")
245 (defvar gnus-file-save-name (function gnus-numeric-save-name)
246 "A function generating a file name to save articles in article format.
247 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
249 (defvar gnus-kill-file-name "KILL"
250 "Suffix of the kill files.")
252 (defvar gnus-fetch-old-headers nil
253 "Non-nil means that Gnus will try to build threads by grabbing old headers.
254 If an unread article in the group refers to an older, already read (or
255 just marked as read) article, the old article will not normally be
256 displayed in the Summary buffer. If this variable is non-nil, Gnus
257 will attempt to grab the headers to the old articles, and thereby
258 build complete threads. `gnus-nov-is-evil' has to be nil if this is
259 to work. If it has the value `some', only enough headers to connect
260 otherwise loose threads will be displayed.")
262 (defvar gnus-visual t
263 "*If non-nil, will do various highlighting.
264 If nil, no mouse highlight (or any other) will be performed. This
265 might speed up Gnus some when generating large group and summary
268 (defvar gnus-novice-user t
269 "*Non-nil means that you are a usenet novice.
270 If non-nil, verbose messages may be displayed and confirmations may be
273 (defvar gnus-expert-user nil
274 "*Non-nil means that you will never be asked for confirmation about anything.
275 And that means *anything*.")
277 (defvar gnus-keep-same-level nil
278 "Non-nil means that the next newsgroup after the current will be on the same level.
279 When you type, for instance, `n' after reading the last article in the
280 current newsgroup, you will go to the next newsgroup. If this variable
281 is nil, the next newsgroup will be the next from the group
282 buffer. If this variable is non-nil, Gnus will either put you in the
283 next newsgroup with the same level, or, if no such newsgroup is
284 available, the next newsgroup with the lowest possible level higher
285 than the current level.")
287 (defvar gnus-summary-make-false-root 'adopt
288 "nil means that Gnus won't gather loose threads.
289 If the root of a thread has expired or been read in a previous
290 session, the information necessary to build a complete thread has been
291 lost. Instead of having many small sub-threads from this original thread
292 scattered all over the summary buffer, Gnus can gather them.
294 If non-nil, Gnus will try to gather all loose sub-threads from an
295 original thread into one large thread.
297 If this variable is non-nil, it should be one of `none', `adopt',
300 If this variable is `none', Gnus will not make a false root, but just
301 present the sub-threads after another.
302 If this variable is `dummy', Gnus will create a dummy root that will
303 have all the sub-threads as children.
304 If this variable is `adopt', Gnus will make one of the \"children\"
305 the parent and mark all the step-children as such.
306 If this variable is `empty', the \"children\" are printed with empty
309 (defvar gnus-summary-gather-subject-limit nil
310 "*Maximum length of subject to compare when gathering loose threads.
311 Use nil to compare the whole subject.")
313 (defvar gnus-check-new-newsgroups t
314 "Non-nil means that Gnus will add new newsgroups at startup.
315 If this variable is `ask-server', Gnus will ask the server for new
316 groups since the last time it checked. This means that the killed list
317 is no longer necessary, so you could set `gnus-save-killed-list' to
319 If this variable is nil, then you have to tell Gnus explicitly to
320 check for new newsgroups with \\<gnus-group-mode-map>\\[gnus-find-new-newsgroups].")
322 (defvar gnus-check-bogus-newsgroups nil
323 "Non-nil means that Gnus will check and remove bogus newsgroup at startup.
324 If this variable is nil, then you have to tell Gnus explicitly to
325 check for bogus newsgroups with \\<gnus-group-mode-map>\\[gnus-group-check-bogus-groups].")
327 (defvar gnus-read-active-file t
328 "Non-nil means that Gnus will read the entire active file at startup.
329 If this variable is nil, Gnus will only read parts of the active file.")
331 (defvar gnus-activate-foreign-newsgroups nil
332 "If nil, Gnus will not check foreign newsgroups at startup.
333 If it is non-nil, it should be a number between one and nine. Foreign
334 newsgroups that have a level lower or equal to this number will be
335 activated on startup. For instance, if you want to active all
336 subscribed newsgroups, but not the rest, you'd set this variable to 5.
338 If you subscribe to lots of newsgroups from different servers, startup
339 might take a while. By setting this variable to nil, you'll save time,
340 but you won't be told how many unread articles there are in the
343 (defvar gnus-save-newsrc-file t
344 "Non-nil means that Gnus will save a .newsrc file.
345 Gnus always saves its own startup file, which is called \".newsrc.el\".
346 The file called \".newsrc\" is in a format that can be readily
347 understood by other newsreaders. If you don't plan on using other
348 newsreaders, set this variable to nil to save some time on exit.")
350 (defvar gnus-save-killed-list t
351 "If non-nil, save the list of killed groups to the startup file.
352 This will save both time (when starting and quitting) and space (on
353 disk), but it will also mean that Gnus has no record of what
354 newsgroups are new or old, so the automatic new newsgroups
355 subscription methods become meaningless. You should always set
356 `gnus-check-new-newsgroups' to nil if you set this variable to nil.")
358 (defvar gnus-interactive-catchup t
359 "Require your confirmation when catching up a newsgroup if non-nil.")
361 (defvar gnus-interactive-post t
362 "Group and subject will be asked for if non-nil.")
364 (defvar gnus-interactive-exit t
365 "Require your confirmation when exiting Gnus if non-nil.")
367 (defvar gnus-kill-killed nil
368 "If non-nil, Gnus will apply kill files to already killd articles.
369 If it is nil, Gnus will never apply kill files to articles that have
370 already been through the scoring process, which might very well save lots
373 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
374 (defvar gnus-summary-same-subject ""
375 "String indicating that the current article has the same subject as the previous.")
377 (defvar gnus-score-interactive-default-score 1000
378 "Scoring commands will raise/lower with this number as the default.")
380 (defvar gnus-summary-default-score 0
381 "Default article score level.
382 If this variable is nil, score levels will not be used.")
384 (defvar gnus-user-login-name nil
385 "The login name of the user.
386 Got from the function `user-login-name' if undefined.")
388 (defvar gnus-user-full-name nil
389 "The full name of the user.
390 Got from the NAME environment variable if undefined.")
392 (defvar gnus-show-mime nil
393 "*Show MIME message if non-nil.")
395 (defvar gnus-show-threads t
396 "*Show conversation threads in summary mode if non-nil.")
398 (defvar gnus-thread-hide-subtree nil
399 "Non-nil means hide thread subtrees initially.
400 If non-nil, you have to run the command `gnus-summary-show-thread' by
401 hand or by using `gnus-select-article-hook' to show hidden threads.")
403 (defvar gnus-thread-hide-killed t
404 "Non-nil means hide killed thread subtrees automatically.")
406 (defvar gnus-thread-ignore-subject nil
407 "Don't take care of subject differences, but only references if non-nil.
408 If it is non-nil, some commands work with subjects do not work properly.")
410 (defvar gnus-thread-indent-level 4
411 "Indentation of thread subtrees.")
413 ;; jwz: nuke newsgroups whose name is all digits - that means that
414 ;; some loser has let articles get into the root of the news spool,
415 ;; which is toxic. Lines beginning with whitespace also tend to be
417 (defvar gnus-ignored-newsgroups
418 (purecopy (mapconcat 'identity
419 '("^to\\." ; not "real" groups
420 "^[0-9. \t]+ " ; all digits in name
421 "[][\"#'() ;\\]" ; bogus characters
424 "A regexp to match uninteresting newsgroups in the active file.
425 Any lines in the active file matching this regular expression are
426 removed from the newsgroup list before anything else is done to it,
427 thus making them effectively non-existant.")
429 (defvar gnus-ignored-headers
430 "^Path:\\|^Posting-Version:\\|^Article-I.D.:\\|^Expires:\\|^Date-Received:\\|^References:\\|^Control:\\|^Xref:\\|^Lines:\\|^Posted:\\|^Relay-Version:\\|^Message-ID:\\|^Nf-ID:\\|^Nf-From:\\|^Approved:\\|^Sender:\\|^Received:\\|^Mail-from:"
431 "All headers that match this regexp will be hidden.
432 Also see `gnus-visible-headers'.")
434 (defvar gnus-visible-headers "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:"
435 "All headers that do not match this regexp will be hidden.
436 Also see `gnus-ignored-headers'.")
438 (defvar gnus-sorted-header-list
439 '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:"
440 "^Date:" "^Organization:")
441 "This variable is a list of regular expressions.
442 If it is non-nil, headers that match the regular expressions will
443 be placed first in the article buffer in the sequence specified by
446 (defvar gnus-required-headers
447 '(From Date Newsgroups Subject Message-ID Organization Lines X-Newsreader)
448 ;; changed by jwz because it's not so nice to do "Lines: 0" by default.
449 ;; and to remove Path, since it's incorrect for Gnus to try
450 ;; and generate that - it is the responsibility of inews or nntpd.
451 "All required headers for articles you post.
452 RFC977 and RFC1036 require From, Date, Newsgroups, Subject, Message-ID
453 and Path headers. Organization, Lines and X-Newsreader are optional.
454 If you want Gnus not to insert some header, remove it from this
457 (defvar gnus-show-all-headers nil
458 "*Show all headers of an article if non-nil.")
460 (defvar gnus-save-all-headers t
461 "*Save all headers of an article if non-nil.")
463 (defvar gnus-inhibit-startup-message nil
464 "The startup message will not be displayed if this function is non-nil.")
466 (defvar gnus-auto-extend-newsgroup t
467 "Extend visible articles to forward and backward if non-nil.")
469 (defvar gnus-auto-select-first t
470 "Select the first unread article automagically if non-nil.
471 If you want to prevent automatic selection of the first unread article
472 in some newsgroups, set the variable to nil in `gnus-select-group-hook'
473 or `gnus-apply-kill-hook'.")
475 (defvar gnus-auto-select-next t
476 "Select the next newsgroup automagically if non-nil.
477 If the value is t and the next newsgroup is empty, Gnus will exit
478 summary mode and go back to group mode. If the value is neither nil
479 nor t, Gnus will select the following unread newsgroup. Especially, if
480 the value is the symbol `quietly', the next unread newsgroup will be
481 selected without any confirmations.")
483 (defvar gnus-auto-select-same nil
484 "Select the next article with the same subject automagically if non-nil.")
486 (defvar gnus-auto-center-summary t
487 "*Always center the current summary in Gnus summary window if non-nil.")
489 (defvar gnus-auto-mail-to-author nil
490 "Insert `To: author' of the article when following up if non-nil.
491 Mail is sent using the function specified by the variable
492 `gnus-mail-send-method'.")
494 (defvar gnus-break-pages t
495 "*Break an article into pages if non-nil.
496 Page delimiter is specified by the variable `gnus-page-delimiter'.")
498 (defvar gnus-page-delimiter "^\^L"
499 "Regexp describing line-beginnings that separate pages of news article.")
501 (defvar gnus-digest-show-summary t
502 "Show a summary of undigestified messages if non-nil.")
504 (defvar gnus-digest-separator "^Subject:[ \t]"
505 "Regexp that separates messages in a digest article.")
507 (defvar gnus-use-full-window t
508 "*Non-nil means to take up the entire screen of Emacs.")
510 (defvar gnus-window-configuration
514 "Specify window configurations for each action.
515 The format of the variable is either a list of (ACTION (G S A)), where
516 G, S, and A are the relative height of group, summary, and article
517 windows, respectively, or a list of (ACTION FUNCTION), where FUNCTION
518 is a function that will be called with ACTION as an argument. ACTION
519 can be `summary', `newsgroups', or `article'.")
521 (defvar gnus-show-mime-method (function metamail-buffer)
522 "Function to process a MIME message.
523 The function is expected to process current buffer as a MIME message.")
525 (defvar gnus-mail-reply-method
526 (function gnus-mail-reply-using-mail)
527 "Function to compose reply mail.
528 The function `gnus-mail-reply-using-mail' uses usual sendmail mail
529 program. The function `gnus-mail-reply-using-mhe' uses the MH-E mail
530 program. You can use yet another program by customizing this variable.")
532 (defvar gnus-mail-forward-method
533 (function gnus-mail-forward-using-mail)
534 "Function to forward current message to another user.
535 The function `gnus-mail-reply-using-mail' uses usual sendmail mail
536 program. You can use yet another program by customizing this variable.")
538 (defvar gnus-mail-other-window-method
539 (function gnus-mail-other-window-using-mail)
540 "Function to compose mail in other window.
541 The function `gnus-mail-other-window-using-mail' uses the usual sendmail
542 mail program. The function `gnus-mail-other-window-using-mhe' uses the MH-E
543 mail program. You can use yet another program by customizing this variable.")
545 (defvar gnus-mail-send-method send-mail-function
546 "Function to mail a message too which is being posted as an article.
547 The message must have To or Cc header. The default is copied from
548 the variable `send-mail-function'.")
550 (defvar gnus-subscribe-newsgroup-method
551 (function gnus-subscribe-zombies)
552 "Function called with a newsgroup name when new newsgroup is found.
553 The function `gnus-subscribe-randomly' inserts a new newsgroup a the
554 beginning of newsgroups. The function `gnus-subscribe-alphabetically'
555 inserts it in strict alphabetic order. The function
556 `gnus-subscribe-hierarchically' inserts it in hierarchical newsgroup
557 order. The function `gnus-subscribe-interactively' asks for your decision.")
559 ;; Suggested by a bug report by Hallvard B Furuseth
560 ;; <h.b.furuseth@usit.uio.no>.
561 (defvar gnus-subscribe-options-newsgroup-method
562 (function gnus-subscribe-alphabetically)
563 "This function is called to subscribe newsgroups mentioned on \"options -n\" lines.
564 If, for instance, you want to subscribe to all newsgroups in the
565 \"no\" and \"alt\" hierarchies, you'd put the following in your
568 options -n no.all alt.all
570 Gnus will the subscribe all new newsgroups in these hierarchies with
571 the subscription method in this variable.")
573 ;; Mark variables suggested by Thomas Michanek
574 ;; <Thomas.Michanek@telelogic.se>.
575 (defvar gnus-unread-mark ?
576 "Mark used for unread articles.")
577 (defvar gnus-ticked-mark ?!
578 "Mark used for ticked articles.")
579 (defvar gnus-dormant-mark ??
580 "Mark used for dormant articles.")
581 (defvar gnus-read-mark ?D
582 "Mark used for read articles.")
583 (defvar gnus-expirable-mark ?E
584 "Mark used for expirable articles.")
585 (defvar gnus-killed-mark ?K
586 "Mark used for killed articles.")
587 (defvar gnus-kill-file-mark ?X
588 "Mark used for articles killed by kill files.")
589 (defvar gnus-low-score-mark ?Y
590 "Mark used for articles with a low score.")
591 (defvar gnus-catchup-mark ?C
592 "Mark used for articles that are caught up.")
593 (defvar gnus-replied-mark ?R
594 "Mark used for articles that have been replied to.")
595 (defvar gnus-process-mark ?#
596 "Mark used for marking articles as processable.")
597 (defvar gnus-ancient-mark ?A
598 "Mark used for ancient articles.")
599 (defvar gnus-canceled-mark ?%
600 "Mark used for cancelled articles.")
602 (defvar gnus-view-pseudo-asynchronously nil
603 "*If non-nil, Gnus will view pseudo-articles asynchronously.")
605 (defvar gnus-group-mode-hook nil
606 "A hook for Gnus group mode.")
608 (defvar gnus-summary-mode-hook nil
609 "A hook for Gnus summary mode.")
611 (defvar gnus-article-mode-hook nil
612 "A hook for Gnus article mode.")
614 (defvar gnus-kill-file-mode-hook nil
615 "A hook for Gnus KILL File mode.")
617 (defvar gnus-open-server-hook nil
618 "A hook called just before opening connection to news server.")
620 (defvar gnus-startup-hook nil
621 "A hook called at startup time.
622 This hook is called after Gnus is connected to the NNTP server. So, it
623 is possible to change the behavior of Gnus according to the selected
626 (defvar gnus-group-prepare-hook nil
627 "A hook called after the newsgroup list is created in the group buffer.
628 If you want to modify the group buffer, you can use this hook.")
630 (defvar gnus-summary-prepare-hook nil
631 "A hook called after summary list is created in the summary buffer.
632 If you want to modify the summary buffer, you can use this hook.")
634 (defvar gnus-article-prepare-hook nil
635 "A hook called after an article is prepared in the article buffer.
636 If you want to run a special decoding program like nkf, use this hook.")
638 (defvar gnus-article-display-hook nil
639 "A hook called after the article is displayed in the article buffer.
640 The hook is designed to change the contents of the article
641 buffer. Typical functions that this hook may contain are
642 `gnus-article-hide-headers' (hide selected headers),
643 `gnus-article-hide-signature' (hide signature) and
644 `gnus-article-treat-overstrike' (turn \"^H_\" into bold characters).")
645 (add-hook 'gnus-article-display-hook 'gnus-article-hide-headers-if-wanted)
646 (add-hook 'gnus-article-display-hook 'gnus-article-treat-overstrike)
648 (defvar gnus-select-group-hook nil
649 "A hook called when a newsgroup is selected.
651 If you'd like to simplify subjects like the
652 `gnus-summary-next-same-subject' command does, you can use the
655 (setq gnus-select-group-hook
658 (mapcar (lambda (header)
661 (gnus-simplify-subject
662 (header-subject header) 're-only)))
663 gnus-newsgroup-headers))))
666 (defvar gnus-select-article-hook
667 '(gnus-summary-show-thread)
668 "A hook called when an article is selected.
669 The default hook shows conversation thread subtrees of the selected
670 article automatically using `gnus-summary-show-thread'.
672 If you'd like to run RMAIL on a digest article automagically, you can
673 use the following hook:
675 \(setq gnus-select-article-hook
678 (gnus-summary-show-thread)
679 (cond ((string-equal \"comp.sys.sun\" gnus-newsgroup-name)
680 (gnus-summary-rmail-digest))
681 ((and (string-equal \"comp.text\" gnus-newsgroup-name)
682 (string-match \"^TeXhax Digest\"
683 (header-subject gnus-current-headers)))
684 (gnus-summary-rmail-digest)
687 (defvar gnus-select-digest-hook
690 ;; Reply-To: is required by `undigestify-rmail-message'.
691 (or (mail-position-on-field "Reply-to" t)
693 (mail-position-on-field "Reply-to")
694 (insert (gnus-fetch-field "From"))))))
695 "A hook called when reading digest messages using Rmail.
696 This hook can be used to modify incomplete digest articles as follows
697 \(this is the default):
699 \(setq gnus-select-digest-hook
702 ;; Reply-To: is required by `undigestify-rmail-message'.
703 (or (mail-position-on-field \"Reply-to\" t)
705 (mail-position-on-field \"Reply-to\")
706 (insert (gnus-fetch-field \"From\")))))))")
708 (defvar gnus-rmail-digest-hook nil
709 "A hook called when reading digest messages using Rmail.
710 This hook is intended to customize Rmail mode for reading digest articles.")
712 (defvar gnus-apply-kill-hook '(gnus-apply-kill-file)
713 "A hook called when a newsgroup is selected and summary list is prepared.
714 This hook is intended to apply a kill file to the selected newsgroup.
715 The function `gnus-apply-kill-file' is called by default.
717 Since a general kill file is too heavy to use only for a few
718 newsgroups, I recommend you to use a lighter hook function. For
719 example, if you'd like to apply a kill file to articles which contains
720 a string `rmgroup' in subject in newsgroup `control', you can use the
723 \(setq gnus-apply-kill-hook
726 (cond ((string-match \"control\" gnus-newsgroup-name)
727 (gnus-kill \"Subject\" \"rmgroup\")
728 (gnus-expunge \"X\"))))))")
730 (defvar gnus-visual-mark-article-hook
731 (list 'gnus-visual-highlight-selected-summary)
732 "Hook run after selecting an article in the summary buffer.
733 It is meant to be used for highlighting the article in some way. It is
734 not run if `gnus-visual' is nil.")
736 (defvar gnus-prepare-article-hook (list (function gnus-inews-insert-signature))
737 "A hook called after preparing body, but before preparing header headers.
738 The default hook (`gnus-inews-insert-signature') inserts a signature
739 file specified by the variable `gnus-signature-file'.")
741 (defvar gnus-inews-article-hook (list (function gnus-inews-do-fcc))
742 "A hook called before finally posting an article.
743 The default hook (`gnus-inews-do-fcc') does FCC processing (save article
746 (defvar gnus-exit-group-hook nil
747 "A hook called when exiting (not quitting) summary mode.
748 If your machine is so slow that exiting from summary mode takes very
749 long time, set the variable `gnus-use-cross-reference' to nil. This
750 inhibits marking articles as read using cross-reference information.")
752 (defvar gnus-suspend-gnus-hook nil
753 "A hook called when suspending (not exiting) Gnus.")
755 (defvar gnus-exit-gnus-hook (list 'nntp-request-close)
756 "A hook called when exiting Gnus.")
758 (defvar gnus-save-newsrc-hook nil
759 "A hook called when saving the newsrc file.
760 This hook is called before saving the `.newsrc' file.")
762 (defvar gnus-auto-expirable-newsgroups nil
763 "All newsgroups that match this regexp will have all read articles automatically marked as expirable.")
765 (defvar gnus-subscribe-hierarchical-interactive nil
766 "If non-nil, Gnus will offer to subscribe hierarchically.
767 When a new hierarchy appears, Gnus will ask the user:
769 'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys):
771 If the user pressed `d', Gnus will descend the hierarchy, `y' will
772 subscribe to all newsgroups in the hierarchy and `s' will skip this
773 hierarchy in its entirety.")
775 (defvar gnus-group-line-format "%M%S%5y: %(%g%)\n"
776 "Format of groups lines.
777 It works along the same lines as a normal formatting string,
778 with some simple extrensions.
780 %M Only marked articles (character, \"*\" or \" \")
781 %S Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \")
782 %L Level of subscribedness (integer, 1-9)
783 %N Number of unread articles (integer)
784 %I Number of dormant articles (integer)
785 %i Number of ticked and dormant (integer)
786 %T Number of ticked articles (integer)
787 %R Number of read articles (integer)
788 %t Total number of articles (integer)
789 %y Number of unread, unticked articles (integer)
790 %G Group name (string)
791 %g Qualified group name (string)
792 %D Group description (string)
793 %s Select method (string)
794 %o Moderated group (char, \"m\")
795 %O Moderated group (string, \"(m)\" or \"\")
796 %n Select from where (string)
797 %z A string that look like `<%s:%n>' if a foreign select method is used
798 %u User defined specifier. The next character in the format string should
799 be a letter. GNUS will call the function gnus-user-format-function-X,
800 where X is the letter following %u. The function will be passed the
801 current header as argument. The function should return a string, which
802 will be inserted into the summary just like information from any other
805 Text between %( and %) will be highlighted with `gnus-mouse-face' when
806 the mouse point move inside the area. There can only be one such area.
808 Note that this format specification is not always respected. For
809 reasons of efficiency, when listing killed groups, this specification
810 is ignored altogether. If the spec is changed considerably, your
811 output may end up looking strange when listing both alive and killed
814 If you use %o or %O, reading the active file will be slower and quite
815 a bit of extra memory will be used. %D will also worsen performance.
816 Also note that if you change the format specification to include any
817 of these specs, you must probably re-start Gnus to see them go into
820 (defvar gnus-summary-line-format "%U%R %I%(%[%4L: %-20,20n%]%) %s\n"
821 "The format specification of the lines in the summary buffer.
822 The first specification must always be \"%U%R\", at least in this
825 It works along the same lines as a normal formatting string,
826 with some simple extensions.
828 %N Article number, left padded with spaces (integer)
830 %s Subject if it is at the root of a thread, and \"\" otherwise (string)
831 %n Name of the poster (string)
832 %A Address of the poster (string)
833 %L Number of lines in the article (integer)
834 %c Number of characters in the article (integer)
835 %D Date of the article (string)
836 %I Indentation based on thread level (a string of spaces)
837 %T A string with two possible values: 80 spaces if the article
838 is on thread level two or larger and 0 spaces on level one
839 %U Status of this article (character, \"D\", \"K\", \"-\" or \" \")
840 %[ Opening bracket (character, \"[\" or \"<\")
841 %] Closing bracket (character, \"]\" or \">\")
842 %> Spaces of length thread-level (string)
843 %< Spaces of length (- 20 thread-level) (string)
844 %i Article score (number)
845 %z Article zcore (character)
846 %u User defined specifier. The next character in the format string should
847 be a letter. GNUS will call the function gnus-user-format-function-X,
848 where X is the letter following %u. The function will be passed the
849 current header as argument. The function should return a string, which
850 will be inserted into the summary just like information from any other
853 Text between %( and %) will be highlighted with `gnus-mouse-face'
854 when the mouse point is placed inside the area. There can only be one
857 (defconst gnus-summary-dummy-line-format "* : : %S\n"
858 "The format specification for the dummy roots in the summary buffer.
859 It works along the same lines as a normal formatting string,
860 with some simple extensions.
864 (defvar gnus-summary-mode-line-format "(ding) %G/%A %Z"
865 "The format specification for the summary mode line.")
867 (defvar gnus-article-mode-line-format "(ding) %G/%A %S"
868 "The format specification for the article mode line.")
870 (defconst gnus-group-mode-line-format "(ding) List of groups {%M:%S}"
871 "The format specification for the group mode line.")
875 ;; Site dependent variables. You have to define these variables in
876 ;; site-init.el, default.el or your .emacs.
878 (defvar gnus-local-timezone nil
880 This value is used only if `current-time-zone' does not work in your Emacs.
881 It specifies the GMT offset, i.e. a decimal integer
882 of the form +-HHMM giving the hours and minutes ahead of (i.e. east of) GMT.
883 For example, +0900 should be used in Japan, since it is 9 hours ahead of GMT.
885 For backwards compatibility, it may also be a string like \"JST\",
886 but strings are obsolescent: you should use numeric offsets instead.")
888 (defvar gnus-local-domain nil
889 "Local domain name without a host name.
890 The DOMAINNAME environment variable is used instead if it is defined.
891 If the `system-name' function returns the full Internet name, there is
892 no need to set this variable.")
894 (defvar gnus-local-organization nil
895 "String with a description of what organization (if any) the user belongs to.
896 The ORGANIZATION environment variable is used instead if it is defined.
897 If this variable contains a function, this function will be called
898 with the current newsgroup name as the argument. The function should
900 In any case, if the string (either in the variable, in the environment
901 variable, or returned by the function) is a file name, the contents of
902 this file will be used as the organization.")
904 (defvar gnus-use-generic-from nil
905 "If nil, the full host name will be the system name prepended to the domain name.
906 If this is a string, the full host name will be this string.
907 If this is non-nil, non-string, the domain name will be used as the
910 (defvar gnus-use-generic-path nil
911 "If nil, use the NNTP server name in the Path header.
912 If stringp, use this; if non-nil, use no host name (user name only).")
914 (defvar gnus-valid-select-methods
915 '(("nntp" post address) ("nnspool" post) ("nnvirtual" none)
916 ("nnmbox" mail respool) ("nnml" mail respool)
917 ("nnmh" mail respool) ("nndir" none))
918 "A list of valid select methods.
919 Each element in this list should be a list. The first element of these
920 lists should be a string with the name of the select method. The
921 other elements may be be the category of this method (ie. `post',
922 `mail', `none' or whatever) or other properties that this method has
923 (like being respoolable).
924 If you implement a new select method, all you should have to change is
925 this variable. I think.")
927 (defvar gnus-updated-mode-lines '(group article summary)
928 "This variable is a list of buffers that should keep their mode lines updated.
929 The list may contain the symbols `group', `article' and `summary'. If
930 the corresponding symbol is present, Gnus will keep that mode line
931 updated with information that may be pertinent.
932 If this variable is nil, screen refresh may be quicker.")
934 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
935 (defvar gnus-mouse-face 'highlight
936 "Face used for mouse highlighting in Gnus.
937 No mouse highlights will be done if `gnus-visual' is nil.")
939 (defvar gnus-visual-summary-update-hook
940 (list 'gnus-visual-summary-highlight-line)
941 "A hook called when a summary line is changed.
942 The hook will not be called if `gnus-visual' is nil.
944 Point will be at the beginning of the line, and the following free
945 variables can be used for convenience:
947 score: (gnus-summary-article-score)
948 default: gnus-summary-default-score
949 below: gnus-summary-mark-below
951 The default hook `gnus-visual-summary-highlight-line' will highlight the line
952 according to the `gnus-visual-summary-highlight' variable.")
954 (defvar gnus-summary-mark-below nil
955 "Score below which articles automatically become marked.
956 This variable is local to each summary buffer and usually set in the
959 (defvar gnus-thread-sort-functions '(gnus-thread-sort-by-number)
960 "List of functions used for thread roots in the summary buffer.
962 Each function takes two threads and return non-nil if the first thread
963 should be sorted before the other. If you use more than one function,
964 list the function you want to act as the primary sort key last.
966 Functions you can use are:
967 - gnus-thread-sort-by-number
968 - gnus-thread-sort-by-author
969 - gnus-thread-sort-by-subject
970 - gnus-thread-sort-by-date
971 - gnus-thread-sort-by-score
972 - gnus-thread-sort-by-total-score (see `gnus-thread-score-function').
974 The two later only works on articles that have already been scored prior
975 to entering the newsgroup.")
977 (defvar gnus-thread-score-function '+
978 "Function used for calculating the total score of a thread.
980 The function is called with the scores of the article and each
981 subthread and should then return the score of the thread.
983 Some functions you can use are `+', `max', or `min'.")
985 (defvar gnus-score-hierarchical t
986 "If non-nil, a SCORE file for a group also applies to subgroups.")
988 (defvar gnus-score-find-score-files-function nil
989 "If non-nil, it should be a function that returns a list of score files.
990 The function will be called with the name of the group that is to be
991 scored. This function does not have to make sure that the file names
992 returned actually exist.")
995 ;; Internal variables
997 ;; Avoid highlighting in kill files.
998 (defvar gnus-summary-inhibit-highlight nil)
1000 (defvar caesar-translate-table nil)
1002 (defvar gnus-dribble-buffer nil)
1003 (defvar gnus-headers-retrieved-by nil)
1005 (defvar gnus-article-reply nil)
1006 (defvar gnus-article-check-size nil)
1008 (defvar gnus-score-file-list nil)
1009 (defvar gnus-score-alist nil
1010 "Alist containing score information.
1011 The keys can be symbols or strings. The following symbols are defined.
1013 touched: If this alist has been modified.
1014 mark: Automatically mark articles below this.
1015 expunge: Automatically expunge articles below this.
1016 files: List of other SCORE files to load when loading this one.
1017 eval: Sexp to be evaluated when the score file is loaded.
1019 String entries have the form (HEADER (MATCH TYPE SCORE DATE) ...)
1020 where HEADER is the header being scored, MATCH is the string we are
1021 looking for, TYPE is a flag indicating whether it should use regexp or
1022 substring matching, SCORE is the score to add and DATE is the date
1023 of the last succesful match.")
1025 (defvar gnus-score-cache nil)
1026 ;; Alist containing the content of all loaded SCORE files.
1028 (defvar gnus-header-index nil)
1029 (defvar gnus-score-index nil)
1031 (defvar gnus-newsgroup-dependencies nil)
1033 (defconst gnus-group-edit-buffer "*Gnus edit newsgroup*")
1035 (defvar gnus-default-subscribe-level 2
1036 "Default subscription level.")
1038 (defvar gnus-default-unsubscribe-level 6
1039 "Default unsubscription level.")
1041 (defvar gnus-default-kill-level 9
1042 "Default kill level.")
1044 (defconst gnus-group-line-format-alist
1045 (list (list ?M 'marked ?c)
1046 (list ?S 'subscribed ?c)
1048 (list ?N 'number ?s)
1049 (list ?I 'number-of-dormant ?d)
1050 (list ?T 'number-of-ticked ?d)
1051 (list ?R 'number-of-read ?s)
1052 (list ?t 'number-total ?d)
1053 (list ?y 'number-of-unread-unticked ?s)
1054 (list ?i 'number-of-ticked-and-dormant ?d)
1056 (list ?G 'qualified-group ?s)
1057 (list ?D 'newsgroup-description ?s)
1058 (list ?o 'moderated ?c)
1059 (list ?O 'moderated-string ?s)
1060 (list ?s 'news-server ?s)
1061 (list ?n 'news-method ?s)
1062 (list ?z 'news-method-string ?s)
1063 (list ?u 'user-defined ?s)))
1065 (defconst gnus-summary-line-format-alist
1066 (list (list ?N 'number ?d)
1067 (list ?S 'subject ?s)
1068 (list ?s 'subject-or-nil ?s)
1070 (list ?A 'address ?s)
1072 (list ?x (macroexpand '(header-xref header)) ?s)
1073 (list ?D (macroexpand '(header-date header)) ?s)
1074 (list ?M (macroexpand '(header-id header)) ?s)
1075 (list ?r (macroexpand '(header-references header)) ?s)
1076 (list ?c (macroexpand '(header-chars header)) ?d)
1078 (list ?I 'indentation ?s)
1079 (list ?T '(if (< level 1) "" (make-string (frame-width) ? )) ?s)
1080 (list ?R 'replied ?c)
1081 (list ?\[ 'opening-bracket ?c)
1082 (list ?\] 'closing-bracket ?c)
1083 (list ?\> '(make-string level ? ) ?s)
1084 (list ?\< '(make-string (max 0 (- 20 level)) ? ) ?s)
1086 (list ?z 'score-char ?c)
1087 (list ?U 'unread ?c)
1088 (list ?u 'user-defined ?s))
1089 "An alist of format specifications that can appear in summary lines,
1090 and what variables they correspond with, along with the type of the
1091 variable (string, integer, character, etc).")
1093 (defconst gnus-summary-dummy-line-format-alist
1094 (list (list ?S 'subject ?s)
1095 (list ?N 'number ?d)))
1097 (defconst gnus-summary-mode-line-format-alist
1098 (list (list ?G 'group-name ?s)
1099 (list ?A 'article-number ?d)
1100 (list ?Z 'unread-and-unselected ?s)
1101 (list ?V 'gnus-version ?s)
1102 (list ?U 'unread ?d)
1103 (list ?S 'subject ?s)
1104 (list ?u 'unselected ?d)))
1106 (defconst gnus-group-mode-line-format-alist
1107 (list (list ?S 'news-server ?s)
1108 (list ?M 'news-method ?s)))
1110 (defvar gnus-have-read-active-file nil)
1112 (defconst gnus-maintainer "Lars Magne Ingebrigtsen <larsi@ifi.uio.no>"
1113 "The mail address of the Gnus maintainer.")
1115 (defconst gnus-version "(ding) Gnus v0.20"
1116 "Version number for this version of Gnus.")
1118 (defvar gnus-info-nodes
1119 '((gnus-group-mode "(gnus)Group Commands")
1120 (gnus-summary-mode "(gnus)Summary Commands")
1121 (gnus-article-mode "(gnus)Article Commands")
1122 (gnus-kill-file-mode "(gnus)Kill File"))
1123 "Assoc list of major modes and related Info nodes.")
1125 (defvar gnus-group-buffer "*Group*")
1126 (defvar gnus-summary-buffer "*Summary*")
1127 (defvar gnus-article-buffer "*Article*")
1128 (defvar gnus-digest-buffer "Gnus Digest")
1129 (defvar gnus-digest-summary-buffer "Gnus Digest-summary")
1131 (defvar gnus-buffer-list nil
1132 "Gnus buffers that should be killed when exiting.")
1134 (defvar gnus-variable-list
1135 '(gnus-newsrc-options
1136 gnus-newsrc-options-n-yes gnus-newsrc-options-n-no
1137 gnus-newsrc-last-checked-date
1138 gnus-newsrc-assoc gnus-killed-list gnus-zombie-list)
1139 "Gnus variables saved in the quick startup file.")
1141 (defvar gnus-overload-functions
1142 '((news-inews gnus-inews-news "rnewspost")
1143 (caesar-region gnus-caesar-region "rnews"))
1144 "Functions overloaded by gnus.
1145 It is a list of `(original overload &optional file)'.")
1147 (defvar gnus-newsrc-options nil
1148 "Options line in the .newsrc file.")
1150 (defvar gnus-newsrc-options-n-yes nil
1151 "Regexp representing subscribed newsgroups.")
1153 (defvar gnus-newsrc-options-n-no nil
1154 "Regexp representing unsubscribed newsgroups.")
1156 (defvar gnus-newsrc-last-checked-date nil
1157 "Date Gnus last asked server for new newsgroups.")
1159 (defvar gnus-newsrc-assoc nil
1160 "Assoc list of read articles.
1161 gnus-newsrc-hashtb should be kept so that both hold the same information.")
1163 (defvar gnus-newsrc-hashtb nil
1164 "Hashtable of gnus-newsrc-assoc.")
1166 (defvar gnus-killed-list nil
1167 "List of killed newsgroups.")
1169 (defvar gnus-killed-hashtb nil
1170 "Hash table equivalent of gnus-killed-list.")
1172 (defvar gnus-zombie-list nil
1173 "List of almost dead newsgroups.")
1175 (defvar gnus-description-hashtb nil
1176 "Descriptions of newsgroups.")
1178 (defvar gnus-list-of-killed-groups nil
1179 "List of newsgroups that have recently been killed by the user.")
1181 (defvar gnus-xref-hashtb nil
1182 "Hash table of cross-posted articles.")
1184 (defvar gnus-active-hashtb nil
1185 "Hashtable of active articles.")
1187 (defvar gnus-moderated-list nil
1188 "List of moderated newsgroups.")
1190 (defvar gnus-current-startup-file nil
1191 "Startup file for the current host.")
1193 (defvar gnus-last-search-regexp nil
1194 "Default regexp for article search command.")
1196 (defvar gnus-last-shell-command nil
1197 "Default shell command on article.")
1199 (defvar gnus-current-select-method nil
1200 "The current method for selecting a newsgroup.")
1202 (defvar gnus-have-all-newsgroups nil)
1204 (defvar gnus-article-internal-prepare-hook nil)
1206 (defvar gnus-newsgroup-name nil)
1207 (defvar gnus-newsgroup-begin nil)
1208 (defvar gnus-newsgroup-end nil)
1209 (defvar gnus-newsgroup-last-rmail nil)
1210 (defvar gnus-newsgroup-last-mail nil)
1211 (defvar gnus-newsgroup-last-folder nil)
1212 (defvar gnus-newsgroup-last-file nil)
1213 (defvar gnus-newsgroup-auto-expire nil
1214 "If non-nil, all read articles will be marked as expirable.")
1216 (defvar gnus-newsgroup-selected-overlay nil)
1218 (defvar gnus-newsgroup-unreads nil
1219 "List of unread articles in the current newsgroup.")
1221 (defvar gnus-newsgroup-unselected nil
1222 "List of unselected unread articles in the current newsgroup.")
1224 (defvar gnus-newsgroup-marked nil
1225 "List of ticked articles in the current newsgroup (a subset of unread art).")
1227 (defvar gnus-newsgroup-killed nil
1228 "List of ranges of articles that have been through the scoring process.")
1230 (defvar gnus-newsgroup-kill-headers nil)
1232 (defvar gnus-newsgroup-replied nil
1233 "List of articles that have been replied to in the current newsgroup.")
1235 (defvar gnus-newsgroup-expirable nil
1236 "List of articles in the current newsgroup that can be expired.")
1238 (defvar gnus-newsgroup-processable nil
1239 "List of articles in the current newsgroup that can be processed.")
1241 (defvar gnus-newsgroup-bookmarks nil
1242 "List of articles in the current newsgroup that have bookmarks.")
1244 (defvar gnus-newsgroup-dormant nil
1245 "List of dormant articles in the current newsgroup.")
1247 (defvar gnus-newsgroup-scored nil
1248 "List of scored articles in the current newsgroup.")
1250 (defvar gnus-newsgroup-headers nil
1251 "List of article headers in the current newsgroup.")
1252 (defvar gnus-newsgroup-headers-hashtb-by-number nil)
1254 (defvar gnus-newsgroup-ancient nil
1255 "List of `gnus-fetch-old-headers' articles in the current newsgroup.")
1257 (defvar gnus-current-article nil)
1258 (defvar gnus-article-current nil)
1259 (defvar gnus-current-headers nil)
1260 (defvar gnus-have-all-headers nil "Must be either T or NIL.")
1261 (defvar gnus-last-article nil)
1262 (defvar gnus-current-kill-article nil)
1263 (defvar gnus-newsgroup-dormant-subjects nil)
1264 (defvar gnus-newsgroup-expunged-buffer nil)
1266 ;; Save window configuration.
1267 (defvar gnus-winconf-kill-file nil)
1269 (defconst gnus-group-mode-map nil)
1270 (defvar gnus-article-mode-map nil)
1271 (defvar gnus-kill-file-mode-map nil)
1274 (defvar gnus-summary-line-format-spec nil)
1275 (defvar gnus-summary-dummy-line-format-spec nil)
1276 (defvar gnus-group-line-format-spec nil)
1277 (defvar gnus-summary-mode-line-format-spec nil)
1278 (defvar gnus-article-mode-line-format-spec nil)
1279 (defvar gnus-group-mode-line-format-spec nil)
1280 (defvar gnus-summary-expunge-below nil)
1281 (defvar gnus-reffed-article-number nil)
1283 (defvar rmail-default-file (expand-file-name "~/XMBOX"))
1284 (defvar rmail-default-rmail-file (expand-file-name "~/XNEWS"))
1286 (defconst gnus-summary-local-variables
1287 '(gnus-newsgroup-name
1288 gnus-newsgroup-begin gnus-newsgroup-end
1289 gnus-newsgroup-last-rmail gnus-newsgroup-last-mail
1290 gnus-newsgroup-last-folder gnus-newsgroup-last-file
1291 gnus-newsgroup-auto-expire gnus-newsgroup-unreads
1292 gnus-newsgroup-unselected gnus-newsgroup-marked
1293 gnus-newsgroup-replied gnus-newsgroup-expirable
1294 gnus-newsgroup-processable gnus-newsgroup-killed
1295 gnus-newsgroup-bookmarks gnus-newsgroup-dormant
1296 gnus-newsgroup-dormant-subjects gnus-newsgroup-expunged-buffer
1297 gnus-newsgroup-headers gnus-newsgroup-headers-hashtb-by-number
1298 gnus-current-article gnus-current-headers gnus-have-all-headers
1299 gnus-last-article gnus-article-internal-prepare-hook
1300 gnus-newsgroup-selected-overlay gnus-newsgroup-dependencies
1301 gnus-newsgroup-scored gnus-newsgroup-kill-headers
1302 gnus-score-alist gnus-summary-expunge-below
1303 gnus-summary-mark-below gnus-newsgroup-ancient)
1304 "Variables that are buffer-local to the summary buffers.")
1306 (defvar gnus-mark-article-hook
1309 (or (memq gnus-current-article gnus-newsgroup-marked)
1310 (memq gnus-current-article gnus-newsgroup-dormant)
1311 (memq gnus-current-article gnus-newsgroup-expirable)
1312 (gnus-summary-mark-as-read gnus-current-article))))
1313 "A hook called when an article is selected at the first time.
1314 The hook is intended to mark an article as read (or unread)
1315 automatically when it is selected.
1317 If you'd like to tick articles instead, use the following hook:
1319 \(setq gnus-mark-article-hook
1322 (gnus-summary-tick-article gnus-current-article))))")
1324 ;; Define some autoload functions Gnus may use.
1326 (autoload 'metamail-buffer "metamail")
1327 (autoload 'Info-goto-node "info")
1329 (autoload 'timezone-make-date-arpa-standard "timezone")
1330 (autoload 'timezone-fix-time "timezone")
1331 (autoload 'timezone-make-sortable-date "timezone")
1332 (autoload 'timezone-make-time-string "timezone")
1334 (autoload 'rmail-output "rmailout"
1335 "Append this message to Unix mail file named FILE-NAME." t)
1336 (autoload 'mail-position-on-field "sendmail")
1337 (autoload 'mail-setup "sendmail")
1339 (autoload 'gnus-mail-reply-using-mhe "gnus-mh")
1340 (autoload 'gnus-mail-forward-using-mhe "gnus-mh")
1341 (autoload 'gnus-mail-other-window-using-mhe "gnus-mh")
1342 (autoload 'gnus-summary-save-in-folder "gnus-mh")
1343 (autoload 'gnus-Folder-save-name "gnus-mh")
1344 (autoload 'gnus-folder-save-name "gnus-mh")
1346 (autoload 'gnus-group-make-menu-bar "gnus-visual")
1347 (autoload 'gnus-summary-make-menu-bar "gnus-visual")
1348 (autoload 'gnus-article-make-menu-bar "gnus-visual")
1349 (autoload 'gnus-visual-highlight-selected-summary "gnus-visual")
1350 (autoload 'gnus-visual-summary-highlight-line "gnus-visual")
1352 (autoload 'gnus-uu-decode-map "gnus-uu" nil nil 'keymap)
1353 (autoload 'gnus-uu-mark-by-regexp "gnus-uu")
1354 (autoload 'gnus-uu-mark-region "gnus-uu")
1355 (autoload 'gnus-uu-mark-thread "gnus-uu")
1356 (autoload 'gnus-uu-mark-sparse "gnus-uu")
1357 (autoload 'gnus-uu-post-news "gnus-uu")
1358 (autoload 'gnus-uu-digest-and-forward "gnus-uu")
1359 (autoload 'gnus-uu-decode-uu "gnus-uu")
1360 (autoload 'gnus-uu-decode-uu-and-save "gnus-uu")
1361 (autoload 'gnus-uu-decode-unshar "gnus-uu")
1362 (autoload 'gnus-uu-decode-unshar-and-save "gnus-uu")
1363 (autoload 'gnus-uu-decode-save "gnus-uu")
1364 (autoload 'gnus-uu-decode-save "gnus-uu")
1365 (autoload 'gnus-uu-decode-binhex "gnus-uu")
1366 (autoload 'gnus-uu-decode-binhex "gnus-uu")
1371 (put 'gnus-group-mode 'mode-class 'special)
1372 (put 'gnus-summary-mode 'mode-class 'special)
1373 (put 'gnus-article-mode 'mode-class 'special)
1377 ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
1378 (defun gnus-summary-position-cursor () nil)
1379 (defun gnus-group-position-cursor () nil)
1380 (fset 'gnus-summary-position-cursor 'gnus-goto-colon)
1381 (fset 'gnus-group-position-cursor 'gnus-goto-colon)
1383 (defmacro gnus-eval-in-buffer-window (buffer &rest forms)
1384 "Pop to BUFFER, evaluate FORMS, and then returns to original window."
1385 (` (let ((GnusStartBufferWindow (selected-window)))
1388 (pop-to-buffer (, buffer))
1390 (select-window GnusStartBufferWindow)))))
1392 (defun gnus-make-hashtable (&optional hashsize)
1393 "Make a hash table (default and minimum size is 255).
1394 Optional argument HASHSIZE specifies the table size."
1395 (make-vector (if hashsize
1396 (max (gnus-create-hash-size hashsize) 255)
1399 (defmacro gnus-gethash (string hashtable)
1400 "Get hash value of STRING in HASHTABLE."
1401 ;;(` (symbol-value (abbrev-symbol (, string) (, hashtable))))
1402 ;;(` (abbrev-expansion (, string) (, hashtable)))
1403 (` (symbol-value (intern-soft (, string) (, hashtable)))))
1405 (defmacro gnus-sethash (string value hashtable)
1406 "Set hash value. Arguments are STRING, VALUE, and HASHTABLE."
1407 ;; We cannot use define-abbrev since it only accepts string as value.
1408 ; (set (intern string hashtable) value))
1409 (` (set (intern (, string) (, hashtable)) (, value))))
1411 (defsubst gnus-buffer-substring (beg end)
1412 (buffer-substring (match-beginning beg) (match-end end)))
1414 (defsubst gnus-simplify-subject-re (subject)
1415 "Remove \"Re:\" from subject lines."
1416 (let ((case-fold-search t))
1417 (if (string-match "^re: *" subject)
1418 (substring subject (match-end 0))
1421 (defsubst gnus-goto-char (point)
1422 (and point (goto-char point)))
1426 ;;; Gnus Utility Functions
1429 (defun gnus-extract-address-components (from)
1431 (if (string-match "([^)]+)" from)
1432 (setq name (substring from (1+ (match-beginning 0))
1433 (1- (match-end 0)))))
1434 ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
1435 (if (string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from)
1436 (setq address (substring from (match-beginning 0) (match-end 0))))
1437 (if (and (not name) address)
1438 (if (string-match (concat "<" (regexp-quote address) ">") from)
1439 (setq name (substring from 0 (1- (match-beginning 0))))))
1440 (list (or name from) (or address from))))
1442 (defun gnus-fetch-field (field)
1443 "Return the value of the header FIELD of current article."
1446 (gnus-narrow-to-headers)
1447 (mail-fetch-field field))))
1449 (defun gnus-goto-colon ()
1451 (search-forward ":" (save-excursion (end-of-line) (point)) t))
1453 (defun gnus-narrow-to-headers ()
1457 (if (search-forward "\n\n")
1458 (narrow-to-region 1 (1- (point))))))
1460 ;; Get a number that is suitable for hashing; bigger than MIN
1461 (defun gnus-create-hash-size (min)
1467 (defun gnus-update-format-specifications ()
1468 (setq gnus-summary-line-format-spec
1469 (gnus-parse-format gnus-summary-line-format
1470 gnus-summary-line-format-alist))
1471 (setq gnus-summary-dummy-line-format-spec
1472 (gnus-parse-format gnus-summary-dummy-line-format
1473 gnus-summary-dummy-line-format-alist))
1474 (setq gnus-group-line-format-spec
1476 gnus-group-line-format
1477 gnus-group-line-format-alist))
1478 (if (and (string-match "%D" gnus-group-line-format)
1479 (not gnus-description-hashtb))
1480 (gnus-read-descriptions-file))
1481 (setq gnus-summary-mode-line-format-spec
1482 (gnus-parse-format gnus-summary-mode-line-format
1483 gnus-summary-mode-line-format-alist))
1484 (setq gnus-article-mode-line-format-spec
1485 (gnus-parse-format gnus-article-mode-line-format
1486 gnus-summary-mode-line-format-alist))
1487 (setq gnus-group-mode-line-format-spec
1488 (gnus-parse-format gnus-group-mode-line-format
1489 gnus-group-mode-line-format-alist)))
1491 (defun gnus-format-max-width (var length)
1493 (if (> (length (setq result (eval var))) length)
1494 (format "%s" (substring result 0 length))
1495 (format "%s" result))))
1497 (defun gnus-set-mouse-face (string)
1498 ;; Set mouse face property on STRING.
1499 (put-text-property 0 (length string) 'mouse-face gnus-mouse-face string)
1502 (defun gnus-parse-format (format spec-alist)
1503 ;; This function parses the FORMAT string with the help of the
1504 ;; SPEC-ALIST and returns a list that can be eval'ed to return the
1505 ;; string. If the FORMAT string contains the specifiers %( and %)
1506 ;; the text between them will have the mouse-face text property.
1507 (if (string-match "\\`\\(.*\\)%(\\(.*\\)%)\\(.*\n?\\)\\'" format)
1508 (if (and gnus-visual gnus-mouse-face)
1509 (let ((pre (substring format (match-beginning 1) (match-end 1)))
1510 (button (substring format (match-beginning 2) (match-end 2)))
1511 (post (substring format (match-beginning 3) (match-end 3))))
1513 (gnus-parse-simple-format pre spec-alist)
1514 (list 'gnus-set-mouse-face
1515 (gnus-parse-simple-format button spec-alist))
1516 (gnus-parse-simple-format post spec-alist)))
1517 (gnus-parse-simple-format
1518 (concat (substring format (match-beginning 1) (match-end 1))
1519 (substring format (match-beginning 2) (match-end 2))
1520 (substring format (match-beginning 3) (match-end 3)))
1522 (gnus-parse-simple-format format spec-alist)))
1524 (defun gnus-parse-simple-format (format spec-alist)
1525 ;; This function parses the FORMAT string with the help of the
1526 ;; SPEC-ALIST and returns a list that can be eval'ed to return the
1527 ;; string. The list will consist of the symbol `format', a format
1528 ;; specification string, and a list of forms depending on the
1531 spec flist fstring b newspec max-width elem beg)
1533 (set-buffer (get-buffer-create "*gnus work*"))
1534 (buffer-disable-undo (current-buffer))
1535 (gnus-add-current-to-buffer-list)
1539 (while (re-search-forward "%[-0-9]*\\(,[0-9]*\\)*\\(.\\)\\(.\\)?" nil t)
1540 (setq spec (string-to-char (buffer-substring (match-beginning 2)
1542 ;; First check if there are any specs that look anything like
1543 ;; "%12,12A", ie. with a "max width specification". These have
1544 ;; to be treated specially.
1545 (if (setq beg (match-beginning 1))
1548 (buffer-substring (1+ (match-beginning 1)) (match-end 1))))
1550 (setq beg (match-beginning 2)))
1551 ;; Find the specification from `spec-alist'.
1552 (if (not (setq elem (cdr (assq spec spec-alist))))
1553 (setq elem '("*" ?s)))
1554 ;; Treat user defined format specifiers specially
1555 (and (eq (car elem) 'user-defined)
1558 (list (intern (concat "gnus-user-format-function-"
1564 (delete-region (match-beginning 3) (match-end 3)))
1565 (if (not (zerop max-width))
1567 (setq flist (cons (list 'gnus-format-max-width
1568 (car elem) max-width) flist))
1570 (setq flist (cons (car elem) flist))
1571 (setq newspec (car (cdr elem))))
1572 ;; Remove the old specification (and possibly a ",12" string).
1573 (delete-region beg (match-end 2))
1574 ;; Insert the new specification.
1577 (setq fstring (buffer-substring 1 (point-max)))
1578 (kill-buffer (current-buffer)))
1579 (cons 'format (cons fstring (nreverse flist)))))
1581 ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
1582 (defun gnus-read-init-file ()
1584 (or (file-exists-p gnus-init-file)
1585 (file-exists-p (concat gnus-init-file ".el"))
1586 (file-exists-p (concat gnus-init-file ".elc")))
1587 (load gnus-init-file nil t)))
1589 ;; Article file names when saving.
1591 (defun gnus-Numeric-save-name (newsgroup headers &optional last-file)
1592 "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
1593 If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group/num.
1594 Otherwise, it is like ~/News/news/group/num."
1597 (concat (if gnus-use-long-file-name
1598 (gnus-capitalize-newsgroup newsgroup)
1599 (gnus-newsgroup-directory-form newsgroup))
1600 "/" (int-to-string (header-number headers)))
1601 (or gnus-article-save-directory "~/News"))))
1603 (string-equal (file-name-directory default)
1604 (file-name-directory last-file))
1605 (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
1607 (or last-file default))))
1609 (defun gnus-numeric-save-name (newsgroup headers &optional last-file)
1610 "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
1611 If variable `gnus-use-long-file-name' is nil, it is ~/News/news.group/num.
1612 Otherwise, it is like ~/News/news/group/num."
1615 (concat (if gnus-use-long-file-name
1617 (gnus-newsgroup-directory-form newsgroup))
1618 "/" (int-to-string (header-number headers)))
1619 (or gnus-article-save-directory "~/News"))))
1621 (string-equal (file-name-directory default)
1622 (file-name-directory last-file))
1623 (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
1625 (or last-file default))))
1627 (defun gnus-Plain-save-name (newsgroup headers &optional last-file)
1628 "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
1629 If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group.
1630 Otherwise, it is like ~/News/news/group/news."
1633 (if gnus-use-long-file-name
1634 (gnus-capitalize-newsgroup newsgroup)
1635 (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
1636 (or gnus-article-save-directory "~/News"))))
1638 (defun gnus-plain-save-name (newsgroup headers &optional last-file)
1639 "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
1640 If variable `gnus-use-long-file-name' is nil, it is ~/News/news.group.
1641 Otherwise, it is like ~/News/news/group/news."
1644 (if gnus-use-long-file-name
1646 (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
1647 (or gnus-article-save-directory "~/News"))))
1649 ;; For subscribing new newsgroup
1651 (defun gnus-subscribe-hierarchical-interactive (groups)
1652 (let ((groups (sort groups 'string<))
1653 prefixes prefix start rest ans group starts)
1655 (setq prefixes (list "^"))
1656 (while (and groups prefixes)
1657 (while (not (string-match (car prefixes) (car groups)))
1658 (setq prefixes (cdr prefixes)))
1659 (setq prefix (car prefixes))
1660 (setq start (1- (length prefix)))
1661 (if (and (string-match "[^\\.]\\." (car groups) start)
1664 (concat "^" (substring (car groups) 0 (match-end 0))))
1665 (string-match prefix (car (cdr groups))))
1667 (setq prefixes (cons prefix prefixes))
1668 (message "Descend hierarchy %s? ([y]nsq): "
1669 (substring prefix 1 (1- (length prefix))))
1670 (setq ans (read-char))
1673 (string-match prefix
1674 (setq group (car groups))))
1675 (setq gnus-killed-list
1676 (cons group gnus-killed-list))
1677 (gnus-sethash group group gnus-killed-hashtb)
1678 (setq groups (cdr groups)))
1679 (setq starts (cdr starts)))
1682 (string-match prefix
1683 (setq group (car groups))))
1684 (gnus-sethash group group gnus-killed-hashtb)
1685 (gnus-subscribe-alphabetically (car groups))
1686 (setq groups (cdr groups)))
1687 (setq starts (cdr starts)))
1690 (setq group (car groups))
1691 (setq gnus-killed-list (cons group gnus-killed-list))
1692 (gnus-sethash group group gnus-killed-hashtb)
1693 (setq groups (cdr groups))))
1695 (message "Subscribe %s? ([n]yq)" (car groups))
1696 (setq ans (read-char))
1697 (setq group (car groups))
1699 (gnus-subscribe-alphabetically (car groups))
1700 (gnus-sethash group group gnus-killed-hashtb))
1703 (setq group (car groups))
1704 (setq gnus-killed-list (cons group gnus-killed-list))
1705 (gnus-sethash group group gnus-killed-hashtb)
1706 (setq groups (cdr groups))))
1708 (setq gnus-killed-list (cons group gnus-killed-list))
1709 (gnus-sethash group group gnus-killed-hashtb)))
1710 (setq groups (cdr groups)))))))
1712 (defun gnus-subscribe-randomly (newsgroup)
1713 "Subscribe new NEWSGROUP by making it the first newsgroup."
1714 (gnus-subscribe-newsgroup newsgroup))
1716 (defun gnus-subscribe-alphabetically (newgroup)
1717 "Subscribe new NEWSGROUP and insert it in alphabetical order."
1718 ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
1719 (let ((groups (cdr gnus-newsrc-assoc))
1721 (while (and (not before) groups)
1722 (if (string< newgroup (car (car groups)))
1723 (setq before (car (car groups)))
1724 (setq groups (cdr groups))))
1725 (gnus-subscribe-newsgroup newgroup before)))
1727 (defun gnus-subscribe-hierarchically (newgroup)
1728 "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order."
1729 ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
1731 (set-buffer (find-file-noselect gnus-current-startup-file))
1732 (let ((groupkey newgroup)
1734 (while (and (not before) groupkey)
1735 (goto-char (point-min))
1737 (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
1738 (while (and (re-search-forward groupkey-re nil t)
1740 (setq before (buffer-substring
1741 (match-beginning 1) (match-end 1)))
1742 (string< before newgroup)))))
1743 ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
1745 (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
1746 (substring groupkey (match-beginning 1) (match-end 1)))))
1747 (gnus-subscribe-newsgroup newgroup before))))
1749 (defun gnus-subscribe-interactively (newsgroup)
1750 "Subscribe new NEWSGROUP interactively.
1751 It is inserted in hierarchical newsgroup order if subscribed. If not,
1753 (if (y-or-n-p (format "Subscribe new newsgroup: %s " newsgroup))
1754 (gnus-subscribe-hierarchically newsgroup)
1755 (setq gnus-killed-list (cons newsgroup gnus-killed-list))))
1757 (defun gnus-subscribe-zombies (newsgroup)
1758 "Make new NEWSGROUP a zombie group."
1759 (setq gnus-zombie-list (cons newsgroup gnus-zombie-list)))
1761 (defun gnus-subscribe-newsgroup (newsgroup &optional next)
1762 "Subscribe new NEWSGROUP.
1763 If NEXT is non-nil, it is inserted before NEXT. Otherwise it is made
1764 the first newsgroup."
1765 ;; We subscribe the group by changing its level to 3.
1766 (gnus-group-change-level
1768 (if next (gnus-gethash next gnus-newsrc-hashtb)
1769 (gnus-gethash (car (nth 1 gnus-newsrc-assoc)) gnus-newsrc-hashtb)))
1770 (message "Subscribe newsgroup: %s" newsgroup))
1774 (defun gnus-newsgroup-directory-form (newsgroup)
1775 "Make hierarchical directory name from NEWSGROUP name."
1776 (let ((newsgroup (substring newsgroup 0)) ;Copy string.
1777 (len (length newsgroup))
1779 ;; Replace all occurrences of `.' with `/'.
1781 (if (= (aref newsgroup idx) ?.)
1782 (aset newsgroup idx ?/))
1783 (setq idx (1+ idx)))
1787 (defun gnus-make-directory (dir)
1788 "Make DIRECTORY recursively."
1789 (let* ((dir (expand-file-name dir default-directory))
1791 (if (string-match "/$" dir)
1792 (setq dir (substring dir 0 (match-beginning 0))))
1793 (while (not (file-exists-p dir))
1794 (setq dirs (cons dir dirs))
1795 (string-match "/[^/]+$" dir)
1796 (setq dir (substring dir 0 (match-beginning 0))))
1798 (make-directory (car dirs))
1799 (setq dirs (cdr dirs)))))
1801 (defun gnus-capitalize-newsgroup (newsgroup)
1802 "Capitalize NEWSGROUP name."
1803 (and (not (zerop (length newsgroup)))
1804 (concat (char-to-string (upcase (aref newsgroup 0)))
1805 (substring newsgroup 1))))
1809 (defun gnus-simplify-subject (subject &optional re-only)
1810 "Remove `Re:' and words in parentheses.
1811 If optional argument RE-ONLY is non-nil, strip `Re:' only."
1812 (let ((case-fold-search t)) ;Ignore case.
1813 ;; Remove `Re:' and `Re^N:'.
1814 (if (string-match "^re:[ \t]*" subject)
1815 (setq subject (substring subject (match-end 0))))
1816 ;; Remove words in parentheses from end.
1818 (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject)
1819 (setq subject (substring subject 0 (match-beginning 0)))))
1820 ;; Return subject string.
1824 (defun gnus-add-current-to-buffer-list ()
1825 (setq gnus-buffer-list (cons (current-buffer) gnus-buffer-list)))
1827 ;; Functions accessing headers.
1828 ;; Functions are more convenient than macros in some case.
1830 (defun gnus-header-number (header)
1831 "Return article number in HEADER."
1832 (header-number header))
1834 (defun gnus-header-subject (header)
1835 "Return subject string in HEADER."
1836 (header-subject header))
1838 (defun gnus-header-from (header)
1839 "Return author string in HEADER."
1840 (header-from header))
1842 (defun gnus-header-xref (header)
1843 "Return xref string in HEADER."
1844 (header-xref header))
1846 (defun gnus-header-lines (header)
1847 "Return lines in HEADER."
1848 (header-lines header))
1850 (defun gnus-header-date (header)
1851 "Return date in HEADER."
1852 (header-date header))
1854 (defun gnus-header-id (header)
1855 "Return Id in HEADER."
1858 (defun gnus-header-references (header)
1859 "Return references in HEADER."
1860 (header-references header))
1862 (defun gnus-clear-system ()
1863 "Clear all variables and buffers."
1864 ;; Clear Gnus variables.
1865 (let ((variables gnus-variable-list))
1867 (set (car variables) nil)
1868 (setq variables (cdr variables))))
1869 ;; Clear other internal variables.
1870 (setq gnus-list-of-killed-groups nil
1871 gnus-have-read-active-file nil
1872 gnus-newsrc-assoc nil
1873 gnus-newsrc-hashtb nil
1874 gnus-killed-list nil
1875 gnus-zombie-list nil
1876 gnus-killed-hashtb nil
1877 gnus-active-hashtb nil
1878 gnus-moderated-list nil
1879 gnus-description-hashtb nil
1880 gnus-newsgroup-headers nil
1881 gnus-newsgroup-headers-hashtb-by-number nil
1882 gnus-current-select-method nil)
1883 ;; Kill the startup file.
1884 (and gnus-current-startup-file
1885 (get-file-buffer gnus-current-startup-file)
1886 (kill-buffer (get-file-buffer gnus-current-startup-file)))
1887 (setq gnus-current-startup-file nil)
1888 (gnus-dribble-clear)
1889 ;; Kill global KILL file buffer.
1890 (if (get-file-buffer (gnus-newsgroup-kill-file nil))
1891 (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))
1892 ;; Kill Gnus buffers.
1893 (while gnus-buffer-list
1894 (if (and (get-buffer (car gnus-buffer-list))
1895 (buffer-name (get-buffer (car gnus-buffer-list))))
1896 (kill-buffer (car gnus-buffer-list)))
1897 (setq gnus-buffer-list (cdr gnus-buffer-list))))
1899 (defun gnus-configure-windows (action &optional force)
1900 "Configure Gnus windows according to the next ACTION.
1901 The ACTION is either a symbol, such as `summary', or a
1902 configuration list such as `(1 1 2)'. If ACTION is not a list,
1903 configuration list is got from the variable gnus-window-configuration.
1904 If FORCE is non-nil, the updating will be done whether it is necessary
1907 (if (listp action) action
1908 (if (listp gnus-window-configuration)
1909 (car (cdr (assq action gnus-window-configuration)))
1910 gnus-window-configuration)))
1911 (grpwin (get-buffer-window gnus-group-buffer))
1912 (subwin (get-buffer-window gnus-summary-buffer))
1913 (artwin (get-buffer-window gnus-article-buffer))
1920 ;; Make split-window-vertically leave focus in upper window.
1921 (split-window-keep-point t))
1922 (if (and (symbolp windows) (fboundp windows))
1923 (funcall windows action)
1924 (if (and (not force)
1925 (or (null windows) ;No configuration is specified.
1926 (and (eq (null grpwin)
1927 (zerop (nth 0 windows)))
1929 (zerop (nth 1 windows)))
1931 (zerop (nth 2 windows))))))
1932 ;; No need to change window configuration.
1934 (select-window (or grpwin subwin artwin (selected-window)))
1935 ;; First of all, compute the height of each window.
1936 (cond (gnus-use-full-window
1937 ;; Take up the entire screen.
1938 (delete-other-windows)
1939 (setq height (window-height (selected-window))))
1941 (setq height (+ (if grpwin (window-height grpwin) 0)
1942 (if subwin (window-height subwin) 0)
1943 (if artwin (window-height artwin) 0)))))
1944 ;; The group buffer exits always. So, use it to extend the
1945 ;; group window so as to get enough window space.
1946 (switch-to-buffer gnus-group-buffer 'norecord)
1947 (and (get-buffer gnus-summary-buffer)
1948 (delete-windows-on gnus-summary-buffer))
1949 (and (get-buffer gnus-article-buffer)
1950 (delete-windows-on gnus-article-buffer))
1951 ;; Compute expected window height.
1952 (setq winsum (apply (function +) windows))
1953 (if (not (zerop (nth 0 windows)))
1954 (setq grpheight (max window-min-height
1955 (/ (* height (nth 0 windows)) winsum))))
1956 (if (not (zerop (nth 1 windows)))
1957 (setq subheight (max window-min-height
1958 (/ (* height (nth 1 windows)) winsum))))
1959 (if (not (zerop (nth 2 windows)))
1960 (setq artheight (max window-min-height
1961 (/ (* height (nth 2 windows)) winsum))))
1962 (setq height (+ grpheight subheight artheight))
1963 (enlarge-window (max 0 (- height (window-height (selected-window)))))
1964 ;; Then split the window.
1965 (and (not (zerop artheight))
1966 (or (not (zerop grpheight))
1967 (not (zerop subheight)))
1968 (split-window-vertically (+ grpheight subheight)))
1969 (and (not (zerop grpheight))
1970 (not (zerop subheight))
1971 (split-window-vertically grpheight))
1972 ;; Then select buffers in each window.
1973 (or (zerop grpheight)
1975 (switch-to-buffer gnus-group-buffer 'norecord)
1977 (or (zerop subheight)
1979 (switch-to-buffer gnus-summary-buffer 'norecord)
1981 (or (zerop artheight)
1983 ;; If article buffer does not exist, it will be created
1985 (gnus-article-setup-buffer)
1986 (switch-to-buffer gnus-article-buffer 'norecord)
1987 (bury-buffer gnus-summary-buffer)
1988 (bury-buffer gnus-group-buffer)))
1989 (or (zerop subheight)
1990 (pop-to-buffer gnus-summary-buffer))
1993 (defun gnus-window-configuration-split (action)
1994 (switch-to-buffer gnus-group-buffer t)
1995 (delete-other-windows)
1996 (split-window-horizontally)
1997 (cond ((or (eq action 'newsgroups) (eq action 'summary))
1998 (if (and (get-buffer gnus-summary-buffer)
1999 (buffer-name gnus-summary-buffer))
2000 (switch-to-buffer-other-window gnus-summary-buffer)))
2001 ((eq action 'article)
2002 (switch-to-buffer gnus-summary-buffer t)
2004 (gnus-article-setup-buffer)
2005 (switch-to-buffer gnus-article-buffer t))))
2007 (defun gnus-version ()
2008 "Version numbers of this version of Gnus."
2010 (let ((methods gnus-valid-select-methods)
2013 ;; Go through all the legal select methods and add their version
2014 ;; numbers to the total version string. Only the backends that are
2015 ;; currently in use will have their message numbers taken into
2018 (setq meth (intern (concat (car (car methods)) "-version")))
2020 (stringp (symbol-value meth))
2021 (setq mess (concat mess "; " (symbol-value meth))))
2022 (setq methods (cdr methods)))
2025 (defun gnus-info-find-node ()
2026 "Find Info documentation of Gnus."
2028 ;; Enlarge info window if needed.
2029 (cond ((eq major-mode 'gnus-group-mode)
2030 (gnus-configure-windows '(1 0 0)) ;Take all windows.
2031 (pop-to-buffer gnus-group-buffer))
2032 ((eq major-mode 'gnus-summary-mode)
2033 (gnus-configure-windows '(0 1 0)) ;Take all windows.
2034 (pop-to-buffer gnus-summary-buffer)))
2035 (Info-goto-node (car (cdr (assq major-mode gnus-info-nodes)))))
2038 "Send a bug report to the Gnus maintainers."
2040 (pop-to-buffer "*Gnus Bug*")
2042 (mail-setup gnus-maintainer "[Gnus Bug Report] " nil nil nil nil)
2043 (goto-char (point-min))
2044 (search-forward mail-header-separator)
2046 (insert (format "%s\n%s\n\n" (gnus-version) (emacs-version)))
2051 (defun gnus-debug ()
2052 "Attemps to go through the Gnus source file and report what variables have been changed.
2053 The source file has to be in the Emacs load path."
2055 (let ((dirs load-path)
2058 (if (file-exists-p (setq file (concat (car dirs) "/gnus.el")))
2061 (set-buffer (get-buffer-create "*gnus bug info*"))
2062 (buffer-disable-undo)
2064 (insert-file-contents file)
2065 (goto-char (point-min))
2066 (or (search-forward "\n;; Internal variables" nil t)
2067 (error "Malformed sources"))
2068 (narrow-to-region (point-min) (point))
2069 (goto-char (point-min))
2070 (while (setq expr (condition-case ()
2071 (read (current-buffer)) (error nil)))
2072 (and (eq (car expr) 'defvar)
2073 (stringp (nth 3 expr))
2074 (not (equal (eval (nth 2 expr))
2075 (symbol-value (nth 1 expr))))
2076 (setq olist (cons (nth 1 expr) olist))))
2077 (kill-buffer (current-buffer)))
2078 (setq dirs (cdr dirs))))
2080 (insert (symbol-name (car olist)) ": "
2081 (prin1-to-string (symbol-value (car olist))) "\n")
2082 (setq olist (cdr olist)))
2085 (defun gnus-overload-functions (&optional overloads)
2086 "Overload functions specified by optional argument OVERLOADS.
2087 If nothing is specified, use the variable gnus-overload-functions."
2089 (overloads (or overloads gnus-overload-functions)))
2091 (setq defs (car overloads))
2092 (setq overloads (cdr overloads))
2093 ;; Load file before overloading function if necessary. Make
2094 ;; sure we cannot use `require' always.
2095 (and (not (fboundp (car defs)))
2096 (car (cdr (cdr defs)))
2097 (load (car (cdr (cdr defs))) nil 'nomessage))
2098 (fset (car defs) (car (cdr defs)))
2101 (defun gnus-replace-chars-in-string (string from to)
2102 "Replace characters in STRING from FROM to TO."
2103 (let ((string (substring string 0)) ;Copy string.
2104 (len (length string))
2106 ;; Replace all occurrences of FROM with TO.
2108 (if (= (aref string idx) from)
2109 (aset string idx to))
2110 (setq idx (1+ idx)))
2113 (defun gnus-days-between (date1 date2)
2114 ;; Return the number of days between date1 and date2.
2115 (let ((d1 (mapcar (lambda (s) (and s (string-to-int s)) )
2116 (timezone-parse-date date1)))
2117 (d2 (mapcar (lambda (s) (and s (string-to-int s)) )
2118 (timezone-parse-date date2))))
2119 (- (timezone-absolute-from-gregorian
2120 (nth 1 d1) (nth 2 d1) (car d1))
2121 (timezone-absolute-from-gregorian
2122 (nth 1 d2) (nth 2 d2) (car d2)))))
2124 (defun gnus-file-newer-than (file date)
2125 (let ((fdate (nth 5 (file-attributes file))))
2126 (or (> (car fdate) (car date))
2127 (and (= (car fdate) (car date))
2128 (> (nth 1 fdate) (nth 1 date))))))
2130 ;; List and range functions
2132 (defun gnus-last-element (list)
2133 "Return last element of LIST."
2135 (setq list (cdr list)))
2138 (defun gnus-set-difference (list1 list2)
2139 "Return a list of elements of LIST1 that do not appear in LIST2."
2140 (let ((list1 (copy-sequence list1)))
2142 (setq list1 (delq (car list2) list1))
2143 (setq list2 (cdr list2)))
2147 (defun gnus-intersection (list1 list2)
2150 (if (memq (car list2) list1)
2151 (setq result (cons (car list2) result)))
2152 (setq list2 (cdr list2)))
2156 (defun gnus-compress-sequence (numbers &optional always-list)
2157 "Convert list of numbers to a list of ranges or a single range.
2158 If ALWAYS-LIST is non-nil, this function will always release a list of
2160 (let* ((first (car numbers))
2161 (last (car numbers))
2166 (cond ((= last (car numbers)) nil) ;Omit duplicated number
2167 ((= (1+ last) (car numbers)) ;Still in sequence
2168 (setq last (car numbers)))
2169 (t ;End of one sequence
2170 (setq result (cons (cons first last) result))
2171 (setq first (car numbers))
2172 (setq last (car numbers))))
2173 (setq numbers (cdr numbers)))
2174 (if (and (not always-list) (null result))
2176 (nreverse (cons (cons first last) result))))))
2178 (defun gnus-uncompress-sequence (ranges)
2179 "Expand a list of ranges into a list of numbers.
2180 RANGES is either a single range on the form `(num . num)' or a list of
2182 (let (first last result)
2185 (if (atom (car ranges))
2187 (setq first (car ranges))
2188 (setq last (cdr ranges))
2189 (while (<= first last)
2190 (setq result (cons first result))
2191 (setq first (1+ first))))
2193 (setq first (car (car ranges)))
2194 (setq last (cdr (car ranges)))
2195 (while (<= first last)
2196 (setq result (cons first result))
2197 (setq first (1+ first)))
2198 (setq ranges (cdr ranges))))
2199 (nreverse result))))
2201 (defun gnus-add-to-range (ranges list)
2202 "Return a list of ranges that has all articles from both RANGES and LIST.
2203 Note: LIST has to be sorted over `<'."
2204 (let* ((ranges (if (and ranges (atom (car ranges))) (list ranges) ranges))
2207 range nranges first last)
2211 (gnus-compress-sequence list t)
2213 (> (car (car ranges)) 1)
2216 (setq inrange (setq ranges (cons (cons 1 1) ranges)))))
2217 (while (and ranges list)
2218 (setq range (car ranges))
2219 (while (and list (>= (car list) (car range))
2220 (<= (car list) (cdr range)))
2221 (setq list (cdr list)))
2222 (while (and list (= (1- (car list)) (cdr range)))
2223 (setcdr range (car list))
2224 (setq list (cdr list)))
2225 (if (and list (and (> (car list) (cdr range))
2227 (< (car list) (car (car (cdr ranges))))))
2228 (setcdr ranges (cons (cons (car list) (car list)) (cdr ranges))))
2229 (setq ranges (cdr ranges)))
2230 (if (and list (not ranges))
2231 (setq inrange (nconc inrange (gnus-compress-sequence list t))))
2233 (if (eq (cdr (car inrange)) 1)
2234 (setq inrange (cdr inrange))
2235 (setcar (car inrange) 2)))
2236 (setq ranges inrange)
2238 (if (and (cdr ranges) (>= (1+ (cdr (car ranges)))
2239 (car (car (cdr ranges)))))
2241 (setcdr (car ranges) (cdr (car (cdr ranges))))
2242 (setcdr ranges (cdr (cdr ranges))))
2243 (setq ranges (cdr ranges))))
2244 (if (not (cdr inrange))
2248 (defun gnus-remove-from-range (ranges list)
2249 "Return a list of ranges that has all articles from LIST removed from RANGES.
2250 Note: LIST has to be sorted over `<'."
2251 ;; !!! This function shouldn't look like this, but I've got a headache.
2252 (gnus-compress-sequence
2253 (gnus-set-difference
2254 (gnus-uncompress-sequence ranges) list)))
2256 (defun gnus-member-of-range (number ranges)
2258 (while (and ranges not-stop)
2259 (if (and (>= number (car (car ranges)))
2260 (<= number (cdr (car ranges))))
2261 (setq not-stop nil))
2262 (setq ranges (cdr ranges)))
2270 (if gnus-group-mode-map
2272 (setq gnus-group-mode-map (make-keymap))
2273 (suppress-keymap gnus-group-mode-map)
2274 (define-key gnus-group-mode-map " " 'gnus-group-read-group)
2275 (define-key gnus-group-mode-map "=" 'gnus-group-select-group)
2276 (define-key gnus-group-mode-map "j" 'gnus-group-jump-to-group)
2277 (define-key gnus-group-mode-map "n" 'gnus-group-next-unread-group)
2278 (define-key gnus-group-mode-map "p" 'gnus-group-prev-unread-group)
2279 (define-key gnus-group-mode-map [del] 'gnus-group-prev-unread-group)
2280 (define-key gnus-group-mode-map "N" 'gnus-group-next-group)
2281 (define-key gnus-group-mode-map "P" 'gnus-group-prev-group)
2282 (define-key gnus-group-mode-map "\M-n" 'gnus-group-next-unread-group-same-level)
2283 (define-key gnus-group-mode-map "\M-p" 'gnus-group-prev-unread-group-same-level)
2284 (define-key gnus-group-mode-map "\r" 'gnus-group-select-group)
2285 (define-key gnus-group-mode-map "u" 'gnus-group-unsubscribe-current-group)
2286 (define-key gnus-group-mode-map "U" 'gnus-group-unsubscribe-group)
2287 (define-key gnus-group-mode-map "c" 'gnus-group-catchup-current)
2288 (define-key gnus-group-mode-map "C" 'gnus-group-catchup-current-all)
2289 (define-key gnus-group-mode-map "l" 'gnus-group-list-groups)
2290 (define-key gnus-group-mode-map "L" 'gnus-group-list-all-groups)
2291 (define-key gnus-group-mode-map "m" 'gnus-group-mail)
2292 (define-key gnus-group-mode-map "g" 'gnus-group-get-new-news)
2293 (define-key gnus-group-mode-map "\M-g" 'gnus-group-get-new-news-this-group)
2294 (define-key gnus-group-mode-map "R" 'gnus-group-restart)
2295 (define-key gnus-group-mode-map "r" 'gnus-group-read-init-file)
2296 (define-key gnus-group-mode-map "B" 'gnus-group-browse-foreign-server)
2297 (define-key gnus-group-mode-map "b" 'gnus-group-check-bogus-groups)
2298 (define-key gnus-group-mode-map "F" 'gnus-find-new-newsgroups)
2299 (define-key gnus-group-mode-map "\C-c\C-d" 'gnus-group-describe-group)
2300 (define-key gnus-group-mode-map "\M-d" 'gnus-group-describe-all-groups)
2301 (define-key gnus-group-mode-map "\C-c\C-a" 'gnus-group-apropos)
2302 (define-key gnus-group-mode-map "\C-c\M-C-a" 'gnus-group-description-apropos)
2303 (define-key gnus-group-mode-map "d" 'gnus-group-make-directory-group)
2304 (define-key gnus-group-mode-map "a" 'gnus-group-post-news)
2305 (define-key gnus-group-mode-map "\M-a" 'gnus-group-add-group)
2306 (define-key gnus-group-mode-map "\M-e" 'gnus-group-edit-group)
2307 (define-key gnus-group-mode-map "\ek" 'gnus-group-edit-local-kill)
2308 (define-key gnus-group-mode-map "\eK" 'gnus-group-edit-global-kill)
2309 (define-key gnus-group-mode-map "\C-k" 'gnus-group-kill-group)
2310 (define-key gnus-group-mode-map "\C-y" 'gnus-group-yank-group)
2311 (define-key gnus-group-mode-map "\C-w" 'gnus-group-kill-region)
2312 (define-key gnus-group-mode-map "\M-z" 'gnus-group-kill-all-zombies)
2313 (define-key gnus-group-mode-map "\C-x\C-t" 'gnus-group-transpose-groups)
2314 (define-key gnus-group-mode-map "\C-c\C-l" 'gnus-group-list-killed)
2315 (define-key gnus-group-mode-map "\C-c\C-k" 'gnus-group-list-killed)
2316 (define-key gnus-group-mode-map "\C-c\C-z" 'gnus-group-list-zombies)
2317 (define-key gnus-group-mode-map "\C-c\C-x" 'gnus-group-expire-articles)
2318 (define-key gnus-group-mode-map "\C-c\M-\C-x" 'gnus-group-expire-all-groups)
2319 (define-key gnus-group-mode-map "V" 'gnus-version)
2320 (define-key gnus-group-mode-map "S" 'gnus-group-set-current-level)
2321 (define-key gnus-group-mode-map "s" 'gnus-group-save-newsrc)
2322 (define-key gnus-group-mode-map "z" 'gnus-group-suspend)
2323 (define-key gnus-group-mode-map "Z" 'gnus-group-clear-dribble)
2324 (define-key gnus-group-mode-map "q" 'gnus-group-exit)
2325 (define-key gnus-group-mode-map "Q" 'gnus-group-quit)
2326 (define-key gnus-group-mode-map "?" 'gnus-group-describe-briefly)
2327 (define-key gnus-group-mode-map "\C-c\C-i" 'gnus-info-find-node)
2328 (define-key gnus-group-mode-map [mouse-2] 'gnus-mouse-pick-group)
2329 (if gnus-visual (gnus-group-make-menu-bar)))
2331 (defun gnus-group-mode ()
2332 "Major mode for reading news.
2333 All normal editing commands are switched off.
2334 The following commands are available:
2336 \\<gnus-group-mode-map>
2337 \\[gnus-group-read-group]\t Choose the current group
2338 \\[gnus-group-select-group]\t Select the current group without selecting the first article
2339 \\[gnus-group-jump-to-group]\t Go to some group
2340 \\[gnus-group-next-unread-group]\t Go to the next unread group
2341 \\[gnus-group-prev-unread-group]\t Go to the previous unread group
2342 \\[gnus-group-next-group]\t Go to the next group
2343 \\[gnus-group-prev-group]\t Go to the previous group
2344 \\[gnus-group-next-unread-group-same-level]\t Go to the next unread group on the same level
2345 \\[gnus-group-prev-unread-group-same-level]\t Go to the previous unread group un the same level
2346 \\[gnus-group-unsubscribe-current-group]\t (Un)subscribe to the current group
2347 \\[gnus-group-unsubscribe-group]\t (Un)subscribe to some group
2348 \\[gnus-group-catchup-current]\t Mark all unread articles in the current group as read
2349 \\[gnus-group-catchup-current-all]\t Mark all alrticles in the current group as read
2350 \\[gnus-group-list-groups]\t List groups that have unread articles
2351 \\[gnus-group-list-all-groups]\t List all groups
2352 \\[gnus-group-mail]\t Compose a mail
2353 \\[gnus-group-get-new-news]\t Look for new news
2354 \\[gnus-group-get-new-news-this-group]\t Look for new news for the current group
2355 \\[gnus-group-restart]\t Restart Gnus
2356 \\[gnus-group-save-newsrc]\t Save the startup file(s)
2357 \\[gnus-group-browse-foreign-server]\t Browse a foreign (NNTP) server
2358 \\[gnus-group-check-bogus-groups]\t Check for and remove bogus newsgroups
2359 \\[gnus-find-new-newsgroups]\t Find new newsgroups
2360 \\[gnus-group-describe-group]\t Describe the current newsgroup
2361 \\[gnus-group-describe-all-groups]\t Describe all newsgroups
2362 \\[gnus-group-post-news]\t Post an article to some newsgroup
2363 \\[gnus-group-add-group]\t Add a newsgroup entry
2364 \\[gnus-group-edit-group]\t Edit a newsgroup entry
2365 \\[gnus-group-make-directory-group]\t Read a directory as a newsgroups
2366 \\[gnus-group-edit-local-kill]\t Edit a local kill file
2367 \\[gnus-group-edit-global-kill]\t Edit the global kill file
2368 \\[gnus-group-kill-group]\t Kill the current newsgroup
2369 \\[gnus-group-yank-group]\t Yank a previously killed newsgroup
2370 \\[gnus-group-kill-region]\t Kill all newsgroups between point and mark
2371 \\[gnus-group-kill-all-zombies]\t Kill all zombie newsgroups
2372 \\[gnus-group-transpose-groups]\t Transpose two newsgroups
2373 \\[gnus-group-list-killed]\t List all killed newsgroups
2374 \\[gnus-group-list-zombies]\t List all zombie newsgroups
2375 \\[gnus-group-expire-articles]\t Expire the expirable articles in the current newsgroup
2376 \\[gnus-group-expire-all-groups]\t Expire expirable articles in all newsgroups
2377 \\[gnus-version]\t Display the current Gnus version
2378 \\[gnus-group-set-current-level]\t Set the level of the current newsgroup
2379 \\[gnus-group-suspend]\t Suspend Gnus
2380 \\[gnus-group-clear-dribble]\t Clear the dribble buffer
2381 \\[gnus-group-exit]\t Stop reading news
2382 \\[gnus-group-quit]\t Stop reading news without saving the startup files
2383 \\[gnus-group-describe-briefly]\t Give a brief description of the current mode
2384 \\[gnus-info-find-node]\t Find the info pages for Gnus
2387 (kill-all-local-variables)
2388 (setq mode-line-modified "-- ")
2389 (make-local-variable 'mode-line-format)
2390 (setq mode-line-format (copy-sequence mode-line-format))
2391 (and (equal (nth 3 mode-line-format) " ")
2392 (setcar (nthcdr 3 mode-line-format) ""))
2393 (setq major-mode 'gnus-group-mode)
2394 (setq mode-name "Group")
2395 (gnus-group-set-mode-line)
2396 (setq mode-line-process nil)
2397 (use-local-map gnus-group-mode-map)
2398 (buffer-disable-undo (current-buffer))
2399 (setq truncate-lines t)
2400 (setq buffer-read-only t)
2401 (run-hooks 'gnus-group-mode-hook))
2403 (defun gnus-mouse-pick-group (e)
2406 (gnus-group-read-group nil))
2409 (defun gnus-no-server (&optional arg)
2411 If ARG is a positive number, Gnus will use that as the
2412 startup level. If ARG is nil, Gnus will be started at level 2.
2413 If ARG is non-nil and not a positive number, Gnus will
2414 prompt the user for the name of an NNTP server to use.
2415 As opposed to `gnus', this command will not connect to the local server."
2417 (gnus (or arg 2) t))
2419 (defalias '\(ding\) 'gnus)
2422 (defun gnus (&optional arg dont-connect)
2424 If ARG is non-nil and a positive number, Gnus will use that as the
2425 startup level. If ARG is non-nil and not a positive number, Gnus will
2426 prompt the user for the name of an NNTP server to use."
2428 (if (get-buffer gnus-group-buffer)
2430 (switch-to-buffer gnus-group-buffer)
2431 (gnus-group-get-new-news))
2433 (gnus-read-init-file)
2434 (let ((level (and arg (numberp arg) (> arg 0) arg)))
2437 (switch-to-buffer (get-buffer-create gnus-group-buffer))
2438 (gnus-add-current-to-buffer-list)
2440 (or dont-connect (gnus-start-news-server (and arg (not level)))))
2441 (if (and (not dont-connect)
2442 (not (gnus-server-opened gnus-select-method)))
2444 ;; NNTP server is successfully open.
2445 (gnus-update-format-specifications)
2446 (let ((buffer-read-only nil))
2448 (if (not gnus-inhibit-startup-message)
2450 (gnus-group-startup-message)
2452 (run-hooks 'gnus-startup-hook)
2453 (gnus-setup-news nil level)
2455 (or (not gnus-novice-user)
2457 (gnus-group-describe-briefly)) ;Show brief help message.
2458 (gnus-group-list-groups (or level 5)))))))
2460 (defun gnus-group-startup-message (&optional x y)
2461 "Insert startup message in current buffer."
2462 ;; Insert the message.
2478 ;; And then hack it.
2479 ;; 18 is the longest line.
2480 (indent-rigidly (point-min) (point-max)
2481 (/ (max (- (window-width) (or x 22)) 0) 2))
2482 (goto-char (point-min))
2483 ;; +4 is fuzzy factor.
2484 (insert-char ?\n (/ (max (- (window-height) (or y 12)) 0) 2)))
2486 (defun gnus-group-list-groups (level &optional unread)
2487 "List newsgroups with level LEVEL or lower that have unread alticles.
2488 Default is 5, which lists all subscribed groups.
2489 If argument UNREAD is non-nil, groups with no unread articles are also listed."
2491 (setq level (or level 5))
2492 (let ((case-fold-search nil)
2493 (group (gnus-group-group-name)))
2494 (set-buffer gnus-group-buffer) ;May call from out of group buffer
2495 (gnus-group-prepare level unread)
2496 (if (zerop (buffer-size))
2497 ;; Suggested by Andrew Eskilsson <pi92ae@lelle.pt.hk-r.se>.
2498 (message "No news is horrible news")
2499 (goto-char (point-min))
2501 ;; Go to the first group with unread articles.
2502 (gnus-group-search-forward nil nil nil t)
2503 ;; Find the right group to put point on. If the current group
2504 ;; has disapeared in the new listing, try to find the next
2505 ;; one. If no next one can be found, just leave point at the
2506 ;; first newsgroup in the buffer.
2507 (if (not (gnus-goto-char
2508 (text-property-any (point-min) (point-max)
2509 'gnus-group (intern group))))
2510 (let ((newsrc (nthcdr 3 (gnus-gethash group gnus-newsrc-hashtb))))
2512 (not (gnus-goto-char
2514 (point-min) (point-max) 'gnus-group
2516 (setq newsrc (cdr newsrc))))))
2517 ;; Adjust cursor point.
2518 (gnus-group-position-cursor))))
2520 (defun gnus-group-prepare (level &optional all lowest)
2521 "List all newsgroups with unread articles of level LEVEL or lower.
2522 If ALL is non-nil, list groups that have no unread articles.
2523 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher."
2524 (set-buffer (get-buffer-create gnus-group-buffer))
2525 (gnus-add-current-to-buffer-list)
2526 (let ((buffer-read-only nil)
2527 (newsrc (cdr gnus-newsrc-assoc))
2528 (zombie gnus-zombie-list)
2529 (killed gnus-killed-list)
2530 info clevel unread active group)
2535 ;; List alive newsgroups.
2537 (setq info (car newsrc)
2540 unread (car (gnus-gethash group gnus-newsrc-hashtb)))
2541 (if (and unread ; This group might be bogus
2542 (or all (eq unread t)
2545 (length (cdr (assq 'dormant (nth 3 info)))))))
2546 (and (<= (setq clevel (car (cdr info))) level))
2548 (gnus-group-insert-group-line
2549 nil group (car (cdr info)) (nth 3 info) unread
2552 ;; List zombies and killed lists somehwat faster, which was
2553 ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>. It does
2554 ;; this by ignoring the group format specification altogether.
2555 (let ((lists (list 'gnus-zombie-list 'gnus-killed-list))
2558 (if (or (and (eq (car lists) 'gnus-zombie-list)
2559 (progn (setq mark ?Z)
2561 (and (>= level 8) (<= lowest 8))))
2562 (and (eq (car lists) 'gnus-killed-list)
2563 (progn (setq mark ?K)
2565 (and (>= level 9) (<= lowest 9)))))
2567 (setq newsrc (set (car lists)
2568 (sort (symbol-value (car lists))
2569 (function string<))))
2571 (setq group (car newsrc)
2572 newsrc (cdr newsrc))
2574 (insert (format " %c *: %s\n" mark group))
2575 (add-text-properties
2577 (list 'gnus-group (intern group)
2579 'gnus-level lev)))))
2580 (setq lists (cdr lists))))
2582 (gnus-group-set-mode-line)
2583 (setq gnus-have-all-newsgroups all)
2584 (run-hooks 'gnus-group-prepare-hook)))
2586 (defun gnus-group-real-name (group)
2587 "Find the real name of a foreign newsgroup."
2588 (if (string-match "^[^:]+:" group)
2589 (substring group (match-end 0))
2592 (defun gnus-group-prefixed-name (group method)
2593 "Return the whole name from GROUP and METHOD."
2594 (concat (format "%s" (car method))
2595 (if (assoc (format "%s" (car method)) (gnus-methods-using 'address))
2596 (concat "+" (nth 1 method)))
2599 (defun gnus-group-real-prefix (group)
2600 "Return the prefix of the current group name."
2601 (if (string-match "^[^:]+:" group)
2602 (substring group 0 (match-end 0))
2605 (defun gnus-group-method-name (group)
2606 "Return the method used for selecting GROUP."
2607 (let ((prefix (gnus-group-real-prefix group)))
2608 (if (equal prefix "")
2610 (if (string-match "^[^\\+]+\\+" prefix)
2611 (list (intern (substring prefix 0 (1- (match-end 0))))
2612 (substring prefix (match-end 0) (1- (length prefix))))
2613 (list (intern (substring prefix 0 (1- (length prefix)))) "")))))
2615 (defun gnus-group-foreign-p (group)
2616 "Return nil if GROUP is native, non-nil if it is foreign."
2617 (string-match ":" group))
2619 (defun gnus-group-set-info (info)
2620 (let ((entry (gnus-gethash (car info) gnus-newsrc-hashtb)))
2623 (setcar (nthcdr 2 entry) info)
2624 (if (and (not (eq (car entry) t))
2625 (gnus-gethash (car info) gnus-active-hashtb))
2626 (setcar entry (length (gnus-list-of-unread-articles
2628 (error "No such group: %s" (car info)))))
2630 (defun gnus-group-update-group-line ()
2631 "This function updates the current line in the newsgroup buffer and
2632 moves the point to the colon."
2633 (let* ((buffer-read-only nil)
2634 (group (gnus-group-group-name))
2635 (entry (and group (gnus-gethash group gnus-newsrc-hashtb))))
2638 (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry))
2641 (delete-region (point) (save-excursion (forward-line 1) (point)))
2642 (gnus-group-insert-group-line-info group)
2644 (gnus-group-position-cursor)))
2646 (defun gnus-group-insert-group-line-info (group)
2647 (let ((entry (gnus-gethash group gnus-newsrc-hashtb))
2651 (setq info (nth 2 entry))
2652 (gnus-group-insert-group-line
2653 nil group (nth 1 info) (nth 3 info) (car entry) (nth 4 info)))
2654 (setq active (gnus-gethash group gnus-active-hashtb))
2655 (gnus-group-insert-group-line
2656 nil group (if (member group gnus-zombie-list) 8 9)
2657 nil (- (1+ (cdr active)) (car active)) nil))))
2659 (defun gnus-group-insert-group-line (gformat group level marked number method)
2660 (let* ((gformat (or gformat gnus-group-line-format-spec))
2661 (active (gnus-gethash group gnus-active-hashtb))
2662 (number-total (if active (1+ (- (cdr active) (car active)))))
2663 (number-of-dormant (length (cdr (assq 'dormant marked))))
2664 (number-of-ticked (length (cdr (assq 'tick marked))))
2665 (number-of-ticked-and-dormant
2666 (+ number-of-ticked number-of-dormant))
2667 (number-of-unread-unticked
2668 (if (numberp number)
2669 (max 0 (- number number-of-ticked number-of-dormant))
2672 (if (numberp number)
2673 (max 0 (- number-total number))
2675 (subscribed (cond ((< level 6) ? )
2679 (qualified-group (gnus-group-real-name group))
2680 (newsgroup-description
2681 (if gnus-description-hashtb
2682 (or (gnus-gethash group gnus-description-hashtb) "")
2684 (moderated (if (member group gnus-moderated-list) ?m ? ))
2685 (moderated-string (if (eq moderated ?m) "(m)" ""))
2686 (news-server (or (car (cdr method)) ""))
2687 (news-method (or (car method) ""))
2689 (if method (format "(%s:%s)" (car method) (car (cdr method))) ""))
2690 (number (if (eq number t) "*" number))
2693 (not (zerop number))
2694 (>= (+ (length (cdr (assq 'tick marked)))
2695 (length (cdr (assq 'dormant marked)))) number)
2696 (> (length (cdr (assq 'tick marked))) 0))
2698 (buffer-read-only nil)
2702 ;; Insert the visible text.
2703 (insert-before-markers (eval gformat))
2704 (add-text-properties
2705 b (1+ b) (list 'gnus-group (intern group)
2706 'gnus-unread (if (numberp number-of-unread-unticked)
2707 number-of-unread-unticked t)
2709 'gnus-level level))))
2711 (defun gnus-group-update-group (group &optional visible-only)
2712 "Update newsgroup info of GROUP.
2713 If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't already."
2715 (set-buffer gnus-group-buffer)
2716 (let ((buffer-read-only nil)
2718 (let ((entry (gnus-gethash group gnus-newsrc-hashtb)))
2721 (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry))
2723 ;; Buffer may be narrowed.
2726 ;; Search a line to modify. If the buffer is large, the search
2727 ;; takes long time. In most cases, current point is on the line
2728 ;; we are looking for. So, first of all, check current line.
2731 (eq (get-text-property (point) 'gnus-group)
2736 (point-min) (point-max) 'gnus-group (intern group)))))
2737 ;; GROUP is listed in current buffer. So, delete old line.
2741 (delete-region (point) (progn (forward-line 1) (point))))
2742 ;; No such line in the buffer, find out where it's supposed to
2743 ;; go, and insert it there (or at the end of the buffer).
2744 ;; Fix by Per Abrahamsen <amanda@iesd.auc.dk>.
2746 (let ((entry (cdr (gnus-gethash group gnus-newsrc-hashtb))))
2751 (point-min) (point-max)
2752 'gnus-group (intern (car (car entry)))))))
2753 (setq entry (cdr entry)))
2754 (or entry (goto-char (point-max))))))
2755 (if (or visible (not visible-only))
2757 (gnus-group-insert-group-line-info group)
2758 (forward-line -1) ; Move point back to the inserted line.
2760 (gnus-group-set-mode-line)))
2762 (defun gnus-group-set-mode-line ()
2763 (if (memq 'group gnus-updated-mode-lines)
2764 (let* ((gformat (or gnus-group-mode-line-format-spec
2765 (setq gnus-group-mode-line-format-spec
2767 gnus-group-mode-line-format
2768 gnus-group-mode-line-format-alist))))
2769 (news-server (car (cdr gnus-select-method)))
2770 (news-method (car gnus-select-method))
2771 (mode-string (eval gformat))
2773 (if (> (length mode-string) max-len)
2774 (setq mode-string (substring mode-string 0 (- max-len 4))))
2775 (setq mode-line-buffer-identification mode-string)
2776 (set-buffer-modified-p t))))
2778 (defun gnus-group-group-name ()
2779 "Get the name of the newsgroup on the current line."
2780 (let ((group (get-text-property
2781 (save-excursion (beginning-of-line) (point)) 'gnus-group)))
2782 (and group (symbol-name group))))
2784 (defun gnus-group-group-level ()
2785 "Get the level of the newsgroup on the current line."
2786 (get-text-property (save-excursion (beginning-of-line) (point)) 'gnus-level))
2788 (defun gnus-group-search-forward (&optional backward all level first-too)
2789 "Find the next newsgroup with unread articles.
2790 If BACKWARD is non-nil, find the previous newsgroup instead.
2791 If ALL is non-nil, just find any newsgroup.
2792 If LEVEL is non-nil, find group with level LEVEL, or higher if no such
2794 If FIRST-TOO, the current line is also eligeble as a target."
2795 (let ((way (if backward -1 1))
2799 (or first-too (forward-line way))
2806 (get-text-property (point) 'gnus-unread)))
2807 (or (eq unread t) (and unread (> unread 0)))))
2809 (let ((lev (get-text-property (point) 'gnus-level)))
2815 (setq pos (point))))
2817 (zerop (forward-line way))))
2819 (progn (gnus-group-position-cursor) t)
2820 (if pos (goto-char pos) (goto-char beg))
2823 ;; Gnus group mode commands
2825 (defun gnus-group-read-group (all &optional no-article)
2826 "Read news in this newsgroup.
2827 If argument ALL is non-nil, already read articles become readable.
2828 If optional argument NO-ARTICLE is non-nil, no article body is displayed."
2830 (let ((group (gnus-group-group-name))
2833 (error "No group on current line"))
2834 ;; This group might be a dead group. In that case we have to get
2835 ;; the number of unread articles from `gnus-active-hashtb'.
2836 (if (>= (gnus-group-group-level) 8)
2837 (setq number (- (1+ (cdr (setq active (gnus-gethash
2838 group gnus-active-hashtb))))
2840 (setq number (car (gnus-gethash group gnus-newsrc-hashtb))))
2841 (gnus-summary-read-group
2842 group (or all (and (numberp number) (zerop number))) no-article)))
2844 (defun gnus-group-select-group (all)
2845 "Select this newsgroup.
2846 No article is selected automatically.
2847 If argument ALL is non-nil, already read articles become readable."
2849 (gnus-group-read-group all t))
2851 (defun gnus-group-jump-to-group (group)
2852 "Jump to newsgroup GROUP."
2855 (completing-read "Group: " gnus-active-hashtb nil t)))
2857 ;; Either go to the line in the group buffer...
2858 (or (and (setq b (text-property-any (point-min) (point-max)
2859 'gnus-group (intern group)))
2861 ;; ... or insert the line.
2862 (progn (gnus-group-update-group group)
2863 (goto-char (text-property-any (point-min) (point-max)
2864 'gnus-group (intern group))))))
2865 ;; Adjust cursor point.
2866 (gnus-group-position-cursor))
2868 (defun gnus-group-next-group (n)
2869 "Go to next N'th newsgroup.
2870 If N is negative, search backward instead.
2871 Returns the difference between N and the number of skips actually
2874 (gnus-group-next-unread-group n t))
2876 (defun gnus-group-next-unread-group (n &optional all level)
2877 "Go to next N'th unread newsgroup.
2878 If N is negative, search backward instead.
2879 If ALL is non-nil, choose any newsgroup, unread or not.
2880 If LEVEL is non-nil, choose the next group with level LEVEL, or, if no
2881 such group can be found, the next group with a level higher than
2883 Returns the difference between N and the number of skips actually
2886 (let ((backward (< n 0))
2889 (gnus-group-search-forward backward all level))
2891 (if (/= 0 n) (message "No more%s newsgroups%s" (if all "" " unread")
2892 (if level " on this level or higher" "")))
2895 (defun gnus-group-prev-group (n)
2896 "Go to previous N'th newsgroup.
2897 Returns the difference between N and the number of skips actually
2900 (gnus-group-next-unread-group (- n) t))
2902 (defun gnus-group-prev-unread-group (n)
2903 "Go to previous N'th unread newsgroup.
2904 Returns the difference between N and the number of skips actually
2907 (gnus-group-next-unread-group (- n)))
2909 (defun gnus-group-next-unread-group-same-level (n)
2910 "Go to next N'th unread newsgroup on the same level.
2911 If N is negative, search backward instead.
2912 Returns the difference between N and the number of skips actually
2915 (gnus-group-next-unread-group n t (gnus-group-group-level))
2916 (gnus-group-position-cursor))
2918 (defun gnus-group-prev-unread-group-same-level (n)
2919 "Go to next N'th unread newsgroup on the same level.
2920 Returns the difference between N and the number of skips actually
2923 (gnus-group-next-unread-group (- n) t (gnus-group-group-level))
2924 (gnus-group-position-cursor))
2926 (defun gnus-group-add-group (&optional name how where)
2927 "Add a new newsgroup."
2929 (let ((methods gnus-valid-select-methods)
2932 (setq name (read-string "Group name: ")))
2934 (setq how (completing-read (format "%s method: " name) methods nil t)))
2936 (setq where (read-string
2937 (format "Get %s by method %s from: " name how))))
2938 (setq nname (gnus-group-prefixed-name name (list (intern how) where)))
2939 (gnus-group-change-level
2940 (list t nname 3 nil nil (list (intern how) where))
2941 3 9 (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb)
2943 (gnus-group-insert-group-line-info nname)))
2945 (defun gnus-group-edit-group ()
2947 (let ((group (gnus-group-group-name))
2949 (if group (setq info (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))
2950 (error "No group on current line"))
2951 (switch-to-buffer (get-buffer-create gnus-group-edit-buffer))
2952 (gnus-add-current-to-buffer-list)
2954 ;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
2955 (use-local-map (copy-keymap emacs-lisp-mode-map))
2956 (local-set-key "\C-c\C-c" 'gnus-group-edit-group-done)
2958 (insert ";; Type `C-c C-c' after you have edited the newsgroup entry.\n\n")
2959 (insert (format "(gnus-group-set-info\n '%S)\n" info))))
2961 (defun gnus-group-edit-group-done ()
2963 (set-buffer (get-buffer-create gnus-group-edit-buffer))
2964 (eval-current-buffer)
2965 (kill-buffer (current-buffer))
2966 (set-buffer gnus-group-buffer)
2967 (gnus-group-update-group (gnus-group-group-name))
2968 (gnus-group-position-cursor))
2970 (defun gnus-group-make-directory-group (dir)
2971 "Create an nndir group.
2972 The user will be prompted for a directory. The contents of this
2973 directory will be used as a newsgroup. The directory should contain
2974 mail messages or news articles in files that have numeric names."
2976 (list (read-file-name "Create group from directory: ")))
2977 (or (file-exists-p dir) (error "No such directory"))
2978 (or (file-directory-p dir) (error "Not a directory"))
2979 (gnus-group-add-group dir "nndir" dir))
2981 (defun gnus-group-catchup-current (n &optional all)
2982 "Mark all articles not marked as unread in current newsgroup as read.
2983 If prefix argument N is numeric, the ARG next newsgroups will be
2984 caught up. If ALL is non-nil, marked articles will also be marked as
2985 read. Cross references (Xref: header) of articles are ignored.
2986 The difference between N and actual number of newsgroups that were
2987 caught up is returned."
2989 (if (or (not gnus-interactive-catchup) ;Without confirmation?
2993 "Do you really want to mark all articles as read? "
2994 "Mark all unread articles as read? ")))
3000 (gnus-group-catchup (gnus-group-group-name) all)
3001 (gnus-group-update-group-line)
3003 (zerop (gnus-group-next-unread-group 1))))))
3006 (defun gnus-group-catchup-current-all (n)
3007 "Mark all articles in current newsgroup as read.
3008 Cross references (Xref: header) of articles are ignored."
3010 (gnus-group-catchup-current n 'all))
3012 (defun gnus-group-catchup (group &optional all)
3013 "Mark all articles in GROUP as read.
3014 If ALL is non-nil, all articles are marked as read.
3015 The return value is the number of articles that were marked as read,
3016 or nil if no action could be taken."
3017 (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
3019 (marked (nth 3 (nth 2 entry)))
3021 ;; Do the updating only if the newsgroup isn't killed
3024 (setq ticked (if all nil (cdr (assq 'tick marked))))
3025 (gnus-update-read-articles group ticked nil ticked)
3026 (if (and all marked)
3027 (setcar (nthcdr 3 (nth 2 entry))
3028 (delq (assq 'dormant marked) marked)))))
3031 (defun gnus-group-expire-articles (newsgroup)
3032 "Expire all expirable articles in the current newsgroup."
3033 (interactive (list (gnus-group-group-name)))
3034 (if (not newsgroup) (error "No current newsgroup"))
3036 (assq 'expire (nth 3 (nth 2 (gnus-gethash newsgroup
3037 gnus-newsrc-hashtb))))))
3039 (gnus-check-backend-function 'request-expire-articles newsgroup)
3041 (gnus-request-expire-articles (cdr expirable) newsgroup)))))
3043 (defun gnus-group-expire-all-groups ()
3044 "Expire all expirable articles in all newsgroups."
3046 (message "Expiring...")
3047 (let ((newsrc (cdr gnus-newsrc-assoc)))
3049 (gnus-group-expire-articles (car (car newsrc)))
3050 (setq newsrc (cdr newsrc))))
3051 (message "Expiring...done"))
3053 (defun gnus-group-set-current-level (n)
3054 "Set the level of the current group to the numeric prefix."
3056 (setq n (or n (string-to-int
3059 (mapcar (lambda (n) (list (char-to-string n))) "123456789")
3061 (let ((group (gnus-group-group-name)))
3062 (if (not group) (error "No newsgroup on current line.")
3063 (if (and (numberp n) (>= n 1) (<= n 9))
3065 (gnus-group-change-level group n (gnus-group-group-level))
3066 (gnus-group-update-group-line))
3067 (error "Illegal level: %s" n)))))
3069 (defun gnus-group-unsubscribe-current-group (arg)
3070 "Toggle subscribe from/to unsubscribe current group."
3072 (let ((group (gnus-group-group-name)))
3076 (setq arg (if (<= (gnus-group-group-level) 5) 6 3)))
3077 (gnus-group-unsubscribe-group group arg)
3078 ; (gnus-group-next-group 1)
3080 (message "No newsgroup on current line"))))
3082 (defun gnus-group-unsubscribe-group (group &optional level)
3083 "Toggle subscribe from/to unsubscribe GROUP.
3084 New newsgroup is added to .newsrc automatically."
3086 (list (completing-read "Group: " gnus-active-hashtb nil t)))
3087 (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
3089 ;; Toggle subscription flag.
3090 (gnus-group-change-level
3091 newsrc (if level level (if (< (nth 1 (nth 2 newsrc)) 6) 6 4)))
3092 (gnus-group-update-group group))
3093 ((and (stringp group)
3094 (gnus-gethash group gnus-active-hashtb))
3095 ;; Add new newsgroup.
3096 (gnus-group-change-level
3099 (if (member group gnus-zombie-list) 8 9)
3100 (or (and (gnus-group-group-name)
3101 (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb))
3102 (gnus-gethash (car (car gnus-newsrc-assoc))
3103 gnus-newsrc-hashtb)))
3104 (gnus-group-update-group group))
3105 (t (error "No such newsgroup: %s" group)))
3106 (gnus-group-position-cursor)))
3108 (defun gnus-group-transpose-groups (arg)
3109 "Exchange current newsgroup and previous newsgroup.
3110 With argument ARG, takes previous newsgroup and moves it past ARG newsgroup."
3112 ;; BUG: last newsgroup and the last but one cannot be transposed
3113 ;; since gnus-group-search-forward does not move forward beyond the
3114 ;; last. If we instead use forward-line, no problem, but I don't
3115 ;; want to use it for later extension.
3117 (gnus-group-search-forward t t)
3118 (gnus-group-kill-group 1)
3119 (gnus-group-search-forward nil t)
3120 (gnus-group-yank-group)
3121 (gnus-group-search-forward nil t)
3125 (defun gnus-group-kill-all-zombies ()
3126 "Kill all zombie newsgroups."
3128 (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list))
3129 (setq gnus-zombie-list nil)
3130 (gnus-group-prepare 5)
3131 (goto-char (point-min))
3132 (gnus-group-position-cursor))
3134 (defun gnus-group-kill-region (begin end)
3135 "Kill newsgroups in current region (excluding current point).
3136 The killed newsgroups can be yanked by using \\[gnus-group-yank-group]."
3139 ;; Exclude a line where current point is on.
3153 (beginning-of-line) ;Important when LINES < 1
3154 (gnus-group-kill-group lines)))
3156 (defun gnus-group-kill-group (n)
3157 "The the next N groups.
3158 The killed newsgroups can be yanked by using \\[gnus-group-yank-group].
3159 However, only groups that were alive can be yanked; already killed
3160 groups or zombie groups can't be yanked.
3161 The return value is the name of the (last) newsgroup that was killed."
3163 (let ((buffer-read-only nil)
3165 (while (>= (setq n (1- n)) 0)
3166 (setq group (gnus-group-group-name))
3168 (signal 'end-of-buffer nil))
3169 (setq level (gnus-group-group-level))
3171 (delete-region (point) (progn (forward-line 1) (point)))
3172 (if (setq entry (gnus-gethash group gnus-newsrc-hashtb))
3173 (setq gnus-list-of-killed-groups
3174 (cons (cons (car entry) (nth 2 entry))
3175 gnus-list-of-killed-groups)))
3176 (gnus-group-change-level
3177 (if entry entry group) 9
3178 (if entry nil level)))
3181 (gnus-group-position-cursor)
3184 (defun gnus-group-yank-group (&optional arg)
3185 "Yank the last newsgroups killed with \\[gnus-group-kill-group],
3186 inserting it before the current newsgroup. The numeric ARG specifies
3187 how many newsgroups are to be yanked. The name of the (last)
3188 newsgroup yanked is returned."
3190 (if (not arg) (setq arg 1))
3191 (let (info group prev)
3192 (while (>= (setq arg (1- arg)) 0)
3193 (if (not (setq info (car gnus-list-of-killed-groups)))
3194 (error "No more newsgroups to yank"))
3195 (setq group (nth 2 info))
3196 ;; Find which newsgroup to insert this one before - search
3197 ;; backward until something suitable is found. If there are no
3198 ;; other newsgroups in this buffer, just make this newsgroup the
3200 (while (and (not (setq prev (gnus-group-group-name)))
3201 (zerop (forward-line -1))))
3203 (setq prev (car (car gnus-newsrc-assoc))))
3204 (gnus-group-change-level
3206 (gnus-gethash prev gnus-newsrc-hashtb)
3208 (gnus-group-insert-group-line-info (nth 1 info))
3209 (setq gnus-list-of-killed-groups
3210 (cdr gnus-list-of-killed-groups)))
3212 (gnus-group-position-cursor)
3215 (defun gnus-group-list-all-groups (arg)
3216 "List all newsgroups with level ARG or lower.
3217 Default is 7, which lists all subscribed and most unsubscribed groups."
3219 (setq arg (or arg 7))
3220 (gnus-group-list-groups arg t))
3222 (defun gnus-group-list-killed ()
3223 "List all killed newsgroups in the group buffer."
3225 (gnus-group-prepare 9 t 9)
3226 (goto-char (point-min))
3227 (gnus-group-position-cursor))
3229 (defun gnus-group-list-zombies ()
3230 "List all zombie newsgroups in the group buffer."
3232 (gnus-group-prepare 8 t 8)
3233 (goto-char (point-min))
3234 (gnus-group-position-cursor))
3236 (defun gnus-group-get-new-news (&optional arg)
3237 "Get newly arrived articles.
3238 If ARG is non-nil, it should be a number between one and nine to
3239 specify which levels you are interested in re-scanning."
3241 (if (and gnus-read-active-file (not arg))
3243 (gnus-read-active-file)
3244 (gnus-get-unread-articles (or arg 6)))
3245 (let ((gnus-read-active-file nil))
3246 (gnus-get-unread-articles (or arg 6))))
3247 (gnus-group-list-groups 5 gnus-have-all-newsgroups))
3249 (defun gnus-group-get-new-news-this-group (n)
3250 "Check for newly arrived news in the current group (and the N-1 next groups).
3251 The difference between N and the number of newsgroup checked is returned.
3252 If N is negative, this group and the N-1 previous groups will be checked."
3254 (let ((way (if (< n 0) -1 1))
3256 (w-p (window-start))
3259 (gnus-get-new-news-in-group (gnus-group-group-name))
3260 (zerop (gnus-group-next-group way)))
3262 (if (/= 0 n) (message "No more newsgroups"))
3263 ;; !!! I don't know why the buffer scrolls forward when updating
3264 ;; the first line in the group buffer, but it does. So we set the
3265 ;; window start forcibly.
3266 (set-window-start (get-buffer-window (current-buffer)) w-p)
3269 (defun gnus-get-new-news-in-group (group)
3270 (if (and group (gnus-activate-newsgroup group))
3272 (gnus-get-unread-articles-in-group
3273 (nth 2 (gnus-gethash group gnus-newsrc-hashtb))
3274 (gnus-gethash group gnus-active-hashtb))
3275 (gnus-group-update-group-line)))
3278 (defun gnus-group-describe-group (&optional group)
3279 "Display a description of the current newsgroup."
3281 (let ((group (or group (gnus-group-group-name))))
3283 (message "No group on current line")
3284 (and (or gnus-description-hashtb
3285 (gnus-read-descriptions-file))
3287 (or (gnus-gethash group gnus-description-hashtb)
3288 "No description available"))))))
3290 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
3291 (defun gnus-group-describe-all-groups ()
3292 "Pop up a buffer with descriptons of all newsgroups."
3294 (if (not (or gnus-description-hashtb
3295 (gnus-read-descriptions-file)))
3296 (error "Couldn't request descriptions file"))
3297 (let ((buffer-read-only nil)
3302 (insert (format " *: %-20s %s" (symbol-name group)
3303 (symbol-value group)))
3305 (add-text-properties
3306 b (1+ b) (list 'gnus-group (intern group)
3307 'gnus-unread t 'gnus-marked nil 'gnus-level 6)))
3308 gnus-description-hashtb)
3309 (goto-char (point-min))
3310 (gnus-group-position-cursor)))
3312 ;; Suggested by by Daniel Quinlan <quinlan@best.com>.
3313 (defun gnus-group-apropos (regexp &optional search-description)
3314 "List all newsgroups that have names that match a regexp."
3315 (interactive "sGnus apropos (regexp): ")
3317 (obuf (current-buffer))
3319 ;; Go through all newsgroups that are known to Gnus.
3322 (and (string-match regexp (symbol-name group))
3323 (setq groups (cons (symbol-name group) groups))))
3325 ;; Go through all descriptions that are known to Gnus.
3326 (if search-description
3329 (and (string-match regexp (symbol-value group))
3330 (gnus-gethash (symbol-name group) gnus-active-hashtb)
3331 (setq groups (cons (symbol-name group) groups))))
3332 gnus-description-hashtb))
3334 (message "No groups matched \"%s\"." regexp)
3335 ;; Print out all the groups.
3337 (pop-to-buffer (get-buffer-create "*Gnus Help*"))
3338 (buffer-disable-undo (current-buffer))
3340 (setq groups (sort groups 'string<))
3342 ;; Groups may be entered twice into the list of groups.
3343 (if (not (string= (car groups) prev))
3345 (insert (setq prev (car groups)) "\n")
3346 (if (and gnus-description-hashtb
3347 (setq des (gnus-gethash (car groups)
3348 gnus-description-hashtb)))
3349 (insert " " des "\n"))))
3350 (setq groups (cdr groups)))
3352 (pop-to-buffer obuf)))
3354 (defun gnus-group-description-apropos (regexp)
3355 "List all newsgroups that have names or desccriptions that match a regexp."
3356 (interactive "sGnus description apropos (regexp): ")
3357 (if (not (or gnus-description-hashtb
3358 (gnus-read-descriptions-file)))
3359 (error "Couldn't request descriptions file"))
3360 (gnus-group-apropos regexp t))
3362 ;; Written by Per Abrahamsen <amanda@iesd.auc.dk>.
3363 (defun gnus-group-list-matching (regexp)
3364 "List all newsgroups with unread articles that match REGEXP."
3365 (interactive "sList newsgroups matching: ")
3366 (set-buffer gnus-group-buffer)
3367 (let ((buffer-read-only nil)
3368 (newsrc (cdr gnus-newsrc-assoc))
3369 (zombie gnus-zombie-list)
3370 (killed gnus-killed-list)
3371 info unread active group)
3374 ;; List alive newsgroups.
3376 (setq info (car newsrc)
3379 unread (car (gnus-gethash group gnus-newsrc-hashtb)))
3380 (if (and unread ; This group might be bogus
3381 (string-match regexp group))
3382 (gnus-group-insert-group-line
3383 nil group (car (cdr info)) (nth 3 info) unread
3386 ;; List zombies and killed lists.
3387 (let ((lists (list 'gnus-zombie-list 'gnus-killed-list))
3390 (if (eq (car lists) 'gnus-zombie-list)
3393 (setq newsrc (set (car lists)
3394 (sort (symbol-value (car lists))
3395 (function string<))))
3397 (setq group (car newsrc)
3398 newsrc (cdr newsrc))
3399 (if (not (string-match regexp group))
3402 (insert (format " %c *: %s" mark group))
3403 (add-text-properties
3405 (list 'gnus-group (intern group)
3407 'gnus-level (if (= mark ?Z) 8 9)))))
3408 (setq lists (cdr lists))))
3410 (gnus-group-set-mode-line)
3411 (setq gnus-have-all-newsgroups t)
3412 (run-hooks 'gnus-group-prepare-hook))
3413 (goto-char (point-min))
3414 (gnus-group-position-cursor))
3416 ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
3417 (defun gnus-group-save-newsrc ()
3418 "Save the Gnus startup files."
3420 (gnus-save-newsrc-file))
3422 (defun gnus-group-restart (&optional arg)
3423 "Force Gnus to read the .newsrc file."
3425 (gnus-save-newsrc-file)
3426 (gnus-setup-news 'force)
3427 (gnus-group-list-groups (or arg 5) gnus-have-all-newsgroups))
3429 (defun gnus-group-read-init-file ()
3430 "Read the Gnus elisp init file."
3432 (gnus-read-init-file))
3434 (defun gnus-group-check-bogus-groups ()
3435 "Check bogus newsgroups."
3437 (gnus-check-bogus-newsgroups (not gnus-expert-user)) ;Require confirmation.
3438 (gnus-group-list-groups 5 gnus-have-all-newsgroups))
3440 (defun gnus-group-mail ()
3441 "Start composing a mail."
3445 (defun gnus-group-edit-global-kill ()
3446 "Edit a global kill file."
3448 (setq gnus-current-kill-article nil) ;No articles selected.
3449 (gnus-kill-file-edit-file nil) ;Nil stands for global KILL file.
3451 (substitute-command-keys
3452 "Editing a global kill file (Type \\[gnus-kill-file-exit] to exit)")))
3454 (defun gnus-group-edit-local-kill ()
3455 "Edit a local kill file."
3457 (setq gnus-current-kill-article nil) ;No articles selected.
3458 (gnus-kill-file-edit-file (gnus-group-group-name))
3460 (substitute-command-keys
3461 "Editing a local kill file (Type \\[gnus-kill-file-exit] to exit)")))
3463 (defun gnus-group-force-update ()
3464 "Update `.newsrc' file."
3466 (gnus-save-newsrc-file))
3468 (defun gnus-group-suspend ()
3469 "Suspend the current Gnus session.
3470 In fact, cleanup buffers except for group mode buffer.
3471 The hook gnus-suspend-gnus-hook is called before actually suspending."
3473 (run-hooks 'gnus-suspend-gnus-hook)
3474 ;; Kill Gnus buffers except for group mode buffer.
3475 (let ((group-buf (get-buffer gnus-group-buffer)))
3476 (while gnus-buffer-list
3477 (and (not (eq (car gnus-buffer-list) group-buf))
3478 (get-buffer (car gnus-buffer-list))
3479 (buffer-name (get-buffer (car gnus-buffer-list)))
3480 (kill-buffer (car gnus-buffer-list)))
3481 (setq gnus-buffer-list (cdr gnus-buffer-list)))
3482 (setq gnus-buffer-list (list group-buf))
3483 (bury-buffer group-buf)
3484 (delete-windows-on group-buf t)))
3486 (defun gnus-group-clear-dribble ()
3487 "Clear all information from the dribble buffer."
3489 (gnus-dribble-clear))
3491 (defun gnus-group-exit ()
3492 "Quit reading news after updating .newsrc.eld and .newsrc.
3493 The hook `gnus-exit-gnus-hook' is called before actually exiting."
3495 (if (or noninteractive ;For gnus-batch-kill
3496 (zerop (buffer-size)) ;No news is good news.
3497 (not (gnus-server-opened gnus-select-method)) ;NNTP connection closed
3498 (not gnus-interactive-exit) ;Without confirmation
3500 (y-or-n-p "Are you sure you want to quit reading news? "))
3502 (message "") ;Erase "Yes or No" question.
3503 (run-hooks 'gnus-exit-gnus-hook)
3504 (gnus-save-newsrc-file)
3505 (gnus-clear-system))))
3507 (defun gnus-group-quit ()
3508 "Quit reading news without updating .newsrc.eld or .newsrc.
3509 The hook `gnus-exit-gnus-hook' is called before actually exiting."
3511 (if (or noninteractive ;For gnus-batch-kill
3512 (zerop (buffer-size))
3513 (not (gnus-server-opened gnus-select-method))
3515 (not gnus-current-startup-file)
3517 (format "Quit reading news without saving %s? "
3518 (file-name-nondirectory gnus-current-startup-file))))
3520 (message "") ;Erase "Yes or No" question.
3521 (run-hooks 'gnus-exit-gnus-hook)
3523 (gnus-clear-system))))
3525 (defun gnus-group-describe-briefly ()
3526 "Give a one line description of the group mode commands."
3529 (substitute-command-keys "\\<gnus-group-mode-map>\\[gnus-group-read-group]:Select \\[gnus-group-next-unread-group]:Forward \\[gnus-group-prev-unread-group]:Backward \\[gnus-group-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-group-describe-briefly]:This help")))
3531 (defun gnus-group-browse-foreign-server (method)
3532 "Browse a foreign news server.
3533 If called interactively, this function will ask for a select method
3534 (nntp, nnspool, etc.) and a server address (eg. nntp.some.where).
3535 If not, METHOD should be a list where the first element is the method
3536 and the second element is the address."
3538 (list (list (intern (completing-read
3540 gnus-valid-select-methods nil t "nntp"))
3541 ;; Suggested by mapjph@bath.ac.uk.
3544 (mapcar (lambda (server) (list server))
3545 gnus-secondary-servers)))))
3546 (gnus-browse-foreign-server method))
3550 ;;; Browse Server Mode
3553 (defvar gnus-browse-server-mode-hook nil)
3554 (defvar gnus-browse-server-mode-map nil)
3556 (if gnus-browse-server-mode-map
3558 (setq gnus-browse-server-mode-map (make-keymap))
3559 (suppress-keymap gnus-browse-server-mode-map)
3560 (define-key gnus-browse-server-mode-map " " 'gnus-browse-read-group)
3561 (define-key gnus-browse-server-mode-map "=" 'gnus-browse-read-group)
3562 (define-key gnus-browse-server-mode-map "n" 'gnus-browse-next-group)
3563 (define-key gnus-browse-server-mode-map "p" 'gnus-browse-prev-group)
3564 (define-key gnus-browse-server-mode-map [del] 'gnus-browse-prev-group)
3565 (define-key gnus-browse-server-mode-map "N" 'gnus-browse-next-group)
3566 (define-key gnus-browse-server-mode-map "P" 'gnus-group-prev-group)
3567 (define-key gnus-browse-server-mode-map "\M-n" 'gnus-browse-next-group)
3568 (define-key gnus-browse-server-mode-map "\M-p" 'gnus-browse-prev-group)
3569 (define-key gnus-browse-server-mode-map "\r" 'gnus-browse-read-group)
3570 (define-key gnus-browse-server-mode-map "u" 'gnus-browse-unsubscribe-current-group)
3571 (define-key gnus-browse-server-mode-map "q" 'gnus-browse-exit)
3572 (define-key gnus-browse-server-mode-map "Q" 'gnus-browse-exit)
3573 (define-key gnus-browse-server-mode-map "\C-c\C-c" 'gnus-browse-quit)
3574 (define-key gnus-browse-server-mode-map "?" 'gnus-browse-describe-briefly)
3575 (define-key gnus-browse-server-mode-map "\C-c\C-i" 'gnus-info-find-node)
3578 (defvar gnus-browse-current-method nil)
3580 (defun gnus-browse-foreign-server (method)
3581 (setq gnus-browse-current-method method)
3582 (let ((gnus-select-method method)
3584 (message "Connecting to %s..." (nth 1 method))
3585 (if (not (gnus-request-list method))
3586 (error "Unable to contact server: " (gnus-status-message method)))
3587 (set-buffer (get-buffer-create "*Gnus Browse Server*"))
3588 (gnus-add-current-to-buffer-list)
3589 (buffer-disable-undo (current-buffer))
3590 (let ((buffer-read-only nil))
3592 (gnus-browse-server-mode)
3593 (setq mode-line-buffer-identification
3595 "(ding) Browse Server {%s:%s}" (car method) (car (cdr method))))
3597 (set-buffer nntp-server-buffer)
3598 (let ((cur (current-buffer)))
3600 (while (re-search-forward
3601 "\\(^[^ \t]+\\)[ \t]+[0-9]+[ \t]+[0-9]+" nil t)
3602 (goto-char (match-end 1))
3603 (setq groups (cons (cons (buffer-substring (match-beginning 1)
3605 (- (read cur) (read cur)))
3607 (setq groups (sort groups
3609 (string< (car l1) (car l2)))))
3610 (let ((buffer-read-only nil))
3612 (setq group (car groups))
3614 (format "K%7d: %s\n" (cdr group) (car group)))
3615 (setq groups (cdr groups))))
3616 (switch-to-buffer (current-buffer))
3618 (gnus-group-position-cursor)))
3620 (defun gnus-browse-server-mode ()
3621 "Major mode for reading network news."
3623 (kill-all-local-variables)
3624 (setq mode-line-modified "-- ")
3625 (make-local-variable 'mode-line-format)
3626 (setq mode-line-format (copy-sequence mode-line-format))
3627 (and (equal (nth 3 mode-line-format) " ")
3628 (setcar (nthcdr 3 mode-line-format) ""))
3629 (setq major-mode 'gnus-browse-server-mode)
3630 (setq mode-name "Browse Server")
3631 (setq mode-line-process nil)
3632 (use-local-map gnus-browse-server-mode-map)
3633 (buffer-disable-undo (current-buffer))
3634 (setq truncate-lines t)
3635 (setq buffer-read-only t)
3636 (run-hooks 'gnus-browse-server-mode-hook))
3638 (defun gnus-browse-read-group ()
3639 "Not implemented, and will probably never be."
3641 (error "You can't read while browsing"))
3643 (defun gnus-browse-next-group (n)
3644 "Go to the next group."
3648 (gnus-group-position-cursor)))
3650 (defun gnus-browse-prev-group (n)
3651 "Go to the next group."
3653 (gnus-browse-next-group (- n)))
3655 (defun gnus-browse-unsubscribe-current-group (arg)
3656 "(Un)subscribe to the next ARG groups."
3659 (error "No group at current line."))
3660 (let ((ward (if (< arg 0) -1 1))
3662 (while (and (> arg 0)
3664 (gnus-browse-unsubscribe-group)
3665 (zerop (gnus-browse-next-group ward)))
3666 (setq arg (1- arg)))
3667 (gnus-group-position-cursor)
3668 (if (/= 0 arg) (message "No more newsgroups" ))
3671 (defun gnus-browse-unsubscribe-group ()
3673 (buffer-read-only nil)
3677 (if (= (following-char) ?K) (setq sub t))
3678 (re-search-forward ": \\(.*\\)$" nil t)
3679 (setq group (gnus-group-prefixed-name
3680 (buffer-substring (match-beginning 1) (match-end 1))
3681 gnus-browse-current-method))
3686 (gnus-group-change-level
3687 (list t group 3 nil nil gnus-browse-current-method) 3 9
3688 (gnus-gethash (car (nth 1 gnus-newsrc-assoc)) gnus-newsrc-hashtb)
3691 (gnus-group-change-level group 9 3)
3695 (defun gnus-browse-exit ()
3696 "Quit browsing and return to the group buffer."
3698 (if (eq major-mode 'gnus-browse-server-mode)
3699 (kill-buffer (current-buffer)))
3700 (switch-to-buffer gnus-group-buffer)
3701 (gnus-group-list-groups 5))
3703 (defun gnus-browse-describe-briefly ()
3704 "Give a one line description of the group mode commands."
3707 (substitute-command-keys "\\<gnus-browse-server-mode-map>\\[gnus-group-next-group]:Forward \\[gnus-group-prev-group]:Backward \\[gnus-browse-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-browse-describe-briefly]:This help")))
3711 ;;; Gnus summary mode
3714 (defvar gnus-summary-mode-map nil)
3715 (defvar gnus-summary-mark-map nil)
3716 (defvar gnus-summary-send-map nil)
3717 (defvar gnus-summary-extract-map nil)
3718 (defvar gnus-summary-article-map nil)
3719 (defvar gnus-summary-thread-map nil)
3720 (defvar gnus-summary-goto-map nil)
3721 (defvar gnus-summary-exit-map nil)
3722 (defvar gnus-summary-various-map nil)
3723 (defvar gnus-summary-interest-map nil)
3724 (defvar gnus-summary-process-map nil)
3725 (defvar gnus-summary-sort-map nil)
3726 (defvar gnus-summary-mgroup-map nil)
3727 (defvar gnus-summary-vkill-map nil)
3728 (defvar gnus-summary-increase-map nil)
3729 (defvar gnus-summary-inc-subject-map nil)
3730 (defvar gnus-summary-inc-author-map nil)
3731 (defvar gnus-summary-inc-xref-map nil)
3732 (defvar gnus-summary-inc-thread-map nil)
3733 (defvar gnus-summary-inc-fol-map nil)
3734 (defvar gnus-summary-lower-map nil)
3735 (defvar gnus-summary-low-subject-map nil)
3736 (defvar gnus-summary-low-author-map nil)
3737 (defvar gnus-summary-low-xref-map nil)
3738 (defvar gnus-summary-low-thread-map nil)
3739 (defvar gnus-summary-low-fol-map nil)
3741 (if gnus-summary-mode-map
3743 (setq gnus-summary-mode-map (make-keymap))
3744 (suppress-keymap gnus-summary-mode-map)
3746 ;;Non-orthogonal keys
3748 (define-key gnus-summary-mode-map " " 'gnus-summary-next-page)
3749 (define-key gnus-summary-mode-map "\177" 'gnus-summary-prev-page)
3750 (define-key gnus-summary-mode-map "\r" 'gnus-summary-scroll-up)
3751 (define-key gnus-summary-mode-map "n" 'gnus-summary-next-unread-article)
3752 (define-key gnus-summary-mode-map "p" 'gnus-summary-prev-unread-article)
3753 (define-key gnus-summary-mode-map "N" 'gnus-summary-next-article)
3754 (define-key gnus-summary-mode-map "P" 'gnus-summary-prev-article)
3755 (define-key gnus-summary-mode-map "\M-\C-n" 'gnus-summary-next-same-subject)
3756 (define-key gnus-summary-mode-map "\M-\C-p" 'gnus-summary-prev-same-subject)
3757 (define-key gnus-summary-mode-map "\C-c\C-n" 'gnus-summary-next-digest)
3758 (define-key gnus-summary-mode-map "\C-c\C-p" 'gnus-summary-prev-digest)
3759 (define-key gnus-summary-mode-map "\M-n" 'gnus-summary-next-unread-subject)
3760 (define-key gnus-summary-mode-map "\M-p" 'gnus-summary-prev-unread-subject)
3761 (define-key gnus-summary-mode-map "." 'gnus-summary-first-unread-article)
3762 (define-key gnus-summary-mode-map "," 'gnus-summary-best-unread-article)
3763 (define-key gnus-summary-mode-map "\M-s" 'gnus-summary-search-article-forward)
3764 (define-key gnus-summary-mode-map "\M-r" 'gnus-summary-search-article-backward)
3765 (define-key gnus-summary-mode-map "<" 'gnus-summary-beginning-of-article)
3766 (define-key gnus-summary-mode-map ">" 'gnus-summary-end-of-article)
3767 (define-key gnus-summary-mode-map "j" 'gnus-summary-goto-subject)
3768 (define-key gnus-summary-mode-map "^" 'gnus-summary-refer-parent-article)
3769 (define-key gnus-summary-mode-map "\M-^" 'gnus-summary-refer-article)
3770 (define-key gnus-summary-mode-map "u" 'gnus-summary-tick-article-forward)
3771 (define-key gnus-summary-mode-map "!" 'gnus-summary-tick-article-forward)
3772 (define-key gnus-summary-mode-map "U" 'gnus-summary-tick-article-backward)
3773 (define-key gnus-summary-mode-map "d" 'gnus-summary-mark-as-read-forward)
3774 (define-key gnus-summary-mode-map "D" 'gnus-summary-mark-as-read-backward)
3775 (define-key gnus-summary-mode-map "\M-u" 'gnus-summary-clear-mark-forward)
3776 (define-key gnus-summary-mode-map "\M-U" 'gnus-summary-clear-mark-backward)
3777 (define-key gnus-summary-mode-map "k" 'gnus-summary-kill-same-subject-and-select)
3778 (define-key gnus-summary-mode-map "\C-k" 'gnus-summary-kill-same-subject)
3779 (define-key gnus-summary-mode-map "\M-\C-k" 'gnus-summary-kill-thread)
3780 (define-key gnus-summary-mode-map "#" 'gnus-summary-mark-as-processable)
3781 (define-key gnus-summary-mode-map "\M-#" 'gnus-summary-unmark-as-processable)
3782 (define-key gnus-summary-mode-map "\M-\C-t" 'gnus-summary-toggle-threads)
3783 (define-key gnus-summary-mode-map "\M-\C-s" 'gnus-summary-show-thread)
3784 (define-key gnus-summary-mode-map "\M-\C-h" 'gnus-summary-hide-thread)
3785 (define-key gnus-summary-mode-map "\M-\C-f" 'gnus-summary-next-thread)
3786 (define-key gnus-summary-mode-map "\M-\C-b" 'gnus-summary-prev-thread)
3787 (define-key gnus-summary-mode-map "\M-\C-u" 'gnus-summary-up-thread)
3788 (define-key gnus-summary-mode-map "\M-\C-d" 'gnus-summary-down-thread)
3789 (define-key gnus-summary-mode-map "&" 'gnus-summary-execute-command)
3790 (define-key gnus-summary-mode-map "c" 'gnus-summary-catchup-and-exit)
3791 (define-key gnus-summary-mode-map "\C-t" 'gnus-summary-toggle-truncation)
3792 (define-key gnus-summary-mode-map "\M-d" 'gnus-summary-remove-lines-marked-as-read)
3793 (define-key gnus-summary-mode-map "\C-c\M-\C-d" 'gnus-summary-remove-lines-marked-with)
3794 (define-key gnus-summary-mode-map "?" 'gnus-summary-mark-as-dormant)
3795 (define-key gnus-summary-mode-map "\C-c\M-\C-s" 'gnus-summary-show-all-expunged)
3796 (define-key gnus-summary-mode-map "\C-c\C-s\C-n" 'gnus-summary-sort-by-number)
3797 (define-key gnus-summary-mode-map "\C-c\C-s\C-a" 'gnus-summary-sort-by-author)
3798 (define-key gnus-summary-mode-map "\C-c\C-s\C-s" 'gnus-summary-sort-by-subject)
3799 (define-key gnus-summary-mode-map "\C-c\C-s\C-d" 'gnus-summary-sort-by-date)
3800 (define-key gnus-summary-mode-map "\C-c\C-s\C-i" 'gnus-summary-sort-by-score)
3801 (define-key gnus-summary-mode-map "=" 'gnus-summary-expand-window)
3802 (define-key gnus-summary-mode-map "\C-x\C-s" 'gnus-summary-reselect-current-group)
3803 (define-key gnus-summary-mode-map "\M-g" 'gnus-summary-rescan-group)
3804 (define-key gnus-summary-mode-map "w" 'gnus-summary-stop-page-breaking)
3805 (define-key gnus-summary-mode-map "\C-c\C-r" 'gnus-summary-caesar-message)
3806 (define-key gnus-summary-mode-map "\M-t" 'gnus-summary-toggle-mime)
3807 (define-key gnus-summary-mode-map "\C-d" 'gnus-summary-rmail-digest)
3808 (define-key gnus-summary-mode-map "f" 'gnus-summary-followup)
3809 (define-key gnus-summary-mode-map "F" 'gnus-summary-followup-with-original)
3810 (define-key gnus-summary-mode-map "C" 'gnus-summary-cancel-article)
3811 (define-key gnus-summary-mode-map "r" 'gnus-summary-reply)
3812 (define-key gnus-summary-mode-map "R" 'gnus-summary-reply-with-original)
3813 (define-key gnus-summary-mode-map "\C-c\C-f" 'gnus-summary-mail-forward)
3814 (define-key gnus-summary-mode-map "o" 'gnus-summary-save-article)
3815 (define-key gnus-summary-mode-map "\C-o" 'gnus-summary-save-article-mail)
3816 (define-key gnus-summary-mode-map "|" 'gnus-summary-pipe-output)
3817 (define-key gnus-summary-mode-map "\M-k" 'gnus-summary-edit-local-kill)
3818 (define-key gnus-summary-mode-map "\M-K" 'gnus-summary-edit-global-kill)
3819 (define-key gnus-summary-mode-map "V" 'gnus-version)
3820 (define-key gnus-summary-mode-map "\C-c\C-d" 'gnus-summary-describe-group)
3821 (define-key gnus-summary-mode-map "q" 'gnus-summary-exit)
3822 (define-key gnus-summary-mode-map "Q" 'gnus-summary-quit)
3823 (define-key gnus-summary-mode-map "\C-c\C-i" 'gnus-info-find-node)
3824 (define-key gnus-summary-mode-map [mouse-2] 'gnus-mouse-pick-article)
3825 (define-key gnus-summary-mode-map "m" 'gnus-summary-mail-other-window)
3826 (define-key gnus-summary-mode-map "a" 'gnus-summary-post-news)
3827 (define-key gnus-summary-mode-map "x" 'gnus-summary-delete-marked-as-read)
3828 (define-key gnus-summary-mode-map "s" 'gnus-summary-isearch-article)
3829 (define-key gnus-summary-mode-map "t" 'gnus-summary-toggle-header)
3830 (define-key gnus-summary-mode-map "g" 'gnus-summary-show-article)
3831 ; (define-key gnus-summary-mode-map "?" 'gnus-summary-describe-briefly)
3832 (define-key gnus-summary-mode-map "l" 'gnus-summary-goto-last-article)
3835 ;; Orthogonal keymap
3836 (define-prefix-command 'gnus-summary-mark-map)
3837 (define-key gnus-summary-mode-map "M" 'gnus-summary-mark-map)
3838 (define-key gnus-summary-mark-map "t" 'gnus-summary-tick-article-forward)
3839 (define-key gnus-summary-mark-map "!" 'gnus-summary-tick-article-forward)
3840 (define-key gnus-summary-mark-map "d" 'gnus-summary-mark-as-read-forward)
3841 (define-key gnus-summary-mark-map "r" 'gnus-summary-mark-as-read-forward)
3842 (define-key gnus-summary-mark-map "c" 'gnus-summary-clear-mark-forward)
3843 (define-key gnus-summary-mark-map " " 'gnus-summary-clear-mark-forward)
3844 (define-key gnus-summary-mark-map "e" 'gnus-summary-mark-as-expirable)
3845 (define-key gnus-summary-mark-map "x" 'gnus-summary-mark-as-expirable)
3846 (define-key gnus-summary-mark-map "?" 'gnus-summary-mark-as-dormant)
3847 (define-key gnus-summary-mark-map "b" 'gnus-summary-set-bookmark)
3848 (define-key gnus-summary-mark-map "B" 'gnus-summary-remove-bookmark)
3849 (define-key gnus-summary-mark-map "#" 'gnus-summary-mark-as-processable)
3850 (define-key gnus-summary-mark-map "\M-#" 'gnus-summary-unmark-as-processable)
3851 (define-key gnus-summary-mark-map "\M-r" 'gnus-summary-remove-lines-marked-as-read)
3852 (define-key gnus-summary-mark-map "\M-\C-r" 'gnus-summary-remove-lines-marked-with)
3853 (define-key gnus-summary-mark-map "\C-d" 'gnus-summary-show-all-dormant)
3854 (define-key gnus-summary-mark-map "\C-s" 'gnus-summary-show-all-expunged)
3855 (define-key gnus-summary-mark-map "C" 'gnus-summary-catchup)
3856 (define-key gnus-summary-mark-map "\C-c" 'gnus-summary-catchup-all)
3857 (define-key gnus-summary-mark-map "a" 'gnus-summary-clear-above)
3858 (define-key gnus-summary-mark-map "A" 'gnus-summary-tick-above)
3860 (define-prefix-command 'gnus-summary-process-map)
3861 (define-key gnus-summary-mark-map "p" 'gnus-summary-process-map)
3862 (define-key gnus-summary-process-map "p" 'gnus-summary-mark-as-processable)
3863 (define-key gnus-summary-process-map "u" 'gnus-summary-unmark-as-processable)
3864 (define-key gnus-summary-process-map "U" 'gnus-summary-unmark-all-processable)
3865 (define-key gnus-summary-process-map "s" 'gnus-uu-mark-by-regexp)
3866 (define-key gnus-summary-process-map "r" 'gnus-uu-mark-region)
3867 (define-key gnus-summary-process-map "t" 'gnus-uu-mark-thread)
3868 (define-key gnus-summary-process-map "a" 'gnus-uu-mark-sparse)
3871 (define-prefix-command 'gnus-summary-send-map)
3872 (define-key gnus-summary-mode-map "S" 'gnus-summary-send-map)
3873 (define-key gnus-summary-send-map "p" 'gnus-summary-post-news)
3874 (define-key gnus-summary-send-map "f" 'gnus-summary-followup)
3875 (define-key gnus-summary-send-map "F" 'gnus-summary-followup-with-original)
3876 (define-key gnus-summary-send-map "c" 'gnus-summary-cancel-article)
3877 (define-key gnus-summary-send-map "s" 'gnus-summary-supersede-article)
3878 (define-key gnus-summary-send-map "r" 'gnus-summary-reply)
3879 (define-key gnus-summary-send-map "R" 'gnus-summary-reply-with-original)
3880 (define-key gnus-summary-send-map "\C-f" 'gnus-summary-mail-forward)
3881 (define-key gnus-summary-send-map "m" 'gnus-summary-mail-other-window)
3882 (define-key gnus-summary-send-map "u" 'gnus-uu-post-news)
3883 (define-key gnus-summary-send-map "\M-f" 'gnus-uu-digest-and-forward)
3886 (define-prefix-command 'gnus-summary-goto-map)
3887 (define-key gnus-summary-mode-map "G" 'gnus-summary-goto-map)
3888 (define-key gnus-summary-goto-map "n" 'gnus-summary-next-unread-article)
3889 (define-key gnus-summary-goto-map "p" 'gnus-summary-prev-unread-article)
3890 (define-key gnus-summary-goto-map "N" 'gnus-summary-next-article)
3891 (define-key gnus-summary-goto-map "P" 'gnus-summary-prev-article)
3892 (define-key gnus-summary-goto-map "\C-n" 'gnus-summary-next-same-subject)
3893 (define-key gnus-summary-goto-map "\C-p" 'gnus-summary-prev-same-subject)
3894 (define-key gnus-summary-goto-map "\M-n" 'gnus-summary-next-unread-subject)
3895 (define-key gnus-summary-goto-map "\M-p" 'gnus-summary-prev-unread-subject)
3896 (define-key gnus-summary-goto-map "f" 'gnus-summary-first-unread-article)
3897 (define-key gnus-summary-goto-map "b" 'gnus-summary-best-unread-article)
3898 (define-key gnus-summary-goto-map "g" 'gnus-summary-goto-subject)
3899 (define-key gnus-summary-goto-map "l" 'gnus-summary-goto-last-article)
3902 (define-prefix-command 'gnus-summary-thread-map)
3903 (define-key gnus-summary-mode-map "T" 'gnus-summary-thread-map)
3904 (define-key gnus-summary-thread-map "k" 'gnus-summary-kill-thread)
3905 (define-key gnus-summary-thread-map "l" 'gnus-summary-lower-thread)
3906 (define-key gnus-summary-thread-map "r" 'gnus-summary-raise-thread)
3907 (define-key gnus-summary-thread-map "T" 'gnus-summary-toggle-threads)
3908 (define-key gnus-summary-thread-map "s" 'gnus-summary-show-thread)
3909 (define-key gnus-summary-thread-map "h" 'gnus-summary-hide-thread)
3910 (define-key gnus-summary-thread-map "n" 'gnus-summary-next-thread)
3911 (define-key gnus-summary-thread-map "p" 'gnus-summary-prev-thread)
3912 (define-key gnus-summary-thread-map "u" 'gnus-summary-up-thread)
3913 (define-key gnus-summary-thread-map "d" 'gnus-summary-down-thread)
3914 (define-key gnus-summary-thread-map "#" 'gnus-uu-mark-thread)
3917 (define-prefix-command 'gnus-summary-exit-map)
3918 (define-key gnus-summary-mode-map "E" 'gnus-summary-exit-map)
3919 (define-key gnus-summary-exit-map "c" 'gnus-summary-catchup-and-exit)
3920 (define-key gnus-summary-exit-map "\C-c" 'gnus-summary-catchup-all-and-exit)
3921 (define-key gnus-summary-exit-map "q" 'gnus-summary-exit)
3922 (define-key gnus-summary-exit-map "e" 'gnus-summary-exit)
3923 (define-key gnus-summary-exit-map "Q" 'gnus-summary-quit)
3924 (define-key gnus-summary-exit-map "E" 'gnus-summary-quit)
3927 (define-prefix-command 'gnus-summary-article-map)
3928 (define-key gnus-summary-mode-map "A" 'gnus-summary-article-map)
3929 (define-key gnus-summary-article-map " " 'gnus-summary-next-page)
3930 (define-key gnus-summary-article-map "n" 'gnus-summary-next-page)
3931 (define-key gnus-summary-article-map "\177" 'gnus-summary-prev-page)
3932 (define-key gnus-summary-article-map "p" 'gnus-summary-prev-page)
3933 (define-key gnus-summary-article-map "\r" 'gnus-summary-scroll-up)
3934 (define-key gnus-summary-article-map "<" 'gnus-summary-beginning-of-article)
3935 (define-key gnus-summary-article-map ">" 'gnus-summary-end-of-article)
3936 (define-key gnus-summary-article-map "b" 'gnus-summary-beginning-of-article)
3937 (define-key gnus-summary-article-map "e" 'gnus-summary-end-of-article)
3938 (define-key gnus-summary-article-map "^" 'gnus-summary-refer-parent-article)
3939 (define-key gnus-summary-article-map "r" 'gnus-summary-refer-parent-article)
3940 (define-key gnus-summary-article-map "w" 'gnus-summary-stop-page-breaking)
3941 (define-key gnus-summary-article-map "c" 'gnus-summary-caesar-message)
3942 (define-key gnus-summary-article-map "g" 'gnus-summary-show-article)
3943 (define-key gnus-summary-article-map "t" 'gnus-summary-toggle-header)
3944 (define-key gnus-summary-article-map "m" 'gnus-summary-toggle-mime)
3945 (define-key gnus-summary-article-map "s" 'gnus-summary-isearch-article)
3948 (define-prefix-command 'gnus-summary-extract-map)
3949 (define-key gnus-summary-mode-map "X" 'gnus-summary-extract-map)
3950 ; (define-key gnus-summary-extract-map "x" 'gnus-summary-extract-any)
3951 ; (define-key gnus-summary-extract-map "m" 'gnus-summary-extract-mime)
3952 ; (define-key gnus-summary-extract-map "d" 'gnus-summary-extract-digest)
3954 (define-key gnus-summary-extract-map "u" 'gnus-uu-decode-uu)
3955 (define-key gnus-summary-extract-map "U" 'gnus-uu-decode-uu-and-save)
3956 (define-key gnus-summary-extract-map "s" 'gnus-uu-decode-unshar)
3957 (define-key gnus-summary-extract-map "S" 'gnus-uu-decode-unshar-and-save)
3958 (define-key gnus-summary-extract-map "o" 'gnus-uu-decode-save)
3959 (define-key gnus-summary-extract-map "O" 'gnus-uu-decode-save)
3960 (define-key gnus-summary-extract-map "b" 'gnus-uu-decode-binhex)
3961 (define-key gnus-summary-extract-map "B" 'gnus-uu-decode-binhex)
3964 (define-prefix-command 'gnus-summary-various-map)
3965 (define-key gnus-summary-mode-map "V" 'gnus-summary-various-map)
3966 (define-key gnus-summary-various-map "u" 'gnus-summary-universal-argument)
3967 (define-key gnus-summary-various-map "\M-s" 'gnus-summary-search-article-forward)
3968 (define-key gnus-summary-various-map "\M-r" 'gnus-summary-search-article-backward)
3969 (define-key gnus-summary-various-map "r" 'gnus-summary-refer-article)
3970 (define-key gnus-summary-various-map "&" 'gnus-summary-execute-command)
3971 (define-key gnus-summary-various-map "\C-t" 'gnus-summary-toggle-truncation)
3972 (define-key gnus-summary-various-map "=" 'gnus-summary-expand-window)
3973 (define-key gnus-summary-various-map "\C-s" 'gnus-summary-reselect-current-group)
3974 (define-key gnus-summary-various-map "g" 'gnus-summary-rescan-group)
3975 (define-key gnus-summary-various-map "o" 'gnus-summary-save-article)
3976 (define-key gnus-summary-various-map "\C-o" 'gnus-summary-save-article-mail)
3977 (define-key gnus-summary-various-map "|" 'gnus-summary-pipe-output)
3978 (define-key gnus-summary-various-map "V" 'gnus-version)
3979 (define-key gnus-summary-various-map "d" 'gnus-summary-describe-group)
3980 (define-key gnus-summary-various-map "?" 'gnus-summary-describe-briefly)
3981 (define-key gnus-summary-various-map "i" 'gnus-info-find-node)
3982 (define-key gnus-summary-various-map "S" 'gnus-summary-set-score)
3983 (define-key gnus-summary-various-map "b" 'gnus-summary-set-mark-below)
3985 (define-prefix-command 'gnus-summary-sort-map)
3986 (define-key gnus-summary-various-map "s" 'gnus-summary-sort-map)
3987 (define-key gnus-summary-sort-map "n" 'gnus-summary-sort-by-number)
3988 (define-key gnus-summary-sort-map "a" 'gnus-summary-sort-by-author)
3989 (define-key gnus-summary-sort-map "s" 'gnus-summary-sort-by-subject)
3990 (define-key gnus-summary-sort-map "d" 'gnus-summary-sort-by-date)
3991 (define-key gnus-summary-sort-map "i" 'gnus-summary-sort-by-score)
3993 (define-prefix-command 'gnus-summary-mgroup-map)
3994 (define-key gnus-summary-various-map "m" 'gnus-summary-mgroup-map)
3995 (define-key gnus-summary-mgroup-map "e" 'gnus-summary-expire-articles)
3996 (define-key gnus-summary-mgroup-map "\177" 'gnus-summary-delete-article)
3997 (define-key gnus-summary-mgroup-map "m" 'gnus-summary-move-article)
3998 (define-key gnus-summary-mgroup-map "r" 'gnus-summary-respool-article)
4000 (define-prefix-command 'gnus-summary-vkill-map)
4001 (define-key gnus-summary-various-map "k" 'gnus-summary-vkill-map)
4002 (define-key gnus-summary-vkill-map "k" 'gnus-summary-kill-same-subject-and-select)
4003 (define-key gnus-summary-vkill-map "K" 'gnus-summary-kill-same-subject)
4004 (define-key gnus-summary-vkill-map "\M-k" 'gnus-summary-edit-local-kill)
4005 (define-key gnus-summary-vkill-map "\M-K" 'gnus-summary-edit-global-kill)
4006 (define-key gnus-summary-vkill-map "x" 'gnus-kill-file-set-expunge-below)
4007 (define-key gnus-summary-vkill-map "m" 'gnus-kill-file-set-mark-below)
4011 (define-prefix-command 'gnus-summary-increase-map)
4012 (define-key gnus-summary-mode-map "I" 'gnus-summary-increase-map)
4013 (define-key gnus-summary-increase-map "i" 'gnus-summary-raise-same-subject-and-select)
4014 (define-key gnus-summary-increase-map "I" 'gnus-summary-raise-same-subject)
4015 (define-key gnus-summary-increase-map "\C-i" 'gnus-summary-raise-score)
4017 (define-prefix-command 'gnus-summary-inc-subject-map)
4018 (define-key gnus-summary-increase-map "s" 'gnus-summary-inc-subject-map)
4019 (define-key gnus-summary-increase-map "S" 'gnus-summary-temporarily-raise-by-subject)
4020 (define-key gnus-summary-inc-subject-map "s" 'gnus-summary-temporarily-raise-by-subject)
4021 (define-key gnus-summary-inc-subject-map "S" 'gnus-summary-raise-by-subject)
4022 (define-key gnus-summary-inc-subject-map "t" 'gnus-summary-temporarily-raise-by-subject)
4023 (define-key gnus-summary-inc-subject-map "p" 'gnus-summary-raise-by-subject)
4025 (define-prefix-command 'gnus-summary-inc-author-map)
4026 (define-key gnus-summary-increase-map "a" 'gnus-summary-inc-author-map)
4027 (define-key gnus-summary-increase-map "A" 'gnus-summary-temporarily-raise-by-author)
4028 (define-key gnus-summary-inc-author-map "a" 'gnus-summary-temporarily-raise-by-author)
4029 (define-key gnus-summary-inc-author-map "A" 'gnus-summary-raise-by-author)
4030 (define-key gnus-summary-inc-author-map "t" 'gnus-summary-temporarily-raise-by-author)
4031 (define-key gnus-summary-inc-author-map "p" 'gnus-summary-raise-by-author)
4033 (define-prefix-command 'gnus-summary-inc-thread-map)
4034 (define-key gnus-summary-increase-map "t" 'gnus-summary-inc-thread-map)
4035 (define-key gnus-summary-increase-map "T" 'gnus-summary-temporarily-raise-by-thread)
4036 (define-key gnus-summary-inc-thread-map "t" 'gnus-summary-temporarily-raise-by-thread)
4037 (define-key gnus-summary-inc-thread-map "T" 'gnus-summary-raise-by-thread)
4038 (define-key gnus-summary-inc-thread-map "t" 'gnus-summary-temporarily-raise-by-thread)
4039 (define-key gnus-summary-inc-thread-map "p" 'gnus-summary-raise-by-thread)
4041 (define-prefix-command 'gnus-summary-inc-xref-map)
4042 (define-key gnus-summary-increase-map "x" 'gnus-summary-inc-xref-map)
4043 (define-key gnus-summary-increase-map "X" 'gnus-summary-temporarily-raise-by-xref)
4044 (define-key gnus-summary-inc-xref-map "x" 'gnus-summary-temporarily-raise-by-xref)
4045 (define-key gnus-summary-inc-xref-map "X" 'gnus-summary-raise-by-xref)
4046 (define-key gnus-summary-inc-xref-map "t" 'gnus-summary-temporarily-raise-by-xref)
4047 (define-key gnus-summary-inc-xref-map "p" 'gnus-summary-raise-by-xref)
4049 (define-prefix-command 'gnus-summary-inc-fol-map)
4050 (define-key gnus-summary-increase-map "f" 'gnus-summary-inc-fol-map)
4051 (define-key gnus-summary-increase-map "F" 'gnus-summary-temporarily-raise-followups-to-author)
4052 (define-key gnus-summary-inc-fol-map "f" 'gnus-summary-temporarily-raise-followups-to-author)
4053 (define-key gnus-summary-inc-fol-map "F" 'gnus-summary-raise-followups-to-author)
4054 (define-key gnus-summary-inc-fol-map "t" 'gnus-summary-temporarily-raise-followups-to-author)
4055 (define-key gnus-summary-inc-fol-map "p" 'gnus-summary-raise-followups-to-author)
4057 (define-prefix-command 'gnus-summary-lower-map)
4058 (define-key gnus-summary-mode-map "L" 'gnus-summary-lower-map)
4059 (define-key gnus-summary-lower-map "l" 'gnus-summary-lower-same-subject-and-select)
4060 (define-key gnus-summary-lower-map "L" 'gnus-summary-lower-same-subject)
4061 (define-key gnus-summary-lower-map "\C-l" 'gnus-summary-lower-score)
4063 (define-prefix-command 'gnus-summary-low-subject-map)
4064 (define-key gnus-summary-lower-map "s" 'gnus-summary-low-subject-map)
4065 (define-key gnus-summary-lower-map "S" 'gnus-summary-temporarily-lower-by-subject)
4066 (define-key gnus-summary-low-subject-map "s" 'gnus-summary-temporarily-lower-by-subject)
4067 (define-key gnus-summary-low-subject-map "S" 'gnus-summary-lower-by-subject)
4068 (define-key gnus-summary-low-subject-map "t" 'gnus-summary-temporarily-lower-by-subject)
4069 (define-key gnus-summary-low-subject-map "p" 'gnus-summary-lower-by-subject)
4071 (define-prefix-command 'gnus-summary-low-author-map)
4072 (define-key gnus-summary-lower-map "a" 'gnus-summary-low-author-map)
4073 (define-key gnus-summary-lower-map "A" 'gnus-summary-temporarily-lower-by-author)
4074 (define-key gnus-summary-low-author-map "a" 'gnus-summary-temporarily-lower-by-author)
4075 (define-key gnus-summary-low-author-map "A" 'gnus-summary-lower-by-author)
4076 (define-key gnus-summary-low-author-map "t" 'gnus-summary-temporarily-lower-by-author)
4077 (define-key gnus-summary-low-author-map "p" 'gnus-summary-lower-by-author)
4079 (define-prefix-command 'gnus-summary-low-thread-map)
4080 (define-key gnus-summary-lower-map "t" 'gnus-summary-low-thread-map)
4081 (define-key gnus-summary-lower-map "T" 'gnus-summary-temporarily-lower-by-thread)
4082 (define-key gnus-summary-low-thread-map "t" 'gnus-summary-temporarily-lower-by-thread)
4083 (define-key gnus-summary-low-thread-map "T" 'gnus-summary-lower-by-thread)
4084 (define-key gnus-summary-low-thread-map "t" 'gnus-summary-temporarily-lower-by-thread)
4085 (define-key gnus-summary-low-thread-map "p" 'gnus-summary-lower-by-thread)
4087 (define-prefix-command 'gnus-summary-low-xref-map)
4088 (define-key gnus-summary-lower-map "x" 'gnus-summary-low-xref-map)
4089 (define-key gnus-summary-lower-map "X" 'gnus-summary-temporarily-lower-by-xref)
4090 (define-key gnus-summary-low-xref-map "x" 'gnus-summary-temporarily-lower-by-xref)
4091 (define-key gnus-summary-low-xref-map "X" 'gnus-summary-lower-by-xref)
4092 (define-key gnus-summary-low-xref-map "t" 'gnus-summary-temporarily-lower-by-xref)
4093 (define-key gnus-summary-low-xref-map "p" 'gnus-summary-lower-by-xref)
4095 (define-prefix-command 'gnus-summary-low-fol-map)
4096 (define-key gnus-summary-lower-map "f" 'gnus-summary-low-fol-map)
4097 (define-key gnus-summary-lower-map "F" 'gnus-summary-temporarily-lower-followups-to-author)
4098 (define-key gnus-summary-low-fol-map "f" 'gnus-summary-temporarily-lower-followups-to-author)
4099 (define-key gnus-summary-low-fol-map "F" 'gnus-summary-lower-followups-to-author)
4100 (define-key gnus-summary-low-fol-map "t" 'gnus-summary-temporarily-lower-followups-to-author)
4101 (define-key gnus-summary-low-fol-map "p" 'gnus-summary-lower-followups-to-author)
4103 (if gnus-visual (gnus-summary-make-menu-bar)))
4108 (defun gnus-summary-mode ()
4109 "Major mode for reading articles in this newsgroup.
4110 All normal editing commands are switched off.
4111 The following commands are available:
4113 \\<gnus-summary-mode-map>
4114 \\[gnus-summary-next-page]\t Scroll the article buffer a page forwards
4115 \\[gnus-summary-prev-page]\t Scroll the article buffer a page backwards
4116 \\[gnus-summary-scroll-up]\t Scroll the article buffer one line forwards
4117 \\[gnus-summary-next-unread-article]\t Go to the next unread article
4118 \\[gnus-summary-prev-unread-article]\t Go to the previous unread article
4119 \\[gnus-summary-next-article]\t Go to the next article
4120 \\[gnus-summary-prev-article]\t Go to the previous article
4121 \\[gnus-summary-next-same-subject]\t Go to the next summary line with the same subject
4122 \\[gnus-summary-prev-same-subject]\t Go to the previous summary line with the same subject
4123 \\[gnus-summary-next-digest]\t Go to the next digest
4124 \\[gnus-summary-prev-digest]\t Go to the previous digest
4125 \\[gnus-summary-next-subject]\t Go to the next summary line
4126 \\[gnus-summary-prev-subject]\t Go to the previous summary line
4127 \\[gnus-summary-next-unread-subject]\t Go to the next unread summary line
4128 \\[gnus-summary-prev-unread-subject]\t Go to the previous unread summary line
4129 \\[gnus-summary-first-unread-article]\t Go to the first unread article
4130 \\[gnus-summary-best-unread-article]\t Go to the unread article with the highest score
4131 \\[gnus-summary-goto-subject]\t Go to some subject
4132 \\[gnus-summary-goto-last-article]\t Go to the previous article
4134 \\[gnus-summary-beginning-of-article]\t Go to the beginning of the article
4135 \\[gnus-summary-end-of-article]\t Go to the end of the article
4137 \\[gnus-summary-refer-parent-article]\t Get the parent of the current article from the server
4138 \\[gnus-summary-refer-article]\t Request some article by Message-ID from the server
4140 \\[gnus-summary-isearch-article]\t Do an interactive search on the current article
4141 \\[gnus-summary-search-article-forward]\t Search all articles forward for a regular expression
4142 \\[gnus-summary-search-article-backward]\t Search all articles backward for a regular expression
4144 \\[gnus-summary-tick-article-forward]\t Tick current article and move forward
4145 \\[gnus-summary-tick-article-backward]\t Tick current article and move backward
4146 \\[gnus-summary-mark-as-read-forward]\t Mark the current article as read and move forward
4147 \\[gnus-summary-mark-as-read-backward]\t Mark the current article as read and move backward
4148 \\[gnus-summary-clear-mark-forward]\t Clear tick and read marks and move forward
4149 \\[gnus-summary-clear-mark-backward]\t Clear tick and read marks and move backward
4150 \\[gnus-summary-mark-as-processable]\t Set the process mark on the current article
4151 \\[gnus-summary-unmark-as-processable]\t Remove the process mark from the current article
4152 \\[gnus-summary-unmark-all-processable]\t Remove the process mark from all articles
4154 \\[gnus-summary-raise-same-subject-and-select]\t Raise all articles with the current subject and select the next article
4155 \\[gnus-summary-raise-same-subject]\t Raise all articles with the current subject
4156 \\[gnus-summary-lower-same-subject-and-select]\t Lower all articles with the current subject and select the next article
4157 \\[gnus-summary-lower-same-subject]\t Lower all articles with the current subject
4159 \\[gnus-summary-toggle-threads]\t Toggle thread display
4160 \\[gnus-summary-show-thread]\t Show the current thread
4161 \\[gnus-summary-hide-thread]\t Hide the current thread
4162 \\[gnus-summary-next-thread]\t Go to the next thread
4163 \\[gnus-summary-prev-thread]\t Go to the previous thread
4164 \\[gnus-summary-up-thread]\t Go up the current thread
4165 \\[gnus-summary-down-thread]\t Descend the current thread
4166 \\[gnus-summary-raise-thread]\t Raise the current thread
4167 \\[gnus-summary-lower-thread]\t Lower the current thread
4168 \\[gnus-summary-mark-as-expirable]\t Mark the current artivles as expirable
4169 \\[gnus-summary-remove-lines-marked-as-read]\t Remove all articles that are marked as read
4170 \\[gnus-summary-remove-lines-marked-with]\t Remove all articles that have some mark
4172 \\[gnus-summary-execute-command]\t Execute a command
4173 \\[gnus-summary-catchup-and-exit]\t Mark all unread articles as read and exit
4174 \\[gnus-summary-toggle-truncation]\t Toggle truncation of summary lines
4175 \\[gnus-summary-expand-window]\t Expand the summary window
4176 \\[gnus-summary-universal-argument]\t Run a command on all articles with the process mark
4178 \\[gnus-summary-sort-by-number]\t Sort the summary buffer by article number
4179 \\[gnus-summary-sort-by-author]\t Sort the summary buffer by author
4180 \\[gnus-summary-sort-by-subject]\t Sort the summary buffer by subject
4181 \\[gnus-summary-sort-by-date]\t Sort the summary buffer by date
4183 \\[gnus-summary-reselect-current-group]\t Exit and reselect the current group
4184 \\[gnus-summary-rescan-group]\t Exit, get new articles and reselect the group
4185 \\[gnus-summary-stop-page-breaking]\t Stop page breaking of the current article
4186 \\[gnus-summary-caesar-message]\t Caesar rotate (rot13) the current article
4187 \\[gnus-summary-show-article]\t Reselect the current article
4188 \\[gnus-summary-toggle-header]\t Toggle header display
4189 \\[gnus-summary-toggle-mime]\t Toggle whether to use MIME
4190 \\[gnus-summary-rmail-digest]\t Use rmail digest
4191 \\[gnus-summary-post-news]\t Post an article to the current group
4192 \\[gnus-summary-followup]\t Post a followup to the current article
4193 \\[gnus-summary-followup-with-original]\t Post a followup and include the original article
4194 \\[gnus-summary-cancel-article]\t Cancel the current article
4195 \\[gnus-summary-supersede-article]\t Supersede the current article
4196 \\[gnus-summary-reply]\t Mail a reply to the author of the current article
4197 \\[gnus-summary-reply-with-original]\t Mail a reply and include the current article
4198 \\[gnus-summary-mail-forward]\t Forward the current article
4199 \\[gnus-summary-mail-other-window]\t Mail in the other window
4200 \\[gnus-summary-save-article]\t Save the current article
4201 \\[gnus-summary-save-article-mail]\t Save the current article in rmail format
4202 \\[gnus-summary-pipe-output]\t Pipe the current article to a process
4203 \\[gnus-summary-move-article]\t Move the article to a different newsgroup
4204 \\[gnus-summary-respool-article]\t Respool the article
4205 \\[gnus-summary-edit-local-kill]\t Edit the local kill file
4206 \\[gnus-summary-edit-global-kill]\t Edit the global kill file
4207 \\[gnus-version]\t Display the current Gnus version
4208 \\[gnus-summary-exit]\t Exit the summary buffer
4209 \\[gnus-summary-quit]\t Exit the summary buffer without saving any changes
4210 \\[gnus-summary-describe-group]\t Describe the current newsgroup
4211 \\[gnus-summary-describe-briefly]\t Give a brief key overview
4212 \\[gnus-info-find-node]\t Go to the Gnus info node
4214 \\[gnus-kill-file-set-expunge-below] Automatically expunge articles below LEVEL.
4216 \\[gnus-kill-file-set-mark-below] Automatically mark articles below LEVEL.
4217 \\[gnus-summary-temporarily-raise-by-subject]\t Temporarily raise score for articles with the current subject
4218 \\[gnus-summary-temporarily-raise-by-author]\t Temporarily raise score for articles from the current author
4219 \\[gnus-summary-temporarily-raise-by-xref]\t Temporarily raise score for articles with the current cross-posting
4220 \\[gnus-summary-raise-by-subject]\t Permanently raise score for articles with the current subject
4221 \\[gnus-summary-raise-by-author]\t Permanently raise score for articles from the current author
4222 \\[gnus-summary-raise-followups-to-author]\t Permanently raise score for followups to the current author
4223 \\[gnus-summary-raise-by-xref]\t Permanently raise score for articles with the current cross-posting
4224 \\[gnus-summary-temporarily-lower-by-subject]\t Temporarily lower score for articles with the current subject
4225 \\[gnus-summary-temporarily-lower-by-author]\t Temporarily lower score for articles from the current author
4226 \\[gnus-summary-temporarily-lower-by-xref]\t Temporarily lower score for articles with the current cross-posting
4227 \\[gnus-summary-lower-by-subject]\t Permanently lower score for articles with the current subject
4228 \\[gnus-summary-lower-by-author]\t Permanently lower score for articles from the current author
4229 \\[gnus-summary-lower-followups-to-author]\t Permanently lower score for followups to the current author
4230 \\[gnus-summary-lower-by-thread]\t Permanently lower score for articles in the current thread
4231 \\[gnus-summary-lower-by-xref]\t Permanently lower score for articles with the current cross-posting
4234 (kill-all-local-variables)
4235 (let ((locals gnus-summary-local-variables))
4237 (if (consp (car locals))
4239 (make-local-variable (car (car locals)))
4240 (set (car (car locals)) (eval (cdr (car locals)))))
4241 (make-local-variable (car locals))
4242 (set (car locals) nil))
4243 (setq locals (cdr locals))))
4244 (gnus-update-format-specifications)
4245 (setq mode-line-modified "-- ")
4246 (make-local-variable 'mode-line-format)
4247 (setq mode-line-format (copy-sequence mode-line-format))
4248 (and (equal (nth 3 mode-line-format) " ")
4249 (setcar (nthcdr 3 mode-line-format) ""))
4250 (setq major-mode 'gnus-summary-mode)
4251 (setq mode-name "Summary")
4252 (make-local-variable 'minor-mode-alist)
4253 ; (or (assq 'gnus-show-threads minor-mode-alist)
4254 ; (setq minor-mode-alist
4255 ; (cons (list 'gnus-show-threads " Thread") minor-mode-alist)))
4256 (gnus-set-mode-line 'summary)
4257 (use-local-map gnus-summary-mode-map)
4258 (buffer-disable-undo (current-buffer))
4259 (setq buffer-read-only t) ;Disable modification
4260 (setq truncate-lines t)
4261 (setq selective-display t)
4262 (setq selective-display-ellipses t) ;Display `...'
4263 (run-hooks 'gnus-summary-mode-hook))
4265 (defun gnus-mouse-pick-article (e)
4268 (gnus-summary-next-page nil t))
4270 (defun gnus-summary-setup-buffer (group)
4271 "Initialize summary buffer."
4272 (let ((buffer (concat "*Summary " group "*")))
4273 ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
4274 (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer)))
4275 (gnus-add-current-to-buffer-list)
4276 (gnus-summary-mode)))
4278 (defun gnus-set-global-variables ()
4279 ;; Set the global equivalents of the summary buffer-local variables
4280 ;; to the latest values they had. These reflect the summary buffer
4281 ;; that was in action when the last article was fetched.
4282 (let ((name gnus-newsgroup-name)
4283 (marked gnus-newsgroup-marked)
4284 (unread gnus-newsgroup-unreads)
4285 (headers gnus-current-headers))
4287 (set-buffer gnus-group-buffer)
4288 (setq gnus-newsgroup-name name)
4289 (setq gnus-newsgroup-marked marked)
4290 (setq gnus-newsgroup-unreads unread)
4291 (setq gnus-current-headers headers))))
4293 (defun gnus-summary-insert-dummy-line (sformat subject number)
4295 (setq sformat gnus-summary-dummy-line-format-spec))
4299 (insert (eval sformat))
4300 (add-text-properties
4302 (list 'gnus-subject (gnus-simplify-subject-re subject)
4307 (defun gnus-summary-insert-line
4308 (sformat header level current unread replied expirable subject-or-nil
4309 &optional dummy score)
4311 (setq sformat gnus-summary-line-format-spec))
4313 (make-string (* level gnus-thread-indent-level) ? ))
4314 (lines (or (header-lines header) 0))
4315 (score (or score gnus-summary-default-score 0))
4316 (score-char (if (= score gnus-summary-default-score) ?
4317 (if (< score gnus-summary-default-score) ?- ?+)))
4318 (replied (if replied gnus-replied-mark ? ))
4319 (from (header-from header))
4320 (name-address (gnus-extract-address-components from))
4321 (address (car (cdr name-address)))
4322 (name (or (car name-address) (car (cdr name-address))))
4323 (number (header-number header))
4324 (subject (header-subject header))
4325 (buffer-read-only nil)
4326 (opening-bracket (if dummy ?\< ?\[))
4327 (closing-bracket (if dummy ?\> ?\]))
4329 ;; Suggested by Brian Edmonds <bedmonds@prodigy.bc.ca>.
4330 (if (not (numberp lines)) (setq lines 0))
4333 (insert-before-markers (eval sformat))
4334 (add-text-properties
4336 (list 'gnus-subject (gnus-simplify-subject-re subject)
4339 'gnus-thread level))))
4341 (defun gnus-summary-update-line ()
4342 ;; Update summary line after change.
4343 (or (not gnus-summary-default-score)
4344 gnus-summary-inhibit-highlight
4346 (beginning-of-line 1)
4347 (let ((score (gnus-summary-article-score))
4348 (default gnus-summary-default-score)
4349 (below gnus-summary-mark-below))
4352 (if (eq (following-char) gnus-unread-mark)
4353 (gnus-summary-mark-article nil gnus-low-score-mark))
4354 (if (eq (following-char) gnus-low-score-mark)
4355 (gnus-summary-mark-article nil gnus-unread-mark))))
4357 (run-hooks 'gnus-visual-summary-update-hook))))))
4359 (defun gnus-summary-update-lines ()
4360 ;; Rehighlight summary buffer according to `gnus-summary-highlight'.
4361 (if (and gnus-visual gnus-visual-summary-update-hook)
4363 (set-buffer gnus-summary-buffer)
4364 (goto-char (point-min))
4366 (gnus-summary-update-line)
4367 (forward-line 1)))))
4369 (defun gnus-summary-read-group (group &optional show-all no-article kill-buffer)
4370 "Start reading news in newsgroup GROUP.
4371 If SHOW-ALL is non-nil, already read articles are also listed.
4372 If NO-ARTICLE is non-nil, no article is selected initially."
4373 (message "Retrieving newsgroup: %s..." group)
4374 (gnus-summary-setup-buffer group)
4375 (if (gnus-select-newsgroup group show-all)
4377 ;; You can change the subjects in this hook.
4378 (run-hooks 'gnus-select-group-hook)
4379 ;; Do Score Processing.
4380 (gnus-score-headers)
4381 ;; Update the format specifiers.
4382 (gnus-update-format-specifications)
4383 (gnus-summary-prepare)
4384 (if (and (zerop (buffer-size))
4385 gnus-newsgroup-dormant)
4386 (gnus-summary-show-all-dormant))
4387 (gnus-set-global-variables)
4388 ;; Function `gnus-apply-kill-file' must be called in this hook.
4389 (run-hooks 'gnus-apply-kill-hook)
4390 (if (zerop (buffer-size))
4392 ;; This newsgroup is empty.
4393 (gnus-summary-catchup-and-exit nil t) ;Without confirmations.
4394 (message "No unread news"))
4395 ;; Hide conversation thread subtrees. We cannot do this in
4396 ;; gnus-summary-prepare-hook since kill processing may not
4397 ;; work with hidden articles.
4398 (and gnus-show-threads
4399 gnus-thread-hide-subtree
4400 (gnus-summary-hide-all-threads))
4401 ;; Show first unread article if requested.
4402 (goto-char (point-min))
4403 (if (and (not no-article)
4404 gnus-auto-select-first
4405 (gnus-summary-first-unread-article))
4406 ;; Window is configured automatically.
4407 ;; Current buffer may be changed as a result of hook
4408 ;; evaluation, especially by gnus-summary-rmail-digest
4409 ;; command, so we should adjust cursor point carefully.
4410 (if (eq major-mode 'gnus-summary-mode)
4411 (gnus-summary-position-cursor))
4412 (gnus-configure-windows 'summary)
4413 (pop-to-buffer gnus-summary-buffer)
4414 (gnus-set-mode-line 'summary)
4415 (gnus-summary-position-cursor))
4416 (if (and kill-buffer
4417 (get-buffer kill-buffer)
4418 (buffer-name (get-buffer kill-buffer)))
4419 (kill-buffer kill-buffer))))
4420 ;; Cannot select newsgroup GROUP.
4421 (message "Couldn't select newsgroup")
4422 (and (eq major-mode 'gnus-summary-mode)
4423 (kill-buffer (current-buffer)))
4424 (set-buffer gnus-group-buffer)
4425 (gnus-summary-position-cursor)))
4427 (defun gnus-summary-prepare ()
4428 "Prepare summary list of current newsgroup in summary buffer."
4429 (let ((buffer-read-only nil))
4431 (gnus-summary-prepare-threads
4432 (if gnus-show-threads
4433 (gnus-gather-threads (gnus-sort-threads (gnus-make-threads)))
4434 gnus-newsgroup-headers)
4436 (gnus-summary-remove-dormant-lines)
4437 ;; Erase header retrieval message.
4439 ;; Call hooks for modifying summary buffer.
4440 ;; Suggested by sven@tde.LTH.Se (Sven Mattisson).
4441 (goto-char (point-min))
4442 (run-hooks 'gnus-summary-prepare-hook)))
4444 (defun gnus-summary-remove-dormant-lines ()
4445 (let ((int gnus-newsgroup-dormant)
4446 (buffer-read-only nil)
4449 (if (gnus-summary-goto-subject (car int))
4452 (setq cur-level (gnus-summary-thread-level))
4454 (re-search-forward "[\n\r]")
4455 (if (<= (gnus-summary-thread-level) cur-level)
4456 ;; If the level of the next article is greater than the
4457 ;; level of this article, then it has to be the child of this
4458 ;; article, so we do not delete this article.
4460 (setq gnus-newsgroup-dormant-subjects
4461 (cons (cons (car int) (buffer-substring beg (point)))
4462 gnus-newsgroup-dormant-subjects))
4463 (delete-region beg (point))))))
4464 (setq int (cdr int)))))
4466 (defun gnus-gather-threads (threads)
4467 "Gather threads that have lost their roots."
4468 (if (not gnus-summary-make-false-root)
4470 (let ((hashtb (gnus-make-hashtable 1023))
4473 thread subject hthread unre-subject)
4475 (setq subject (header-subject (car (car threads))))
4476 (and gnus-summary-gather-subject-limit
4477 (> (length subject) gnus-summary-gather-subject-limit)
4479 (substring subject 0 gnus-summary-gather-subject-limit)))
4482 (setq unre-subject (gnus-simplify-subject-re subject))
4485 (or (stringp (car (car hthread)))
4486 (setcar hthread (list subject (car hthread))))
4487 (setcdr (car hthread) (nconc (cdr (car hthread))
4488 (list (car threads))))
4489 (setcdr prev (cdr threads))
4490 (setq threads prev))
4491 (gnus-sethash unre-subject threads hashtb))
4493 (setq threads (cdr threads)))
4496 (defun gnus-make-threads ()
4497 ;; This function takes the dependencies already made by
4498 ;; `gnus-get-newsgroup-headers' and builds the trees. First we go
4499 ;; through the dependecies in the hash table and finds all the
4500 ;; roots. Roots do not refer back to any valid articles.
4502 (and gnus-fetch-old-headers (eq gnus-headers-retrieved-by 'nov)
4503 (gnus-build-old-threads))
4506 (if (not (car (symbol-value refs)))
4507 (setq roots (append (cdr (symbol-value refs)) roots))
4508 ;; Ok, these refer back to valid articles, but if
4509 ;; `gnus-thread-ignore-subject' is nil, we have to check that
4510 ;; the root has the same subject as its children. The children
4511 ;; that do not are made into roots and removed from the list
4513 (or gnus-thread-ignore-subject
4514 (let* ((prev (symbol-value refs))
4515 (subject (gnus-simplify-subject-re
4516 (header-subject (car prev))))
4517 (headers (cdr prev)))
4519 (if (not (string= subject
4520 (gnus-simplify-subject-re
4521 (header-subject (car headers)))))
4523 (setq roots (cons (car headers) roots))
4524 (setcdr prev (cdr headers)))
4525 (setq prev headers))
4526 (setq headers (cdr headers)))))))
4527 gnus-newsgroup-dependencies)
4529 (mapcar (lambda (root) (gnus-trim-thread (gnus-make-sub-thread root)))
4532 (defun gnus-trim-thread (thread)
4533 (if (and (eq gnus-fetch-old-headers 'some)
4534 (memq (header-number (car thread)) gnus-newsgroup-ancient)
4535 (= (length thread) 2))
4536 (gnus-trim-thread (nth 1 thread))
4539 (defun gnus-make-sub-thread (root)
4540 ;; This function makes a sub-tree for a node in the tree.
4541 (let ((children (reverse (cdr (gnus-gethash (downcase (header-id root))
4542 gnus-newsgroup-dependencies)))))
4543 (cons root (mapcar 'gnus-make-sub-thread children))))
4545 (defun gnus-build-old-threads ()
4546 ;; Look at all the articles that refer back to old articles, and
4547 ;; fetch the headers for the articles that aren't there. This will
4548 ;; build complete threads - if the roots haven't been expired by the
4553 (if (not (car (symbol-value refs)))
4555 (setq heads (cdr (symbol-value refs)))
4557 (if (not (memq (header-number (car heads))
4558 gnus-newsgroup-dormant))
4560 (setq id (symbol-name refs))
4561 (while (and (setq id (gnus-build-get-header id))
4562 (not (car (gnus-gethash
4563 id gnus-newsgroup-dependencies)))))
4565 (setq heads (cdr heads)))))))
4566 gnus-newsgroup-dependencies)))
4568 (defun gnus-build-get-header (id)
4569 ;; Look through the buffer of NOV lines and find the header to
4570 ;; ID. Enter this line into the dependencies hash table, and return
4571 ;; the id of the parent article (if any).
4572 (let ((deps gnus-newsgroup-dependencies)
4576 (set-buffer nntp-server-buffer)
4577 (goto-char (point-min))
4578 (while (and (not found) (search-forward id nil t))
4580 (setq found (looking-at (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s"
4581 (regexp-quote id))))
4582 (or found (beginning-of-line 2)))
4587 (setq header (gnus-nov-parse-line
4588 (read (current-buffer)) deps))
4589 (setq ref (header-references header))
4590 (string-match "\\(<[^>]+>\\) *$" ref)
4591 (substring ref (match-beginning 1) (match-end 1))))))
4593 (setq gnus-newsgroup-headers (cons header gnus-newsgroup-headers)
4594 gnus-newsgroup-ancient (cons (header-number header)
4595 gnus-newsgroup-ancient))))))
4597 (defun gnus-sort-threads (threads)
4598 ;; Sort threads as specified in `gnus-thread-sort-functions'.
4599 (let ((fun gnus-thread-sort-functions))
4601 (setq threads (sort threads (car fun))
4605 (defun gnus-thread-header (thread)
4606 ;; Return header of first article in THREAD.
4608 (if (stringp (car thread))
4609 (car (car (cdr thread)))
4613 (defun gnus-thread-sort-by-number (h1 h2)
4614 "Sort threads by root article number."
4615 (let ((h1 (gnus-thread-header h1))
4616 (h2 (gnus-thread-header h2)))
4617 (< (header-number h1) (header-number h2))))
4619 (defun gnus-thread-sort-by-author (h1 h2)
4620 "Sort threads by root author."
4621 (let ((h1 (gnus-thread-header h1))
4622 (h2 (gnus-thread-header h2)))
4624 (let ((extract (gnus-extract-address-components (header-from h1))))
4625 (or (car extract) (cdr extract)))
4626 (let ((extract (gnus-extract-address-components (header-from h2))))
4627 (or (car extract) (cdr extract))))))
4629 (defun gnus-thread-sort-by-subject (h1 h2)
4630 "Sort threads by root subject."
4631 (let ((h1 (gnus-thread-header h1))
4632 (h2 (gnus-thread-header h2)))
4634 (downcase (gnus-simplify-subject (header-subject h1)))
4635 (downcase (gnus-simplify-subject (header-subject h2))))))
4637 (defun gnus-thread-sort-by-date (h1 h2)
4638 "Sort threads by root article date."
4639 (let ((h1 (gnus-thread-header h1))
4640 (h2 (gnus-thread-header h2)))
4642 (gnus-sortable-date (header-date h1))
4643 (gnus-sortable-date (header-date h2)))))
4645 (defun gnus-thread-sort-by-score (h1 h2)
4646 "Sort threads by root article score.
4647 Unscored articles will be counted as havin a score of zero."
4648 (let ((h1 (gnus-thread-header h1))
4649 (h2 (gnus-thread-header h2)))
4650 (let ((s1 (assq (header-number h1) gnus-newsgroup-scored))
4651 (s2 (assq (header-number h2) gnus-newsgroup-scored)))
4652 (> (or (cdr s1) gnus-summary-default-score 0)
4653 (or (cdr s2) gnus-summary-default-score 0)))))
4655 (defun gnus-thread-sort-by-total-score (h1 h2)
4656 "Sort threads by the sum of all scores in the thread.
4657 Unscored articles will be counted as havin a score of zero."
4658 (> (gnus-thread-total-score h1) (gnus-thread-total-score h2)))
4660 (defun gnus-thread-total-score (thread)
4661 ;; This function find the total score of THREAD.
4663 (if (stringp (car thread))
4664 (apply gnus-thread-score-function 0
4665 (mapcar 'gnus-thread-total-score-1 (cdr thread)))
4666 (gnus-thread-total-score-1 thread))
4667 (gnus-thread-total-score-1 (list thread))))
4669 (defun gnus-thread-total-score-1 (root)
4670 ;; This function find the total score of the thread below ROOT.
4671 (setq root (car root))
4672 (apply gnus-thread-score-function
4673 (or (cdr (assq (header-number root) gnus-newsgroup-scored))
4674 gnus-summary-default-score 0)
4675 (mapcar 'gnus-thread-total-score
4676 (cdr (gnus-gethash (downcase (header-id root))
4677 gnus-newsgroup-dependencies)))))
4679 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
4680 (defvar gnus-tmp-prev-subject "")
4681 (defvar gnus-tmp-prev-dormant nil)
4683 ;; Basic ideas by Paul Dworkin <paul@media-lab.media.mit.edu>.
4684 (defun gnus-summary-prepare-threads
4685 (threads level &optional not-child no-subject)
4686 "Prepare summary buffer from THREADS and indentation LEVEL.
4687 THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])'
4688 or a straight list of headers."
4689 (let (thread header number subject clevel)
4691 (setq thread (car threads)
4692 threads (cdr threads))
4693 ;; If `thread' is a cons, hierarchical threads are used. If not,
4694 ;; `thread' is the header.
4696 (setq header (car thread))
4697 (setq header thread))
4698 (if (stringp header)
4699 ;; The header is a dummy root.
4701 (cond ((eq gnus-summary-make-false-root 'adopt)
4702 ;; We let the first article adopt the rest.
4703 (gnus-summary-prepare-threads (list (car (cdr thread))) 0)
4704 (setq thread (cdr (cdr thread)))
4706 (gnus-summary-prepare-threads (list (car thread)) 1 t)
4707 (setq thread (cdr thread))))
4708 ((eq gnus-summary-make-false-root 'dummy)
4709 ;; We output a dummy root.
4710 (gnus-summary-insert-dummy-line
4711 nil header (header-number (car (car (cdr thread)))))
4713 ((eq gnus-summary-make-false-root 'empty)
4714 ;; We print the articles with empty subject fields.
4715 (gnus-summary-prepare-threads (list (car (cdr thread))) 0)
4716 (setq thread (cdr (cdr thread)))
4718 (gnus-summary-prepare-threads (list (car thread)) 0 nil
4719 (not gnus-tmp-prev-dormant))
4720 (setq thread (cdr thread))))
4722 ;; We do not make a root for the gathered
4723 ;; sub-threads at all.
4725 ;; Print the sub-threads.
4726 (and (consp thread) (cdr thread)
4727 (gnus-summary-prepare-threads (cdr thread) clevel)))
4728 ;; The header is a real article.
4729 (setq number (header-number header)
4730 subject (header-subject header)
4731 gnus-tmp-prev-dormant (memq number gnus-newsgroup-dormant))
4732 (gnus-summary-insert-line
4733 nil header level nil
4734 (cond ((memq number gnus-newsgroup-marked) gnus-ticked-mark)
4735 ((memq number gnus-newsgroup-dormant) gnus-dormant-mark)
4736 ((memq number gnus-newsgroup-unreads) gnus-unread-mark)
4737 ((memq number gnus-newsgroup-expirable) gnus-expirable-mark)
4738 (t gnus-ancient-mark))
4739 (memq number gnus-newsgroup-replied)
4740 (memq number gnus-newsgroup-expirable)
4741 (if no-subject gnus-summary-same-subject
4742 (if (or (zerop level)
4743 (and gnus-thread-ignore-subject
4745 (gnus-simplify-subject-re gnus-tmp-prev-subject)
4746 (gnus-simplify-subject-re subject)))))
4748 gnus-summary-same-subject))
4750 (cdr (assq number gnus-newsgroup-scored)))
4751 (setq gnus-tmp-prev-subject subject)
4752 ;; Recursively print subthreads.
4753 (and (consp thread) (cdr thread)
4754 (gnus-summary-prepare-threads (cdr thread) (1+ level)))))))
4756 (defun gnus-select-newsgroup (group &optional read-all)
4757 "Select newsgroup GROUP.
4758 If READ-ALL is non-nil, all articles in the group are selected."
4759 (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
4760 (info (nth 2 entry))
4761 articles header-marks)
4762 (and (eq (car entry) t)
4763 (or (gnus-activate-newsgroup (car info))
4764 (error "Couldn't request newsgroup %s" group)))
4765 (setq gnus-current-select-method (or (nth 4 info) gnus-select-method))
4766 (gnus-check-news-server (nth 4 info))
4767 (if (not (gnus-request-group group t))
4768 (error "Couldn't request newsgroup %s" group))
4770 ;; Initialize the buffer that holds lines that have been removed
4771 ;; from the summary buffer.
4772 (setq gnus-newsgroup-expunged-buffer
4773 (get-buffer-create (format " *gnus expunge %s*" group)))
4775 (set-buffer gnus-newsgroup-expunged-buffer)
4776 (buffer-disable-undo (current-buffer))
4778 (gnus-add-current-to-buffer-list))
4780 (setq gnus-newsgroup-name group)
4781 (setq gnus-newsgroup-unselected nil)
4782 (setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group))
4786 (gnus-adjust-marked-articles info)
4787 (setq gnus-newsgroup-marked (cdr (assq 'tick (nth 3 info))))
4788 (setq gnus-newsgroup-replied (cdr (assq 'reply (nth 3 info))))
4789 (setq gnus-newsgroup-expirable (cdr (assq 'expire (nth 3 info))))
4790 (setq gnus-newsgroup-killed (cdr (assq 'killed (nth 3 info))))
4791 (setq gnus-newsgroup-bookmarks (cdr (assq 'bookmark (nth 3 info))))
4792 (setq gnus-newsgroup-dormant (cdr (assq 'dormant (nth 3 info))))
4793 (setq gnus-newsgroup-scored (cdr (assq 'score (nth 3 info))))
4794 (setq gnus-newsgroup-processable nil)))
4796 (if (not (setq articles (gnus-articles-to-read group read-all)))
4798 ;; Init the dependencies hash table.
4799 (setq gnus-newsgroup-dependencies
4800 (gnus-make-hashtable (length gnus-newsgroup-unreads)))
4801 ;; Retrieve the headers and read them in.
4802 (setq gnus-newsgroup-headers
4803 (if (eq 'nov (setq gnus-headers-retrieved-by
4804 (gnus-retrieve-headers
4805 (if gnus-fetch-old-headers
4806 (cons 1 articles) articles)
4807 gnus-newsgroup-name)))
4809 (gnus-get-newsgroup-headers-xover articles))
4810 (gnus-get-newsgroup-headers)))
4811 ;; If we were to fetch old headers, but the backend didn't
4812 ;; support XOVER, then it is possible we fetched one article
4813 ;; that we shouldn't have. If that's the case, we pop it off the
4815 (and (not (eq gnus-headers-retrieved-by 'nov))
4816 gnus-fetch-old-headers
4817 gnus-newsgroup-headers
4818 (/= (header-number (car gnus-newsgroup-headers)) (car articles))
4819 (setq gnus-newsgroup-headers (cdr gnus-newsgroup-headers)))
4820 ;; Remove cancelled articles from the list of unread articles.
4821 (setq gnus-newsgroup-unreads
4823 gnus-newsgroup-unreads
4824 (mapcar (lambda (headers) (header-number headers))
4825 gnus-newsgroup-headers)))
4826 ;; Check whether auto-expire is to be done in this group.
4827 (setq gnus-newsgroup-auto-expire
4828 (and (stringp gnus-auto-expirable-newsgroups)
4829 (string-match gnus-auto-expirable-newsgroups
4830 (gnus-group-real-name group))))
4831 ;; First and last article in this newsgroup.
4832 (and gnus-newsgroup-headers
4833 (setq gnus-newsgroup-begin
4834 (header-number (car gnus-newsgroup-headers)))
4835 (setq gnus-newsgroup-end
4836 (header-number (gnus-last-element gnus-newsgroup-headers))))
4837 (setq gnus-xref-hashtb nil)
4838 (setq gnus-reffed-article-number -1)
4839 ;; GROUP is successfully selected.
4840 (or gnus-newsgroup-headers t))))
4842 (defun gnus-articles-to-read (group read-all)
4843 ;; Find out what articles the user wants to read.
4845 ;; Select all articles if `read-all' is non-nil, or if all the
4846 ;; unread articles are dormant articles.
4848 (= (length gnus-newsgroup-unreads)
4849 (length gnus-newsgroup-scored)))
4850 (gnus-uncompress-sequence
4851 (gnus-gethash group gnus-active-hashtb))
4852 gnus-newsgroup-unreads))
4853 (scored-list (gnus-killed-articles gnus-newsgroup-killed articles))
4854 (scored (length scored-list))
4855 (number (length articles))
4856 (marked (+ (length gnus-newsgroup-marked)
4857 (length gnus-newsgroup-dormant)))
4860 (cond ((and (or (<= scored marked)
4862 (numberp gnus-large-newsgroup)
4863 (> number gnus-large-newsgroup))
4867 "How many articles from %s (default %d): "
4868 gnus-newsgroup-name number))))
4869 (if (string-equal input "")
4871 ((and (> scored marked) (< scored number))
4875 "%s %s (%d scored, %d total, %d default): "
4876 "How many articles from"
4877 group scored number scored))))
4878 (if (string-equal input "")
4882 (setq select (if (numberp select) select (string-to-number select)))
4885 (if (and (not (zerop scored)) (<= (abs select) scored))
4887 (setq articles (sort scored-list '<))
4888 (setq number (length articles)))
4889 (setq articles (copy-sequence articles)))
4891 (if (< (abs select) number)
4893 ;; Select the N oldest articles.
4894 (setcdr (nthcdr (1- (abs select)) articles) nil)
4895 ;; Select the N most recent articles.
4896 (setq articles (nthcdr (- number select) articles))))
4897 (setq gnus-newsgroup-unselected
4898 (gnus-set-difference gnus-newsgroup-unreads articles))
4901 (defun gnus-killed-articles (killed articles)
4904 (if (inline (gnus-member-of-range (car articles) killed))
4905 (setq out (cons (car articles) out)))
4906 (setq articles (cdr articles)))
4909 (defun gnus-adjust-marked-articles (info)
4910 "Remove all marked articles that are no longer legal."
4911 (let ((marked-lists (nth 3 info))
4912 (active (gnus-gethash (car info) gnus-active-hashtb))
4914 ;; There are four types of marked articles - ticked, replied,
4915 ;; expirable and dormant.
4917 (setq m (cdr (setq prev (car marked-lists))))
4918 (cond ((or (eq 'tick (car prev)) (eq 'dormant (car prev)))
4919 ;; Make sure that all ticked articles are a subset of the
4920 ;; unread/unselected articles.
4922 (if (or (memq (car m) gnus-newsgroup-unreads)
4923 (memq (car m) gnus-newsgroup-unselected))
4925 (setcdr prev (cdr m)))
4927 ((eq 'score (car prev))
4928 ;; Scored articles should be a subset of
4929 ;; unread/unselected articles.
4931 (if (or (memq (car (car m)) gnus-newsgroup-unreads)
4932 (memq (car (car m)) gnus-newsgroup-unreads))
4934 (setcdr prev (cdr m)))
4936 ((eq 'bookmark (car prev))
4937 ;; Bookmarks should be a subset of active articles.
4939 (if (< (car (car m)) (car active))
4940 (setcdr prev (cdr m))
4943 ((eq 'killed (car prev))
4944 ;; Articles that have been through the kill process are
4945 ;; to be a subset of active articles.
4946 (while (and m (< (cdr (car m)) (car active)))
4947 (setcdr prev (cdr m))
4949 (if (and m (< (car (car m)) (car active)))
4950 (setcar (car m) (car active))))
4951 ((or (eq 'reply (car marked)) (eq 'expire (car marked)))
4952 ;; The replied and expirable articles have to be articles
4955 (if (< (car m) (car active))
4956 (setcdr prev (cdr m))
4959 (setq marked-lists (cdr marked-lists)))
4960 ;; Remove all lists that are empty.
4961 (setq marked-lists (nth 3 info))
4964 (while (= 1 (length (car marked-lists)))
4965 (setq marked-lists (cdr marked-lists)))
4966 (setq m (cdr (setq prev marked-lists)))
4968 (if (= 1 (length (car m)))
4969 (setcdr prev (cdr m))
4972 (setcar (nthcdr 3 info) marked-lists)))
4973 ;; Finally, if there are no marked lists at all left, and if there
4974 ;; are no elements after the lists in the info list, we just chop
4975 ;; the info list off before the marked lists.
4976 (if (and (null marked-lists) (not (nthcdr 4 info)))
4977 (setcdr (nthcdr 2 info) nil)))
4980 (defun gnus-set-marked-articles
4981 (info ticked replied expirable killed dormant bookmark score)
4982 "Enter the various lists of marked articles into the newsgroup info list."
4984 (and ticked (setq newmarked (cons (cons 'tick ticked) nil)))
4985 (and replied (setq newmarked (cons (cons 'reply replied) newmarked)))
4986 (and expirable (setq newmarked (cons (cons 'expire expirable)
4988 (and killed (setq newmarked (cons (cons 'killed killed) newmarked)))
4989 (and dormant (setq newmarked (cons (cons 'dormant dormant) newmarked)))
4990 (and bookmark (setq newmarked (cons (cons 'bookmark bookmark)
4992 (and score (setq newmarked (cons (cons 'score score) newmarked)))
4995 (setcar (nthcdr 3 info) newmarked)
4996 (if (not (nthcdr 4 info))
4997 (setcdr (nthcdr 2 info) nil)
4998 (setcar (nthcdr 3 info) nil)))
5000 (setcdr (nthcdr 2 info) (cons newmarked nil))))))
5002 (defun gnus-add-marked-articles (group type articles &optional info)
5003 ;; Add ARTICLES of TYPE to the info of GROUP.
5004 ;; If INFO is non-nil, use that info.
5005 (let ((info (or info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))))
5008 (and (not (setq marked (nthcdr 3 info)))
5009 (setcdr (nthcdr 2 info) (list (list (cons type articles)))))
5010 (and (not (setq m (assq type (car marked))))
5011 (setcar marked (cons (cons type articles) (car marked))))
5013 (or (memq (car articles) m) (setcdr m (cons (car articles)
5015 (setq articles (cdr articles))))))
5017 (defun gnus-set-mode-line (where)
5018 "This function sets the mode line of the article or summary buffers.
5019 If WHERE is `summary', the summary mode line format will be used."
5020 (if (memq where gnus-updated-mode-lines)
5023 (set-buffer gnus-summary-buffer)
5024 (let* ((mformat (if (eq where 'article)
5025 gnus-article-mode-line-format-spec
5026 gnus-summary-mode-line-format-spec))
5027 (group-name gnus-newsgroup-name)
5028 (article-number (or gnus-current-article 0))
5029 (unread (- (length gnus-newsgroup-unreads)
5030 (length gnus-newsgroup-dormant)))
5031 (unselected (length gnus-newsgroup-unselected))
5032 (unread-and-unselected
5033 (cond ((and (zerop unread) (zerop unselected)) "")
5034 ((zerop unselected) (format "{%d more}" unread))
5035 (t (format "{%d(+%d) more}" unread unselected))))
5037 (if gnus-current-headers
5038 (header-subject gnus-current-headers) ""))
5039 (max-len (if (eq where 'summary) 59 59)))
5040 (setq mode-string (eval mformat))
5041 (if (> (length mode-string) max-len)
5043 (concat (substring mode-string 0 (- max-len 3)) "...")))
5044 (setq mode-string (format (format "%%-%ds" max-len 5)
5046 (setq mode-line-buffer-identification mode-string)
5047 (set-buffer-modified-p t))))
5049 (defun gnus-create-xref-hashtb (from-newsgroup headers unreads)
5050 "Go through the HEADERS list and add all Xrefs to a hash table.
5051 The resulting hash table is returned, or nil if no Xrefs were found."
5052 (let* ((from-method (gnus-find-method-for-group from-newsgroup))
5054 (gnus-group-foreign-p from-newsgroup)
5055 (not (eq 'nnvirtual (car from-method))))
5056 (gnus-group-real-prefix from-newsgroup)))
5057 (xref-hashtb (make-vector 63 0))
5058 start group entry number xrefs header)
5060 (setq header (car headers))
5061 (if (and (setq xrefs (header-xref header))
5062 (not (memq (header-number header) unreads)))
5065 (while (string-match "\\([^ ]+\\):\\([0-9]+\\)" xrefs start)
5066 (setq start (match-end 0))
5067 (setq group (concat prefix (substring xrefs (match-beginning 1)
5070 (string-to-int (substring xrefs (match-beginning 2)
5072 (if (setq entry (gnus-gethash group xref-hashtb))
5073 (setcdr entry (cons number (cdr entry)))
5074 (gnus-sethash group (cons number nil) xref-hashtb)))))
5075 (setq headers (cdr headers)))
5076 (if start xref-hashtb nil)))
5078 (defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads expirable)
5079 "Look through all the headers and mark the Xrefs as read."
5080 (let (name entry read info xref-hashtb idlist active num range exps)
5081 (set-buffer gnus-group-buffer)
5082 (if (setq xref-hashtb
5083 (gnus-create-xref-hashtb from-newsgroup headers unreads))
5086 (if (string= from-newsgroup (setq name (symbol-name group)))
5088 (setq idlist (symbol-value group))
5089 ;; Dead groups are not updated.
5090 (if (and (setq entry (gnus-gethash name gnus-newsrc-hashtb))
5091 ;; Only do the xrefs if the group has the same
5092 ;; select method as the group we have just read.
5093 (or (and (not (nth 4 (setq info (nth 2 entry))))
5094 (eq (gnus-find-method-for-group from-newsgroup)
5095 gnus-select-method))
5096 (eq (car (gnus-find-method-for-group
5097 from-newsgroup)) 'nnvirtual)
5099 (gnus-find-method-for-group from-newsgroup))))
5102 ;; Set the new list of read articles in this group.
5103 (setq active (gnus-gethash name gnus-active-hashtb))
5104 ;; First peel off all illegal article numbers.
5107 (ticked (cdr (memq 'tick (nth 3 info))))
5108 (dormant (cdr (memq 'dormant (nth 3 info))))
5113 (if (or (> id (cdr active))
5117 (setq idlist (delq id idlist)))
5118 (and (memq id expirable)
5119 (setq exps (cons id exps)))
5120 (setq ids (cdr ids)))))
5121 ;; Update expirable articles.
5122 (gnus-add-marked-articles nil 'expirable exps info)
5123 (setcar (nthcdr 2 info)
5127 (setq idlist (sort idlist '<)))))
5128 ;; Then we have to re-compute how many unread
5129 ;; articles there are in this group.
5132 (if (atom (car range))
5134 (setq num (- (1+ (cdr active)) (car active)))
5135 (setq num (- (cdr active) (- (1+ (cdr range))
5138 (setq num (+ num (- (1+ (cdr (car range)))
5139 (car (car range)))))
5140 (setq range (cdr range)))
5141 (setq num (- (cdr active) num)))
5142 ;; Update the number of unread articles.
5143 (setcar entry (max 0 num))
5144 ;; Update the group buffer.
5145 (gnus-group-update-group name t)))))))
5148 (defsubst gnus-header-value ()
5149 (buffer-substring (match-end 0) (save-excursion (end-of-line) (point))))
5151 (defun gnus-get-newsgroup-headers ()
5152 (setq gnus-article-internal-prepare-hook nil)
5153 (let ((cur nntp-server-buffer)
5154 (dependencies gnus-newsgroup-dependencies)
5156 headers char article id dep end)
5158 (set-buffer nntp-server-buffer)
5160 ;; Search to the beginning of the next header. Error messages
5161 ;; do not begin with 2 or 3.
5162 (while (re-search-forward "^[23][0-9]+ " nil t)
5163 (let ((header (make-vector 9 nil))
5164 (c (following-char))
5165 (case-fold-search t)
5167 from subject in-reply-to references ref)
5173 (header-set-number header (setq article (read cur)))
5174 ;; This implementation of this function, with nine
5175 ;; search-forwards instead of the one re-search-forward and
5176 ;; a case (which basically was the old function) is actually
5177 ;; about twice as fast, even though it looks messier. You
5178 ;; can't have everything, I guess. Speed and elegance
5179 ;; doesn't always come hand in hand.
5181 (narrow-to-region (point) (save-excursion
5182 (search-forward "\n.\n" nil t)))
5183 (if (search-forward "\nfrom: " nil t)
5184 (header-set-from header (gnus-header-value))
5185 (header-set-from header "(nobody)"))
5187 (if (search-forward "\nsubject: " nil t)
5188 (header-set-subject header (gnus-header-value))
5189 (header-set-subject header "(none)"))
5191 (and (search-forward "\nxref: " nil t)
5192 (header-set-xref header (gnus-header-value)))
5194 (and (search-forward "\nlines: " nil t)
5195 (header-set-lines header (read cur)))
5197 (and (search-forward "\ndate: " nil t)
5198 (header-set-date header (gnus-header-value)))
5200 (if (search-forward "\nmessage-id: " nil t)
5201 (header-set-id header (setq id (gnus-header-value)))
5202 ;; If there was no message-id, we just fake one to make
5203 ;; subsequent routines simpler.
5206 (setq id (concat "none+" (int-to-string
5207 (setq none-id (1+ none-id)))))))
5209 (if (search-forward "\nreferences: " nil t)
5211 (header-set-references header (gnus-header-value))
5212 (setq end (match-end 0))
5219 (search-backward ">" end t)
5222 (search-backward "<" end t)
5224 ;; Get the references from the in-reply-to header if there
5225 ;; was no references, and the in-reply-to header looks
5227 (if (and (search-forward "\nin-reply-to: " nil t)
5228 (setq in-reply-to (gnus-header-value))
5229 (string-match "<[^>]+>" in-reply-to))
5231 (header-set-references
5233 (setq ref (substring in-reply-to (match-beginning 0)
5235 (setq ref (downcase ref)))
5237 ;; We do some threading while we read the headers. The
5238 ;; message-id and the last reference are both entered into
5239 ;; the same hash table. Some tippy-toeing around has to be
5240 ;; done in case an article has arrived before the article
5241 ;; which it refers to.
5242 (if (boundp (setq dep (intern (downcase id) dependencies)))
5243 (if (car (symbol-value dep))
5245 (setcar (symbol-value dep) header))
5246 (set dep (list header)))
5249 (if (boundp (setq dep (intern ref dependencies)))
5250 (setcdr (symbol-value dep)
5251 (cons header (cdr (symbol-value dep))))
5252 (set dep (list nil header)))
5253 (setq headers (cons header headers))))
5254 (goto-char (point-max))))))
5255 (nreverse headers)))
5257 ;; The following macros and functions were written by Felix Lee
5258 ;; <flee@cse.psu.edu>.
5260 ;; This is almost 4x faster than (string-to-int (buffer-substring ... ))
5261 ;; primarily because of garbage collection. -jwz
5262 (defmacro gnus-read-integer (&optional point move-p)
5263 (` ((, (if move-p 'progn 'save-excursion))
5264 (,@ (if point (list (list 'goto-char point))))
5265 (if (and (<= (following-char) ?9)
5266 (>= (following-char) ?0))
5267 (read (current-buffer))
5270 (defmacro gnus-nov-skip-field ()
5271 '(search-forward "\t" eol 'end))
5273 (defmacro gnus-nov-field ()
5276 (progn (gnus-nov-skip-field) (1- (point)))))
5278 ;; Goes through the xover lines and returns a list of vectors
5279 (defun gnus-get-newsgroup-headers-xover (sequence)
5280 "Parse the news overview data in the server buffer, and return a
5281 list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
5282 ;; Get the Xref when the users reads the articles since most/some
5283 ;; NNTP servers do not include Xrefs when using XOVER.
5284 (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
5285 (let ((cur nntp-server-buffer)
5286 (dependencies gnus-newsgroup-dependencies)
5288 number headers header)
5290 (set-buffer nntp-server-buffer)
5291 (goto-char (point-min))
5292 (while (and sequence (not (eobp)))
5293 (setq number (read cur))
5294 (while (and sequence (< (car sequence) number))
5295 (setq sequence (cdr sequence)))
5297 (eq number (car sequence))
5299 (setq sequence (cdr sequence))
5301 (inline (gnus-nov-parse-line number dependencies)))
5302 (setq headers (cons header headers)))))
5304 (setq headers (nreverse headers)))
5307 (defun gnus-nov-parse-line (number dependencies)
5308 "Point has to be after the number on the beginning of the line."
5310 header eol ref id dep)
5315 ;; overview: [num subject from date id refs chars lines misc]
5319 (gnus-nov-field) ; subject
5320 (gnus-nov-field) ; from
5321 (gnus-nov-field) ; date
5322 (setq id (gnus-nov-field)) ; id
5325 (let ((beg (point)))
5326 (search-forward "\t" eol)
5327 (if (search-backward ">" beg t)
5333 (search-backward "<" beg t)
5336 (gnus-nov-field)) ; refs
5337 (read (current-buffer)) ; chars
5338 (read (current-buffer)) ; lines
5339 (if (/= (following-char) ?\t)
5342 (gnus-nov-field)) ; misc
5344 ;; We build the thread tree.
5349 (or id (concat "none+"
5351 (setq none (1+ none))))))
5353 (if (car (symbol-value dep))
5355 (setcar (symbol-value dep) header))
5356 (set dep (list header)))
5359 (if (boundp (setq dep (intern (or ref "none")
5361 (setcdr (symbol-value dep)
5362 (cons header (cdr (symbol-value dep))))
5363 (set dep (list nil header)))))
5366 (defun gnus-article-get-xrefs ()
5367 "Fill in the Xref value in `gnus-current-headers', if necessary.
5368 This is meant to be called in `gnus-article-internal-prepare-hook'."
5369 (or (not gnus-use-cross-reference)
5370 (let ((case-fold-search t)
5373 (gnus-narrow-to-headers)
5374 (goto-char (point-min))
5375 (if (or (and (eq (downcase (following-char)) ?x)
5376 (looking-at "Xref:"))
5377 (search-forward "\nXref:" nil t))
5379 (goto-char (1+ (match-end 0)))
5380 (setq xref (buffer-substring (point)
5381 (progn (end-of-line) (point))))
5383 (set-buffer gnus-summary-buffer)
5384 (header-set-xref gnus-current-headers xref))))))))
5386 (defalias 'gnus-find-header-by-number 'gnus-get-header-by-number)
5387 (make-obsolete 'gnus-find-header-by-number 'gnus-get-header-by-number)
5389 ;; Return a header specified by a NUMBER.
5390 (defun gnus-get-header-by-number (number)
5392 (set-buffer gnus-summary-buffer)
5393 (or gnus-newsgroup-headers-hashtb-by-number
5394 (gnus-make-headers-hashtable-by-number))
5395 (gnus-gethash (int-to-string number)
5396 gnus-newsgroup-headers-hashtb-by-number)))
5398 (defun gnus-make-headers-hashtable-by-number ()
5399 "Make hashtable for the variable gnus-newsgroup-headers by number."
5401 (set-buffer gnus-summary-buffer)
5402 (let ((headers gnus-newsgroup-headers)
5404 (setq gnus-newsgroup-headers-hashtb-by-number
5405 (gnus-make-hashtable (length headers)))
5407 (setq header (car headers))
5408 (gnus-sethash (int-to-string (header-number header))
5409 header gnus-newsgroup-headers-hashtb-by-number)
5410 (setq headers (cdr headers))))))
5412 (defun gnus-more-header-backward ()
5413 "Find new header backward."
5414 (let ((first (car (gnus-gethash gnus-newsgroup-name gnus-active-hashtb)))
5415 (artnum gnus-newsgroup-begin)
5417 (while (and (not header)
5419 (setq artnum (1- artnum))
5420 (setq header (gnus-read-header artnum)))
5423 (defun gnus-more-header-forward ()
5424 "Find new header forward."
5425 (let ((last (cdr (gnus-gethash gnus-newsgroup-name gnus-active-hashtb)))
5426 (artnum gnus-newsgroup-end)
5428 (while (and (not header)
5430 (setq artnum (1+ artnum))
5431 (setq header (gnus-read-header artnum)))
5434 (defun gnus-extend-newsgroup (header &optional backward)
5435 "Extend newsgroup selection with HEADER.
5436 Optional argument BACKWARD means extend toward backward."
5438 (let ((artnum (header-number header)))
5439 (setq gnus-newsgroup-headers
5441 (cons header gnus-newsgroup-headers)
5442 (nconc gnus-newsgroup-headers (list header))))
5443 (setq gnus-newsgroup-unselected
5444 (delq artnum gnus-newsgroup-unselected))
5445 (setq gnus-newsgroup-begin (min gnus-newsgroup-begin artnum))
5446 (setq gnus-newsgroup-end (max gnus-newsgroup-end artnum)))))
5449 (defun gnus-summary-search-group (&optional backward use-level)
5450 "Search for next unread newsgroup.
5451 If optional argument BACKWARD is non-nil, search backward instead."
5453 (set-buffer gnus-group-buffer)
5455 ;; We don't want to alter current point of group mode buffer.
5456 (if (gnus-group-search-forward
5458 (if use-level (gnus-group-group-level) nil))
5459 (gnus-group-group-name))
5462 (defun gnus-summary-search-subject (&optional backward unread subject)
5463 "Search for article forward.
5464 If BACKWARD is non-nil, search backward.
5465 If UNREAD is non-nil, only unread articles are selected.
5466 If SUBJECT is non-nil, the article which has the same subject will be
5468 (let ((func (if backward 'previous-single-property-change
5469 'next-single-property-change))
5474 (forward-char (if backward (if (bobp) 0 -1) (if (eobp) 0 1)))
5475 (while (and (setq pos (funcall func (point) 'gnus-number))
5476 (goto-char (if backward (1- pos) pos))
5478 (not (and (or (not unread)
5479 (= (get-text-property (point) 'gnus-mark)
5482 (string= (gnus-simplify-subject-re
5484 (gnus-simplify-subject-re
5487 'gnus-subject)))))))
5488 (if backward (if (bobp) nil (forward-char -1) t)
5489 (if (eobp) nil (forward-char 1) t))))
5491 (progn (goto-char beg) nil)
5493 (get-text-property (point) 'gnus-number)
5494 (gnus-summary-position-cursor)))))
5496 (defun gnus-summary-search-forward (&optional unread subject backward)
5497 "Search for article forward.
5498 If UNREAD is non-nil, only unread articles are selected.
5499 If SUBJECT is non-nil, the article which has the same subject will be
5501 If BACKWARD is non-nil, the search will be performed backwards instead."
5502 (gnus-summary-search-subject backward unread subject))
5504 (defun gnus-summary-search-backward (&optional unread subject)
5505 "Search for article backward.
5506 If 1st optional argument UNREAD is non-nil, only unread article is selected.
5507 If 2nd optional argument SUBJECT is non-nil, the article which has
5508 the same subject will be searched for."
5509 (gnus-summary-search-forward unread subject t))
5511 (defun gnus-summary-article-number (&optional number-or-nil)
5512 "The article number of the article on the current line.
5513 If there isn's an article number here, then we return the current
5515 (let ((number (get-text-property (save-excursion (beginning-of-line) (point))
5517 (if number-or-nil number (or number gnus-current-article))))
5519 (defun gnus-summary-thread-level ()
5520 "The thread level of the article on the current line."
5521 (or (get-text-property (save-excursion (beginning-of-line) (point))
5525 (defun gnus-summary-pseudo-article ()
5526 "The thread level of the article on the current line."
5527 (get-text-property (save-excursion (beginning-of-line) (point))
5530 (defun gnus-summary-article-mark ()
5531 "The mark on the current line."
5532 (get-text-property (save-excursion (beginning-of-line) (point))
5535 (defun gnus-summary-subject-string ()
5536 "Return current subject string or nil if nothing."
5537 (get-text-property (save-excursion (beginning-of-line) (point))
5540 (defalias 'gnus-summary-score 'gnus-summary-article-score)
5541 (make-obsolete 'gnus-summary-score 'gnus-summary-article-score)
5542 (defun gnus-summary-article-score ()
5543 "Return current article score."
5544 (or (cdr (assq (gnus-summary-article-number) gnus-newsgroup-scored))
5545 gnus-summary-default-score))
5547 (defun gnus-summary-recenter ()
5548 "Center point in summary window."
5549 ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
5550 ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu.
5551 (let ((half (/ (- (window-height) 2) 2)))
5553 ;; It has to be wanted,
5554 gnus-auto-center-summary
5555 ;; the article buffer must be displayed,
5556 (get-buffer-window gnus-article-buffer)
5557 ;; there must be lines left to scroll forward,
5558 (zerop (save-excursion (forward-line (1+ half))))
5562 (defun gnus-summary-jump-to-group (newsgroup)
5563 "Move point to NEWSGROUP in group mode buffer."
5564 ;; Keep update point of group mode buffer if visible.
5565 (if (eq (current-buffer)
5566 (get-buffer gnus-group-buffer))
5567 (save-window-excursion
5568 ;; Take care of tree window mode.
5569 (if (get-buffer-window gnus-group-buffer)
5570 (pop-to-buffer gnus-group-buffer))
5571 (gnus-group-jump-to-group newsgroup))
5573 ;; Take care of tree window mode.
5574 (if (get-buffer-window gnus-group-buffer)
5575 (pop-to-buffer gnus-group-buffer)
5576 (set-buffer gnus-group-buffer))
5577 (gnus-group-jump-to-group newsgroup))))
5579 ;; This function returns a list of article numbers based on the
5580 ;; difference between the ranges of read articles in this group and
5581 ;; the range of active articles.
5582 (defun gnus-list-of-unread-articles (group)
5583 (let* ((read (nth 2 (nth 2 (gnus-gethash group gnus-newsrc-hashtb))))
5584 (active (gnus-gethash group gnus-active-hashtb))
5586 unread first nlast unread)
5587 ;; If none are read, then all are unread.
5589 (setq first (car active))
5590 ;; If the range of read articles is a single range, then the
5591 ;; first unread article is the article after the last read
5592 ;; article. Sounds logical, doesn't it?
5593 (if (atom (car read))
5594 (setq first (1+ (cdr read)))
5595 ;; `read' is a list of ranges.
5598 (while (< first nlast)
5599 (setq unread (cons first unread))
5600 (setq first (1+ first))))
5601 (setq first (1+ (cdr (car read))))
5602 (setq nlast (car (car (cdr read))))
5603 (setq read (cdr read)))))
5604 ;; And add the last unread articles.
5605 (while (<= first last)
5606 (setq unread (cons first unread))
5607 (setq first (1+ first)))
5608 ;; Return the list of unread articles.
5611 ;; Various summary commands
5613 (defun gnus-summary-universal-argument ()
5614 "Perform any operation on all articles marked with the process mark."
5616 (let ((articles (reverse gnus-newsgroup-processable))
5618 (or articles (error "No articles marked"))
5619 (or (setq func (key-binding (read-key-sequence "C-c C-u")))
5620 (error "Undefined key"))
5622 (gnus-summary-goto-subject (car articles))
5623 (command-execute func)
5624 (gnus-summary-remove-process-mark (car articles))
5625 (setq articles (cdr articles)))))
5627 (defun gnus-summary-toggle-truncation (arg)
5628 "Toggle truncation of summary lines.
5629 With arg, turn line truncation on iff arg is positive."
5631 (setq truncate-lines
5632 (if (null arg) (not truncate-lines)
5633 (> (prefix-numeric-value arg) 0)))
5636 (defun gnus-summary-reselect-current-group (show-all)
5637 "Once exit and then reselect the current newsgroup.
5638 Prefix argument SHOW-ALL means to select all articles."
5640 (let ((current-subject (gnus-summary-article-number)))
5641 (gnus-summary-exit t)
5642 ;; We have to adjust the point of group mode buffer because the
5643 ;; current point was moved to the next unread newsgroup by
5645 (gnus-summary-jump-to-group gnus-newsgroup-name)
5646 (gnus-group-read-group show-all t)
5647 (gnus-summary-goto-subject current-subject)
5650 (defun gnus-summary-rescan-group (all)
5651 "Exit the newsgroup, ask for new articles, and select the newsgroup."
5653 ;; Fix by Ilja Weis <kult@uni-paderborn.de>.
5654 (let ((group gnus-newsgroup-name))
5655 (gnus-summary-exit t)
5656 (gnus-summary-jump-to-group group)
5658 (set-buffer gnus-group-buffer)
5659 (gnus-group-get-new-news-this-group 1))
5660 (gnus-summary-jump-to-group group)
5661 (gnus-group-read-group all)))
5663 (defun gnus-summary-exit (&optional temporary)
5664 "Exit reading current newsgroup, and then return to group selection mode.
5665 gnus-exit-group-hook is called with no arguments if that value is non-nil."
5667 (gnus-kill-save-kill-buffer)
5668 (let ((group gnus-newsgroup-name)
5670 (buf (current-buffer)))
5671 (if gnus-newsgroup-kill-headers
5672 (setq gnus-newsgroup-killed
5673 (gnus-compress-sequence
5676 (gnus-uncompress-sequence gnus-newsgroup-killed)
5677 (setq gnus-newsgroup-unselected
5678 (sort gnus-newsgroup-unselected '<)))
5679 (setq gnus-newsgroup-unreads
5680 (sort gnus-newsgroup-unreads '<))))))
5681 (or (listp (cdr gnus-newsgroup-killed))
5682 (setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
5684 (headers gnus-newsgroup-headers)
5685 (unreads gnus-newsgroup-unreads)
5686 (unselected gnus-newsgroup-unselected)
5687 (ticked gnus-newsgroup-marked))
5688 (gnus-close-group group)
5689 ;; Important internal variables are saved, so we can reenter
5690 ;; the summary buffer even if the hook changes them.
5691 (run-hooks 'gnus-exit-group-hook)
5693 (gnus-update-read-articles
5694 group unreads unselected ticked
5695 t gnus-newsgroup-replied gnus-newsgroup-expirable
5696 gnus-newsgroup-killed gnus-newsgroup-dormant
5697 gnus-newsgroup-bookmarks gnus-newsgroup-scored)
5698 ;; t means ignore unsubscribed newsgroups.
5699 (and gnus-use-cross-reference
5700 (gnus-mark-xrefs-as-read
5701 group headers unreads gnus-newsgroup-expirable))
5702 ;; Do not switch windows but change the buffer to work.
5703 (set-buffer gnus-group-buffer)
5704 (gnus-group-update-group group))
5705 ;; Make sure where I was, and go to next newsgroup.
5706 (gnus-group-jump-to-group group)
5707 (gnus-group-next-unread-group 1)
5709 ;; If exiting temporary, caller should adjust group mode
5710 ;; buffer point by itself.
5712 ;; Return to group mode buffer.
5713 (if (and (get-buffer buf)
5714 (eq mode 'gnus-summary-mode))
5716 (if (get-buffer gnus-article-buffer)
5717 (bury-buffer gnus-article-buffer))
5718 (setq gnus-current-select-method gnus-select-method)
5719 (and gnus-newsgroup-expunged-buffer
5720 (buffer-name gnus-newsgroup-expunged-buffer)
5721 (kill-buffer gnus-newsgroup-expunged-buffer))
5722 (gnus-configure-windows 'newsgroups t)
5723 (pop-to-buffer gnus-group-buffer))))
5725 (defun gnus-summary-quit (&optional no-questions)
5726 "Quit reading current newsgroup without updating read article info."
5728 (if (or no-questions
5729 (y-or-n-p "Do you really wanna quit reading this group? "))
5731 (message "") ;Erase "Yes or No" question.
5732 ;; Return to group selection mode.
5733 (if (get-buffer gnus-summary-buffer)
5734 (kill-buffer gnus-summary-buffer))
5735 (if (get-buffer gnus-article-buffer)
5736 (bury-buffer gnus-article-buffer))
5737 (gnus-configure-windows 'newsgroups)
5738 (pop-to-buffer gnus-group-buffer)
5739 (gnus-group-jump-to-group gnus-newsgroup-name) ;Make sure where I was.
5740 (gnus-group-next-group 1))))
5742 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
5743 (defun gnus-summary-describe-group ()
5744 "Describe the current newsgroup."
5746 (gnus-group-describe-group gnus-newsgroup-name))
5748 (defun gnus-summary-describe-briefly ()
5749 "Describe summary mode commands briefly."
5752 (substitute-command-keys "\\<gnus-summary-mode-map>\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help")))
5754 ;; Walking around group mode buffer from summary mode.
5756 (defun gnus-summary-next-group (&optional no-article group)
5757 "Exit current newsgroup and then select next unread newsgroup.
5758 If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
5760 (let ((ingroup gnus-newsgroup-name))
5761 (gnus-summary-exit t) ;Update all information.
5762 (gnus-group-jump-to-group ingroup)
5763 (let ((group (or group (gnus-summary-search-group)))
5764 (buf gnus-summary-buffer))
5766 (gnus-summary-quit t)
5767 (message "Selecting %s..." group)
5768 ;; We are now in group mode buffer.
5769 ;; Make sure group mode buffer point is on GROUP.
5770 (gnus-group-jump-to-group group)
5772 (gnus-summary-read-group group nil no-article buf)
5773 (and (string= gnus-newsgroup-name ingroup)
5774 (gnus-summary-quit t)))))))
5776 (defun gnus-summary-prev-group (no-article)
5777 "Exit current newsgroup and then select previous unread newsgroup.
5778 If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
5780 ;; Make sure group mode buffer point is on current newsgroup.
5781 (gnus-summary-jump-to-group gnus-newsgroup-name)
5782 (let ((group (gnus-summary-search-group t)))
5785 (message "Exiting %s..." gnus-newsgroup-name)
5788 (message "Selecting %s..." group)
5789 (gnus-summary-exit t) ;Exit summary mode temporary.
5790 ;; We are now in group mode buffer.
5791 ;; We have to adjust point of group mode buffer because current
5792 ;; point is moved to next unread newsgroup by exiting.
5793 (gnus-summary-jump-to-group group)
5794 (gnus-summary-read-group group nil no-article)
5795 (or (eq (current-buffer)
5796 (get-buffer gnus-summary-buffer))
5797 (eq gnus-auto-select-next t)
5798 ;; Expected newsgroup has nothing to read since the articles
5799 ;; are marked as read by cross-referencing. So, try next
5800 ;; newsgroup. (Make sure we are in group mode buffer now.)
5801 (and (eq (current-buffer)
5802 (get-buffer gnus-group-buffer))
5803 (gnus-summary-search-group t)
5804 (gnus-summary-read-group
5805 (gnus-summary-search-group t) nil no-article))
5809 ;; Walking around summary lines.
5811 (defun gnus-summary-first-subject (unread)
5812 "Go to the first unread subject.
5813 If UNREAD is non-nil, go to the first unread article.
5814 Returns nil if there are no unread articles."
5815 (let ((begin (point)))
5817 (if (not (gnus-goto-char
5818 (text-property-any (point-min) (point-max)
5819 'gnus-mark gnus-unread-mark)))
5821 ;; If there is no unread articles, stay where you are.
5823 (message "No more unread articles")
5826 (goto-char (point-min)))))
5828 (defun gnus-summary-next-subject (n &optional unread)
5829 "Go to next N'th summary line.
5830 If N is negative, go to the previous N'th subject line.
5831 If UNREAD is non-nil, only unread articles are selected.
5832 The difference between N and the actual number of steps taken is
5835 (let ((backward (< n 0))
5838 (gnus-summary-search-forward unread nil backward))
5840 (gnus-summary-recenter)
5841 (if (/= 0 n) (message "No more%s articles" (if unread " unread" "")))
5842 ; (gnus-summary-position-cursor)
5845 (defun gnus-summary-next-unread-subject (n)
5846 "Go to next N'th unread summary line."
5848 (gnus-summary-next-subject n t))
5850 (defun gnus-summary-prev-subject (n &optional unread)
5851 "Go to previous N'th summary line.
5852 If optional argument UNREAD is non-nil, only unread article is selected."
5854 (gnus-summary-next-subject (- n) unread))
5856 (defun gnus-summary-prev-unread-subject (n)
5857 "Go to previous N'th unread summary line."
5859 (gnus-summary-next-subject (- n) t))
5861 (defun gnus-summary-goto-subject (article)
5862 "Go the subject line of ARTICLE."
5866 (completing-read "Article number: "
5870 (int-to-string (header-number headers))))
5871 gnus-newsgroup-headers)
5872 nil 'require-match))))
5873 (or article (error "No article number"))
5874 (if (or (eq article (gnus-summary-article-number t))
5877 (point-min) (point-max) 'gnus-number article)))
5880 ;; Walking around summary lines with displaying articles.
5882 (defun gnus-summary-expand-window ()
5883 "Expand summary window to show headers full window."
5885 (gnus-configure-windows 'summary)
5886 (pop-to-buffer gnus-summary-buffer))
5888 (defun gnus-summary-display-article (article &optional all-header)
5889 "Display ARTICLE in article buffer."
5890 (setq gnus-summary-buffer (current-buffer))
5893 (gnus-article-prepare article all-header)
5894 (if (= (gnus-summary-article-mark) ?Z)
5897 (gnus-summary-position-cursor)))
5898 (gnus-summary-recenter)
5899 (run-hooks 'gnus-select-article-hook)
5900 (gnus-summary-goto-subject article)
5901 (gnus-configure-windows 'article)
5902 ;; Successfully display article.
5905 (defun gnus-summary-select-article (&optional all-headers force pseudo)
5906 "Select the current article.
5907 If ALL-HEADERS is non-nil, show all header fields. If FORCE is
5908 non-nil, the article will be re-fetched even if it already present in
5909 the article buffer. If PSEUDO is non-nil, pseudo-articles will also
5911 (and (not pseudo) (gnus-summary-pseudo-article)
5912 (error "This is a pseudo-article."))
5913 (let ((article (gnus-summary-article-number))
5914 (all-headers (not (not all-headers)))) ;Must be T or NIL.
5915 (if (or (null gnus-current-article)
5916 (null gnus-article-current)
5917 (/= article (cdr gnus-article-current))
5918 (not (equal (car gnus-article-current) gnus-newsgroup-name))
5920 ;; The requested article is different from the current article.
5922 (gnus-summary-display-article article all-headers)
5924 (if all-headers (gnus-article-show-all-headers))
5925 (gnus-configure-windows 'article)
5926 (pop-to-buffer gnus-summary-buffer)
5929 (defun gnus-summary-set-current-mark (&optional current-mark)
5930 "Obsolete function."
5933 (defun gnus-summary-next-article (unread &optional subject)
5934 "Select the article after the current one.
5935 If UNREAD is non-nil, only unread articles are selected."
5938 (cond ((gnus-summary-display-article
5939 (gnus-summary-search-forward unread subject)))
5941 gnus-auto-select-same
5942 (gnus-set-difference gnus-newsgroup-unreads
5943 (append gnus-newsgroup-marked
5944 gnus-newsgroup-dormant))
5946 '(gnus-summary-next-unread-article
5947 gnus-summary-next-page
5948 gnus-summary-kill-same-subject-and-select
5949 ;;gnus-summary-next-article
5950 ;;gnus-summary-next-same-subject
5951 ;;gnus-summary-next-unread-same-subject
5953 ;; Wrap article pointer if there are unread articles.
5954 ;; Hook function, such as gnus-summary-rmail-digest, may
5955 ;; change current buffer, so need check.
5956 (let ((buffer (current-buffer))
5957 (last-point (point)))
5958 ;; No more articles with same subject, so jump to the first
5960 (gnus-summary-first-unread-article)
5961 ;;(and (eq buffer (current-buffer))
5962 ;; (= (point) last-point)
5963 ;; ;; Ignore given SUBJECT, and try again.
5964 ;; (gnus-summary-next-article unread nil))
5965 (and (eq buffer (current-buffer))
5966 (< (point) last-point)
5967 (message "Wrapped"))
5969 ((and gnus-auto-extend-newsgroup
5970 (not unread) ;Not unread only
5971 (not subject) ;Only if subject is not specified.
5972 (setq header (gnus-more-header-forward)))
5973 ;; Extend to next article if possible.
5974 ;; Basic ideas by himacdonald@watdragon.waterloo.edu
5975 (gnus-extend-newsgroup header nil)
5976 ;; Threads feature must be turned off.
5977 (let ((buffer-read-only nil))
5978 (goto-char (point-max))
5979 (gnus-summary-prepare-threads (list header) 0))
5980 (gnus-summary-goto-article gnus-newsgroup-end))
5982 ;; Select next newsgroup automatically if requested.
5983 (gnus-summary-jump-to-group gnus-newsgroup-name)
5984 (let ((cmd (aref (this-command-keys) 0))
5985 (group (gnus-summary-search-group nil gnus-keep-same-level))
5987 (and gnus-auto-select-next
5988 ;;(null (gnus-set-difference gnus-newsgroup-unreads
5989 ;; gnus-newsgroup-marked))
5991 '(gnus-summary-next-unread-article
5992 gnus-summary-next-article
5993 gnus-summary-next-page
5994 gnus-summary-next-same-subject
5995 gnus-summary-next-unread-same-subject
5996 gnus-summary-kill-same-subject
5997 gnus-summary-kill-same-subject-and-select
5999 ;; Ignore characters typed ahead.
6000 (not (input-pending-p))
6002 ;; Keep just the event type of CMD.
6004 (setq cmd (car cmd)))
6005 (message "No more%s articles%s"
6006 (if unread " unread" "")
6007 (if (and auto-select
6008 (not (eq gnus-auto-select-next 'quietly)))
6010 (format " (Type %s for %s [%s])"
6011 (single-key-description cmd)
6014 group gnus-newsrc-hashtb)))
6015 (format " (Type %s to exit %s)"
6016 (single-key-description cmd)
6017 gnus-newsgroup-name))
6019 ;; Select next unread newsgroup automagically.
6020 (cond ((and auto-select
6021 (eq gnus-auto-select-next 'quietly))
6023 (gnus-summary-next-group))
6025 ;; Confirm auto selection.
6026 (let* ((event (read-event))
6031 (if (and (eq event type) (eq event cmd))
6032 (gnus-summary-next-group)
6033 (setq unread-command-events (list event)))))
6038 (defun gnus-summary-next-unread-article ()
6039 "Select unread article after current one."
6041 (gnus-summary-next-article t (and gnus-auto-select-same
6042 (gnus-summary-subject-string)))
6043 (gnus-summary-position-cursor))
6045 (defun gnus-summary-prev-article (unread &optional subject)
6046 "Select the article after the current one.
6047 If UNREAD is non-nil, only unread articles are selected."
6050 (cond ((gnus-summary-display-article
6051 (gnus-summary-search-backward unread subject)))
6053 gnus-auto-select-same
6054 (gnus-set-difference gnus-newsgroup-unreads
6055 (append gnus-newsgroup-marked
6056 gnus-newsgroup-dormant))
6058 '(gnus-summary-prev-unread-article
6059 gnus-summary-prev-page)))
6060 ;; Wrap article pointer if there are unread articles.
6061 ;; Hook function, such as gnus-summary-rmail-digest, may
6062 ;; change current buffer, so need check.
6063 (let ((buffer (current-buffer))
6064 (last-point (point)))
6065 ;; No more articles with same subject, so jump to the first
6067 (gnus-summary-first-unread-article)
6068 (and (eq buffer (current-buffer))
6069 (< (point) last-point)
6070 (message "Wrapped"))
6072 ((and gnus-auto-extend-newsgroup
6073 (not unread) ;Not unread only
6074 (not subject) ;Only if subject is not specified.
6075 (setq header (gnus-more-header-backward)))
6076 ;; Extend to next article if possible.
6077 ;; Basic ideas by himacdonald@watdragon.waterloo.edu
6078 (gnus-extend-newsgroup header t)
6079 ;; Threads feature must be turned off.
6080 (let ((buffer-read-only nil))
6081 (goto-char (point-min))
6082 (gnus-summary-prepare-threads (list header) 0))
6083 (gnus-summary-goto-article gnus-newsgroup-begin))
6085 ;; Select prev newsgroup automatically if requested.
6086 (gnus-summary-jump-to-group gnus-newsgroup-name)
6087 (let ((cmd (aref (this-command-keys) 0))
6088 (group (gnus-summary-search-group t gnus-keep-same-level))
6090 (and gnus-auto-select-next
6092 '(gnus-summary-prev-unread-article
6093 gnus-summary-prev-article
6094 gnus-summary-prev-page))
6095 ;; Ignore characters typed ahead.
6096 (not (input-pending-p)))))
6097 ;; Keep just the event type of CMD.
6099 (setq cmd (car cmd)))
6100 (message "No more%s articles%s"
6101 (if unread " unread" "")
6102 (if (and auto-select
6103 (not (eq gnus-auto-select-next 'quietly)))
6105 (format " (Type %s for %s [%s])"
6106 (single-key-description cmd)
6109 group gnus-newsrc-hashtb)))
6110 (format " (Type %s to exit %s)"
6111 (single-key-description cmd)
6112 gnus-newsgroup-name))
6114 ;; Select next unread newsgroup automagically.
6115 (cond ((and auto-select
6116 (eq gnus-auto-select-next 'quietly))
6118 (gnus-summary-prev-group 1))
6120 ;; Confirm auto selection.
6121 (let* ((event (read-event))
6126 (if (and (eq event type) (eq event cmd))
6127 (gnus-summary-prev-group 1)
6128 (setq unread-command-events (list event)))))
6133 (defun gnus-summary-prev-unread-article ()
6134 "Select unred article before current one."
6136 (gnus-summary-prev-article t (and gnus-auto-select-same
6137 (gnus-summary-subject-string))))
6139 (defun gnus-summary-next-page (lines &optional circular)
6140 "Show next page of selected article.
6141 If end of article, select next article.
6142 Argument LINES specifies lines to be scrolled up.
6143 If CIRCULAR is non-nil, go to the start of the article instead of
6144 instead of selecting the next article when reaching the end of the
6147 (setq gnus-summary-buffer (current-buffer))
6148 (let ((article (gnus-summary-article-number))
6150 (if (or (null gnus-current-article)
6151 (null gnus-article-current)
6152 (/= article (cdr gnus-article-current))
6153 (not (equal (car gnus-article-current) gnus-newsgroup-name)))
6154 ;; Selected subject is different from current article's.
6155 (gnus-summary-display-article article)
6156 (gnus-configure-windows 'article)
6157 (pop-to-buffer gnus-summary-buffer)
6158 (gnus-eval-in-buffer-window
6160 (setq endp (gnus-article-next-page lines)))
6163 (gnus-summary-beginning-of-article))
6165 (message "End of message"))
6167 (gnus-summary-next-unread-article))))
6168 (gnus-summary-position-cursor))))
6170 (defun gnus-summary-prev-page (lines)
6171 "Show previous page of selected article.
6172 Argument LINES specifies lines to be scrolled down."
6174 (let ((article (gnus-summary-article-number)))
6175 (if (or (null gnus-current-article)
6176 (null gnus-article-current)
6177 (/= article (cdr gnus-article-current))
6178 (not (equal (car gnus-article-current) gnus-newsgroup-name)))
6179 ;; Selected subject is different from current article's.
6180 (gnus-summary-display-article article)
6181 (gnus-configure-windows 'article)
6182 (pop-to-buffer gnus-summary-buffer)
6183 (gnus-eval-in-buffer-window gnus-article-buffer
6184 (gnus-article-prev-page lines))
6185 (gnus-summary-position-cursor))))
6187 (defun gnus-summary-scroll-up (lines)
6188 "Scroll up (or down) one line current article.
6189 Argument LINES specifies lines to be scrolled up (or down if negative)."
6191 (or (gnus-summary-select-article nil nil 'pseudo)
6192 (gnus-eval-in-buffer-window
6195 (if (gnus-article-next-page lines)
6196 (message "End of message")))
6198 (gnus-article-prev-page (- lines))))))
6199 (gnus-summary-position-cursor))
6201 (defun gnus-summary-next-same-subject ()
6202 "Select next article which has the same subject as current one."
6204 (gnus-summary-next-article nil (gnus-summary-subject-string)))
6206 (defun gnus-summary-prev-same-subject ()
6207 "Select previous article which has the same subject as current one."
6209 (gnus-summary-prev-article nil (gnus-summary-subject-string)))
6211 (defun gnus-summary-next-unread-same-subject ()
6212 "Select next unread article which has the same subject as current one."
6214 (gnus-summary-next-article t (gnus-summary-subject-string)))
6216 (defun gnus-summary-prev-unread-same-subject ()
6217 "Select previous unread article which has the same subject as current one."
6219 (gnus-summary-prev-article t (gnus-summary-subject-string)))
6221 (defun gnus-summary-first-unread-article ()
6222 "Select the first unread article.
6223 Return nil if there are no unread articles."
6225 (if (gnus-summary-first-subject t)
6226 (gnus-summary-display-article (gnus-summary-article-number))))
6228 (defun gnus-summary-best-unread-article ()
6229 "Select the unread article with the highest score."
6231 (let ((scored gnus-newsgroup-scored)
6235 (or (> best (cdr (car scored)))
6236 (and (memq (setq art (car (car scored))) gnus-newsgroup-unreads)
6237 (not (memq art gnus-newsgroup-marked))
6238 (not (memq art gnus-newsgroup-dormant))
6239 (if (= best (cdr (car scored)))
6240 (setq article (min art article))
6242 (setq best (cdr (car scored))))))
6243 (setq scored (cdr scored)))
6245 (gnus-summary-goto-article article)
6246 (gnus-summary-first-unread-article))))
6248 (defun gnus-summary-goto-article (article &optional all-headers)
6249 "Fetch ARTICLE and display it if it exists.
6250 If ALL-HEADERS is non-nil, no header lines are hidden."
6256 (mapcar (lambda (headers) (list (int-to-string (header-number headers))))
6257 gnus-newsgroup-headers)
6258 nil 'require-match))))
6259 (if (gnus-summary-goto-subject article)
6260 (gnus-summary-display-article article all-headers)))
6262 (defun gnus-summary-goto-last-article ()
6263 "Go to the last article."
6265 (if gnus-last-article
6266 (gnus-summary-goto-article gnus-last-article)))
6268 ;; Summary article oriented commands
6270 (defun gnus-summary-refer-parent-article (n)
6271 "Refer parent article N times.
6272 The difference between N and the number of articles fetched is returned."
6277 (let ((ref (header-references (gnus-get-header-by-number
6278 (gnus-summary-article-number)))))
6279 (if (and ref (not (equal ref ""))
6280 (string-match "<[^<>]*>[ \t]*$" ref))
6281 (gnus-summary-refer-article
6282 (substring ref (match-beginning 0) (match-end 0))))))
6284 (or (zerop n) (message "No references in article or expired article."))
6287 (defun gnus-summary-refer-article (message-id)
6288 "Refer article specified by MESSAGE-ID.
6289 NOTE: This command only works with newsgroup that use NNTP."
6290 (interactive "sMessage-ID: ")
6291 (if (or (not (stringp message-id))
6292 (zerop (length message-id)))
6294 ;; Construct the correct Message-ID if necessary.
6295 ;; Suggested by tale@pawl.rpi.edu.
6296 (or (string-match "^<" message-id)
6297 (setq message-id (concat "<" message-id)))
6298 (or (string-match ">$" message-id)
6299 (setq message-id (concat message-id ">")))
6300 (let ((header (car (gnus-gethash message-id gnus-newsgroup-dependencies))))
6302 (gnus-summary-goto-article (header-number header))
6303 (if (gnus-article-prepare message-id nil (gnus-read-header message-id))
6305 (gnus-summary-insert-line
6306 nil gnus-current-headers 0 nil gnus-read-mark nil nil
6307 (header-subject gnus-current-headers))
6309 (gnus-summary-position-cursor)
6310 (gnus-summary-update-line)
6312 (message "No such references")
6315 (defun gnus-summary-next-digest (nth)
6316 "Move to head of NTH next digested message."
6318 (gnus-summary-select-article)
6319 (gnus-eval-in-buffer-window gnus-article-buffer
6320 (gnus-article-next-digest (or nth 1))
6323 (defun gnus-summary-prev-digest (nth)
6324 "Move to head of NTH previous digested message."
6326 (gnus-summary-select-article)
6327 (gnus-eval-in-buffer-window gnus-article-buffer
6328 (gnus-article-prev-digest (or nth 1))
6331 (defun gnus-summary-rmail-digest ()
6332 "Run RMAIL on current digest article.
6333 gnus-select-digest-hook will be called with no arguments, if that
6334 value is non-nil. It is possible to modify the article so that Rmail
6336 gnus-rmail-digest-hook will be called with no arguments, if that value
6337 is non-nil. The hook is intended to customize Rmail mode."
6339 (gnus-summary-select-article)
6341 (let ((artbuf gnus-article-buffer)
6342 (digbuf (get-buffer-create gnus-digest-buffer))
6343 (mail-header-separator ""))
6345 (gnus-add-current-to-buffer-list)
6346 (buffer-disable-undo (current-buffer))
6347 (setq buffer-read-only nil)
6349 (insert-buffer-substring artbuf)
6350 (run-hooks 'gnus-select-digest-hook)
6351 (gnus-convert-article-to-rmail)
6352 (goto-char (point-min))
6353 ;; Rmail initializations.
6354 (rmail-insert-rmail-file-header)
6356 (rmail-set-message-counters)
6357 (rmail-show-message)
6360 (undigestify-rmail-message)
6361 (rmail-expunge) ;Delete original message.
6362 ;; File name is meaningless but `save-buffer' requires it.
6363 (setq buffer-file-name "Gnus Digest")
6364 (setq mode-line-buffer-identification
6366 (header-subject gnus-current-headers)))
6367 ;; There is no need to write this buffer to a file.
6368 (make-local-variable 'write-file-hooks)
6369 (setq write-file-hooks
6371 (set-buffer-modified-p nil)
6372 (message "(No changes need to be saved)")
6373 'no-need-to-write-this-buffer)))
6374 ;; Default file name saving digest messages.
6375 (setq rmail-default-rmail-file
6376 (funcall gnus-rmail-save-name gnus-newsgroup-name
6377 gnus-current-headers gnus-newsgroup-last-rmail))
6378 (setq rmail-default-file
6379 (funcall gnus-mail-save-name gnus-newsgroup-name
6380 gnus-current-headers gnus-newsgroup-last-mail))
6381 ;; Prevent generating new buffer named ***<N> each time.
6382 (setq rmail-summary-buffer
6383 (get-buffer-create gnus-digest-summary-buffer))
6384 (run-hooks 'gnus-rmail-digest-hook)
6385 ;; Take all windows safely.
6386 (gnus-configure-windows '(1 0 0))
6387 (pop-to-buffer gnus-group-buffer)
6388 ;; Use summary article windows for Digest summary and
6390 (if gnus-digest-show-summary
6391 (let ((gnus-summary-buffer gnus-digest-summary-buffer)
6392 (gnus-article-buffer gnus-digest-buffer))
6393 (gnus-configure-windows 'article)
6394 (pop-to-buffer gnus-digest-buffer)
6396 (pop-to-buffer gnus-digest-summary-buffer)
6397 (message (substitute-command-keys
6398 "Type \\[rmail-summary-quit] to return to Gnus")))
6399 (let ((gnus-summary-buffer gnus-digest-buffer))
6400 (gnus-configure-windows 'summary)
6401 (pop-to-buffer gnus-digest-buffer)
6402 (message (substitute-command-keys
6403 "Type \\[rmail-quit] to return to Gnus")))
6405 ;; Move the buffers to the end of buffer list.
6406 (bury-buffer gnus-article-buffer)
6407 (bury-buffer gnus-group-buffer)
6408 (bury-buffer gnus-digest-summary-buffer)
6409 (bury-buffer gnus-digest-buffer))
6410 (error (set-buffer-modified-p nil)
6411 (kill-buffer digbuf)
6412 ;; This command should not signal an error because the
6413 ;; command is called from hooks.
6414 (ding) (message "Article is not a digest")))
6417 (defun gnus-summary-isearch-article ()
6418 "Do incremental search forward on current article."
6420 (gnus-summary-select-article)
6421 (gnus-eval-in-buffer-window gnus-article-buffer
6424 (defun gnus-summary-search-article-forward (regexp)
6425 "Search for an article containing REGEXP forward.
6426 gnus-select-article-hook is not called during the search."
6429 (concat "Search forward (regexp): "
6430 (if gnus-last-search-regexp
6431 (concat "(default " gnus-last-search-regexp ") "))))))
6432 (if (string-equal regexp "")
6433 (setq regexp (or gnus-last-search-regexp ""))
6434 (setq gnus-last-search-regexp regexp))
6435 (if (gnus-summary-search-article regexp nil)
6436 (gnus-eval-in-buffer-window gnus-article-buffer
6440 (error "Search failed: \"%s\"" regexp)
6443 (defun gnus-summary-search-article-backward (regexp)
6444 "Search for an article containing REGEXP backward.
6445 gnus-select-article-hook is not called during the search."
6448 (concat "Search backward (regexp): "
6449 (if gnus-last-search-regexp
6450 (concat "(default " gnus-last-search-regexp ") "))))))
6451 (if (string-equal regexp "")
6452 (setq regexp (or gnus-last-search-regexp ""))
6453 (setq gnus-last-search-regexp regexp))
6454 (if (gnus-summary-search-article regexp t)
6455 (gnus-eval-in-buffer-window gnus-article-buffer
6459 (error "Search failed: \"%s\"" regexp)
6462 (defun gnus-summary-search-article (regexp &optional backward)
6463 "Search for an article containing REGEXP.
6464 Optional argument BACKWARD means do search for backward.
6465 gnus-select-article-hook is not called during the search."
6466 (let ((gnus-select-article-hook nil) ;Disable hook.
6467 (gnus-mark-article-hook nil) ;Inhibit marking as read.
6470 (function re-search-backward) (function re-search-forward)))
6473 ;; Hidden thread subtrees must be searched for ,too.
6474 (gnus-summary-show-all-threads)
6475 ;; First of all, search current article.
6476 ;; We don't want to read article again from NNTP server nor reset
6478 (gnus-summary-select-article)
6479 (message "Searching article: %d..." gnus-current-article)
6480 (setq last gnus-current-article)
6481 (gnus-eval-in-buffer-window gnus-article-buffer
6484 ;; Begin search from current point.
6485 (setq found (funcall re-search regexp nil t))))
6486 ;; Then search next articles.
6487 (while (and (not found)
6488 (gnus-summary-display-article
6489 (gnus-summary-search-subject backward nil nil)))
6490 (message "Searching article: %d..." gnus-current-article)
6491 (gnus-eval-in-buffer-window gnus-article-buffer
6494 (goto-char (if backward (point-max) (point-min)))
6495 (setq found (funcall re-search regexp nil t)))
6498 ;; Adjust article pointer.
6499 (or (eq last gnus-current-article)
6500 (setq gnus-last-article last))
6501 ;; Return T if found such article.
6505 (defun gnus-summary-execute-command (field regexp command &optional backward)
6506 "If FIELD of article header matches REGEXP, execute a COMMAND string.
6507 If FIELD is an empty string (or nil), entire article body is searched for.
6508 If optional (prefix) argument BACKWARD is non-nil, do backward instead."
6510 (list (let ((completion-ignore-case t))
6511 (completing-read "Field name: "
6512 '(("Number")("Subject")("From")
6513 ("Lines")("Date")("Id")
6514 ("Xref")("References"))
6515 nil 'require-match))
6516 (read-string "Regexp: ")
6517 (read-key-sequence "Command: ")
6518 current-prefix-arg))
6519 ;; Hidden thread subtrees must be searched for ,too.
6520 (gnus-summary-show-all-threads)
6521 ;; We don't want to change current point nor window configuration.
6523 (save-window-excursion
6524 (message "Executing %s..." (key-description command))
6525 ;; We'd like to execute COMMAND interactively so as to give arguments.
6526 (gnus-execute field regexp
6528 (call-interactively '(, (key-binding command)))))
6530 (message "Executing %s... done" (key-description command)))))
6532 (defun gnus-summary-beginning-of-article ()
6533 "Scroll the article back to the beginning."
6535 (gnus-summary-select-article)
6536 (gnus-eval-in-buffer-window gnus-article-buffer
6538 (goto-char (point-min))
6539 (if gnus-break-pages
6540 (gnus-narrow-to-page))
6543 (defun gnus-summary-end-of-article ()
6544 "Scroll to the end of the article."
6546 (gnus-summary-select-article)
6547 (gnus-eval-in-buffer-window gnus-article-buffer
6549 (goto-char (point-max))
6550 (if gnus-break-pages
6551 (gnus-narrow-to-page))
6554 (defun gnus-summary-show-article ()
6555 "Force re-fetching of the current article."
6557 (gnus-summary-select-article gnus-have-all-headers t t))
6559 (defun gnus-summary-toggle-header (arg)
6560 "Show the headers if they are hidden, or hide them if they are shown.
6561 If ARG is a positive number, show the entire header.
6562 If ARG is a negative number, hide the unwanted header lines."
6565 (set-buffer gnus-article-buffer)
6566 (let ((buffer-read-only nil))
6568 (if (> arg 0) (remove-text-properties 1 (point-max) '(invisible t))
6569 (if (< arg 0) (run-hooks 'gnus-article-display-hook)))
6570 (if (text-property-any 1 (point-max) 'invisible t)
6571 (remove-text-properties 1 (point-max) '(invisible t))
6572 (run-hooks 'gnus-article-display-hook))))))
6574 (defun gnus-summary-show-all-headers ()
6575 "Make all header lines visible."
6577 (gnus-article-show-all-headers))
6579 (defun gnus-summary-toggle-mime (arg)
6580 "Toggle MIME processing.
6581 If ARG is a positive number, turn MIME processing on."
6583 (setq gnus-show-mime
6584 (if (null arg) (not gnus-show-mime)
6585 (> (prefix-numeric-value arg) 0)))
6586 (gnus-summary-select-article t 'force))
6588 (defun gnus-summary-caesar-message (rotnum)
6589 "Caesar rotates all letters of current message by 13/47 places.
6590 With prefix arg, specifies the number of places to rotate each letter forward.
6591 Caesar rotates Japanese letters by 47 places in any case."
6593 (gnus-summary-select-article)
6594 (gnus-overload-functions)
6595 (gnus-eval-in-buffer-window gnus-article-buffer
6598 ;; We don't want to jump to the beginning of the message.
6599 ;; `save-excursion' does not do its job.
6600 (move-to-window-line 0)
6601 (let ((last (point)))
6602 (news-caesar-buffer-body rotnum)
6608 (defun gnus-summary-stop-page-breaking ()
6609 "Stop page breaking in the current article."
6611 (gnus-summary-select-article)
6612 (gnus-eval-in-buffer-window gnus-article-buffer (widen)))
6614 ;; Suggested by Brian Edmonds <bedmonds@prodigy.bc.ca>.
6616 (defun gnus-summary-move-article (n &optional to-newsgroup select-method)
6617 "Move the current article to a different newsgroup.
6618 If N is a positive number, move the N next articles.
6619 If N is a negative number, move the N previous articles.
6620 If N is nil and any articles have been marked with the process mark,
6621 move those articles instead.
6622 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to.
6623 If SELECT-METHOD is symbol, do not move to a specific newsgroup, but
6624 re-spool using this method.
6625 For this function to work, both the current newsgroup and the
6626 newsgroup that you want to move to have to support the `request-move'
6627 and `request-accept' functions. (Ie. mail newsgroups at present.)"
6629 (or (gnus-check-backend-function 'request-move-article gnus-newsgroup-name)
6630 (error "The current newsgroup does not support article moving"))
6631 (let (articles art-group)
6632 (if (and n (numberp n))
6633 (let ((backward (< n 0))
6637 (setq articles (cons (gnus-summary-article-number)
6639 (gnus-summary-search-forward nil nil backward))
6641 (setq articles (sort articles (function <))))
6642 (setq articles (or (setq gnus-newsgroup-processable
6643 (sort gnus-newsgroup-processable (function <)))
6644 (list (gnus-summary-article-number)))))
6645 (if (and (not to-newsgroup) (not select-method))
6648 (format "Where do you want to move %s? "
6649 (if (> (length articles) 1)
6650 (format "these %d articles" (length articles))
6652 gnus-active-hashtb nil t)))
6653 (or (gnus-check-backend-function 'request-accept-article
6654 (or select-method to-newsgroup))
6655 (error "%s does not support article moving" to-newsgroup))
6656 (message "Moving to %s: %s..." (or select-method to-newsgroup) articles)
6659 (gnus-request-move-article
6662 (nth 1 (gnus-find-method-for-group gnus-newsgroup-name))
6663 (list 'gnus-request-accept-article
6665 (quote select-method)
6667 (let* ((buffer-read-only nil)
6670 (gnus-gethash (car art-group) gnus-newsrc-hashtb)
6672 (gnus-group-prefixed-name
6674 (if select-method (list select-method "")
6675 (gnus-find-method-for-group to-newsgroup)))
6676 gnus-newsrc-hashtb)))
6677 (info (nth 2 entry))
6678 (article (car articles))
6679 (marked (nth 3 info)))
6680 (gnus-summary-goto-subject article)
6681 (delete-region (progn (beginning-of-line) (point))
6682 (progn (forward-line 1) (point)))
6683 (if (not (memq article gnus-newsgroup-unreads))
6684 (setcar (cdr (cdr info))
6685 (gnus-add-to-range (nth 2 info)
6686 (list (cdr art-group)))))
6687 ;; !!! Here one should copy all the marks over to the new
6688 ;; newsgroup, but I couldn't be bothered. nth on that!
6690 (message "Couldn't move article %s" (car articles)))
6691 (setq articles (cdr articles)))))
6693 (defun gnus-summary-respool-article (n &optional respool-method)
6694 "Respool the current article.
6695 The article will be squeezed through the mail spooling process again,
6696 which means that it will be put in some mail newsgroup or other
6697 depending on `nnmail-split-methods'.
6698 If N is a positive number, respool the N next articles.
6699 If N is a negative number, respool the N previous articles.
6700 If N is nil and any articles have been marked with the process mark,
6701 respool those articles instead.
6702 For this function to work, both the current newsgroup and the
6703 newsgroup that you want to move to have to support the `request-move'
6704 and `request-accept' functions. (Ie. mail newsgroups at present.)"
6707 (setq respool-method
6709 "What method do you want to use when respooling? "
6710 (gnus-methods-using 'respool) nil t)))
6711 (gnus-summary-move-article n nil (intern respool-method)))
6713 ;; Summary score commands.
6715 ;; Suggested by boubaker@cenatls.cena.dgac.fr.
6717 (defun gnus-summary-raise-score (n)
6718 "Raise the score of the current article by N."
6720 (gnus-summary-set-score (+ (gnus-summary-article-score) n)))
6722 (defun gnus-summary-lower-score (n)
6723 "Lower the score of the current article by N."
6725 (gnus-summary-raise-score (- n)))
6727 (defun gnus-summary-set-score (n)
6728 "Set the score of the current article to N."
6730 ;; Skip dummy header line.
6732 (if (= (gnus-summary-article-mark) ?Z) (forward-line 1))
6733 (let ((buffer-read-only nil))
6738 (insert (if (= n gnus-summary-default-score) ?
6739 (if (< n gnus-summary-default-score) ?- ?+))))
6740 (let* ((article (gnus-summary-article-number))
6741 (score (assq article gnus-newsgroup-scored)))
6742 (if score (setcdr score n)
6743 (setq gnus-newsgroup-scored
6744 (cons (cons article n) gnus-newsgroup-scored))))
6745 (gnus-summary-update-line)))
6747 (defmacro gnus-raise (field expression level)
6748 (` (gnus-kill (, field) (, expression)
6749 (function (gnus-summary-raise-score (, level))) t)))
6751 (defmacro gnus-lower (field expression level)
6752 (` (gnus-kill (, field) (, expression)
6753 (function (gnus-summary-raise-score (- (, level)))) t)))
6755 ;; Summary marking commands.
6757 (defun gnus-summary-raise-same-subject-and-select (score)
6758 "Raise articles which has the same subject with SCORE and select the next."
6760 (let ((subject (gnus-summary-subject-string)))
6761 (gnus-summary-raise-score score)
6762 (while (gnus-summary-search-subject nil nil subject)
6763 (gnus-summary-raise-score score))
6764 (gnus-summary-next-article t)))
6766 (defun gnus-summary-raise-same-subject (score)
6767 "Raise articles which has the same subject with SCORE."
6769 (let ((subject (gnus-summary-subject-string)))
6770 (gnus-summary-raise-score score)
6771 (while (gnus-summary-search-subject nil nil subject)
6772 (gnus-summary-raise-score score))
6773 (gnus-summary-next-subject 1 t)))
6775 (defun gnus-summary-raise-thread (score)
6776 "Raise articles under current thread with SCORE."
6780 (let ((level (gnus-summary-thread-level)))
6781 (gnus-summary-raise-score score)
6782 (while (and (zerop (gnus-summary-next-subject 1))
6783 (> (gnus-summary-thread-level) level))
6784 (gnus-summary-raise-score score))
6786 (or (zerop (gnus-summary-next-subject 1 t))
6788 (gnus-summary-position-cursor))
6790 (defun gnus-summary-lower-same-subject-and-select (score)
6791 "Raise articles which has the same subject with SCORE and select the next."
6793 (gnus-summary-raise-same-subject-and-select (- score)))
6795 (defun gnus-summary-lower-same-subject (score)
6796 "Raise articles which has the same subject with SCORE."
6798 (gnus-summary-raise-same-subject (- score)))
6800 (defun gnus-summary-lower-thread (score)
6801 "Raise articles under current thread with SCORE."
6803 (gnus-summary-raise-thread (- score)))
6805 (defun gnus-summary-kill-same-subject-and-select (unmark)
6806 "Mark articles which has the same subject as read, and then select the next.
6807 If UNMARK is positive, remove any kind of mark.
6808 If UNMARK is negative, tick articles."
6811 (setq unmark (prefix-numeric-value unmark)))
6813 (gnus-summary-mark-same-subject
6814 (gnus-summary-subject-string) unmark)))
6815 ;; Select next unread article. If auto-select-same mode, should
6816 ;; select the first unread article.
6817 (gnus-summary-next-article t (and gnus-auto-select-same
6818 (gnus-summary-subject-string)))
6819 (message "%d articles are marked as %s"
6820 count (if unmark "unread" "read"))
6823 (defun gnus-summary-kill-same-subject (unmark)
6824 "Mark articles which has the same subject as read.
6825 If UNMARK is positive, remove any kind of mark.
6826 If UNMARK is negative, tick articles."
6829 (setq unmark (prefix-numeric-value unmark)))
6831 (gnus-summary-mark-same-subject
6832 (gnus-summary-subject-string) unmark)))
6833 ;; If marked as read, go to next unread subject.
6835 ;; Go to next unread subject.
6836 (gnus-summary-next-subject 1 t))
6837 (message "%d articles are marked as %s"
6838 count (if unmark "unread" "read"))
6841 (defun gnus-summary-mark-same-subject (subject &optional unmark)
6842 "Mark articles with same SUBJECT as read, and return marked number.
6843 If optional argument UNMARK is positive, remove any kinds of marks.
6844 If optional argument UNMARK is negative, mark articles as unread instead."
6847 (cond ((null unmark)
6848 (gnus-summary-mark-as-read nil gnus-killed-mark))
6850 (gnus-summary-tick-article nil t))
6852 (gnus-summary-tick-article)))
6854 (gnus-summary-search-forward nil subject))
6855 (cond ((null unmark)
6856 (gnus-summary-mark-as-read nil gnus-killed-mark))
6858 (gnus-summary-tick-article nil t))
6860 (gnus-summary-tick-article)))
6861 (setq count (1+ count))
6863 ;; Hide killed thread subtrees. Does not work properly always.
6864 ;;(and (null unmark)
6865 ;; gnus-thread-hide-killed
6866 ;; (gnus-summary-hide-thread))
6867 ;; Return number of articles marked as read.
6871 (defun gnus-summary-mark-as-processable (n &optional unmark)
6872 "Set the process mark on the next N articles.
6873 If N is negative, mark backward instead. If UNMARK is non-nil, remove
6874 the process mark instead. The difference between N and the actual
6875 number of articles marked is returned."
6877 (let ((backward (< n 0))
6882 (gnus-summary-remove-process-mark (gnus-summary-article-number))
6883 (gnus-summary-set-process-mark (gnus-summary-article-number)))
6884 (zerop (gnus-summary-next-subject (if backward -1 1))))
6886 (if (/= 0 n) (message "No more articles"))
6889 (defun gnus-summary-unmark-as-processable (n)
6890 "Remove the process mark from the next N articles.
6891 If N is negative, mark backward instead. The difference between N and
6892 the actual number of articles marked is returned."
6894 (gnus-summary-mark-as-processable n t))
6896 (defun gnus-summary-unmark-all-processable ()
6897 "Remove the process mark from all articles."
6900 (while gnus-newsgroup-processable
6901 (gnus-summary-remove-process-mark (car gnus-newsgroup-processable))))
6902 (gnus-summary-position-cursor))
6904 (defun gnus-summary-mark-as-expirable (n)
6905 "Mark N articles forward as expirable.
6906 If N is negative, mark backward instead. The difference between N and
6907 the actual number of articles marked is returned."
6909 (gnus-summary-mark-forward n gnus-expirable-mark))
6911 (defun gnus-summary-expire-articles ()
6912 "Expire all articles that are marked as expirable in the current group."
6914 (if (and gnus-newsgroup-expirable
6915 (gnus-check-backend-function
6916 'gnus-request-expire-articles gnus-newsgroup-name))
6917 (let ((expirable gnus-newsgroup-expirable))
6918 ;; The list of articles that weren't expired is returned.
6919 (setq gnus-newsgroup-expirable
6920 (gnus-request-expire-articles gnus-newsgroup-expirable
6921 gnus-newsgroup-name))
6922 ;; We go through the old list of expirable, and mark all
6923 ;; really expired articles as non-existant.
6925 (or (memq (car expirable) gnus-newsgroup-expirable)
6926 (gnus-summary-mark-as-read (car expirable) "%"))
6927 (setq expirable (cdr expirable))))))
6929 ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
6930 (defun gnus-summary-delete-article (n)
6931 "Delete the N next (mail) articles.
6932 This command actually deletes articles. This is not a marking
6933 command. The article will disappear forever from you life, never to
6935 If N is negative, delete backwards.
6936 If N is nil and articles have been marked with the process mark,
6937 delete these instead."
6939 (or (gnus-check-backend-function 'request-expire-articles
6940 gnus-newsgroup-name)
6941 (error "The current newsgroup does not support article deletion."))
6942 ;; Compute the list of articles to delete.
6944 (if (and n (numberp n))
6945 (let ((backward (< n 0))
6949 (setq articles (cons (gnus-summary-article-number)
6951 (gnus-summary-search-forward nil nil backward))
6953 (setq articles (sort articles (function <))))
6954 (setq articles (or (setq gnus-newsgroup-processable
6955 (sort gnus-newsgroup-processable (function <)))
6956 (list (gnus-summary-article-number)))))
6957 (if (and gnus-novice-user
6959 (format "Do you really want to delete %s forever?"
6960 (if (> (length articles) 1) "these articles"
6963 ;; Delete the articles.
6964 (setq gnus-newsgroup-expirable
6965 (gnus-request-expire-articles
6966 articles gnus-newsgroup-name 'force)))))
6968 (defun gnus-summary-mark-article-as-replied (article)
6969 "Mark ARTICLE replied and update the summary line."
6970 (setq gnus-newsgroup-replied (cons article gnus-newsgroup-replied))
6971 (let ((buffer-read-only nil))
6972 (if (gnus-summary-goto-subject article)
6977 (insert gnus-replied-mark)
6980 (defun gnus-summary-set-bookmark (article)
6981 "Set a bookmark in current article."
6982 (interactive (list (gnus-summary-article-number)))
6983 (if (or (not (get-buffer gnus-article-buffer))
6984 (not gnus-current-article)
6985 (not gnus-article-current)
6986 (not (equal gnus-newsgroup-name (car gnus-article-current))))
6987 (error "No current article selected"))
6988 ;; Remove old bookmark, if one exists.
6989 (let ((old (assq article gnus-newsgroup-bookmarks)))
6990 (if old (setq gnus-newsgroup-bookmarks
6991 (delq old gnus-newsgroup-bookmarks))))
6992 ;; Set the new bookmark, which is on the form
6993 ;; (article-number . line-number-in-body).
6994 (setq gnus-newsgroup-bookmarks
6998 (set-buffer gnus-article-buffer)
7003 (search-forward "\n\n" nil t)
7006 gnus-newsgroup-bookmarks))
7007 (message "A bookmark has been added to the current article."))
7009 (defun gnus-summary-remove-bookmark (article)
7010 "Remove the bookmark from the current article."
7011 (interactive (list (gnus-summary-article-number)))
7012 ;; Remove old bookmark, if one exists.
7013 (let ((old (assq article gnus-newsgroup-bookmarks)))
7016 (setq gnus-newsgroup-bookmarks
7017 (delq old gnus-newsgroup-bookmarks))
7018 (message "Removed bookmark."))
7019 (message "No bookmark in current article."))))
7021 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
7022 (defun gnus-summary-mark-as-dormant (n)
7023 "Mark N articles forward as dormant.
7024 If N is negative, mark backward instead. The difference between N and
7025 the actual number of articles marked is returned."
7027 (gnus-summary-mark-forward n gnus-dormant-mark))
7029 (defun gnus-summary-set-process-mark (article)
7030 "Set the process mark on ARTICLE and update the summary line."
7031 (setq gnus-newsgroup-processable (cons article gnus-newsgroup-processable))
7032 (let ((buffer-read-only nil))
7033 (if (gnus-summary-goto-subject article)
7035 (if (= (gnus-summary-article-mark) ?Z) (forward-line 1))
7039 (insert gnus-process-mark)
7040 (gnus-summary-update-line)
7043 (defun gnus-summary-remove-process-mark (article)
7044 "Remove the process mark from ARTICLE and update the summary line."
7045 (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable))
7046 (let ((buffer-read-only nil))
7047 (if (gnus-summary-goto-subject article)
7049 (and (= (gnus-summary-article-mark) ?Z) (forward-line 1))
7053 (insert (if (memq article gnus-newsgroup-replied)
7054 gnus-replied-mark ? ))
7055 (gnus-summary-update-line)
7058 (defun gnus-summary-mark-forward (n &optional mark)
7059 "Mark N articles as read forwards.
7060 If N is negative, mark backwards instead.
7061 Mark with MARK. If MARK is ? , ?! or ??, articles will be
7063 The difference between N and the actual number of articles marked is
7066 (let ((backward (< n 0))
7068 (mark (or mark gnus-read-mark)))
7070 (gnus-summary-mark-article nil mark)
7071 (zerop (gnus-summary-next-subject (if backward -1 1))))
7073 (if (/= 0 n) (message "No more %sarticles" (if mark "" "unread ")))
7074 (gnus-set-mode-line 'summary)
7077 (defun gnus-summary-mark-article (&optional article mark)
7078 "Mark ARTICLE with MARK.
7079 MARK can be any character.
7080 Five MARK strings are reserved: ? (unread),
7081 ?! (ticked), ?? (dormant), ?D (read), ?E (expirable).
7082 If MARK is nil, then the default character ?D is used.
7083 If ARTICLE is nil, then the article on the current line will be
7085 ;; If no mark is given, then we check auto-expiring.
7087 (and (numberp mark) (= mark gnus-killed-mark)))
7088 (and gnus-newsgroup-auto-expire (setq mark gnus-expirable-mark)))
7089 (let* ((buffer-read-only nil)
7090 (mark (or (and (stringp mark) (aref mark 0)) mark gnus-read-mark))
7091 (article (or article (gnus-summary-article-number))))
7092 (if (or (= mark gnus-unread-mark)
7093 (= mark gnus-ticked-mark)
7094 (= mark gnus-dormant-mark))
7095 (gnus-mark-article-as-unread article mark)
7096 (gnus-mark-article-as-read article mark))
7097 (if (gnus-summary-goto-subject article)
7099 (gnus-summary-show-thread)
7101 (if (= (gnus-summary-article-mark) ?Z) (forward-line 1))
7103 (let ((plist (text-properties-at (point))))
7105 (setcar (cdr (memq 'gnus-mark plist)) mark)
7107 (add-text-properties (1- (point)) (point) plist))
7110 (defun gnus-mark-article-as-read (article &optional mark)
7111 "Enter ARTICLE in the pertinent lists and remove it from others."
7112 ;; Make the article expirable.
7113 (let ((mark (or (and (stringp mark) (aref mark 0)) mark gnus-read-mark)))
7114 (if (= mark gnus-expirable-mark)
7115 (setq gnus-newsgroup-expirable (cons article gnus-newsgroup-expirable))
7116 (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)))
7117 ;; Remove from unread and marked lists.
7118 (setq gnus-newsgroup-unreads
7119 (delq article gnus-newsgroup-unreads))
7120 (setq gnus-newsgroup-marked
7121 (delq article gnus-newsgroup-marked))
7122 (setq gnus-newsgroup-dormant
7123 (delq article gnus-newsgroup-dormant))))
7125 (defun gnus-mark-article-as-unread (article &optional mark)
7126 "Enter ARTICLE in the pertinent lists and remove it from others."
7127 (let ((mark (or (and (stringp mark) (aref mark 0)) mark gnus-ticked-mark)))
7128 ;; Add to unread list.
7129 (or (memq article gnus-newsgroup-unreads)
7130 (setq gnus-newsgroup-unreads
7131 (cons article gnus-newsgroup-unreads)))
7132 ;; If CLEAR-MARK is non-nil, the article must be removed from marked
7133 ;; list. Otherwise, it must be added to the list.
7134 (setq gnus-newsgroup-marked
7135 (delq article gnus-newsgroup-marked))
7136 (setq gnus-newsgroup-dormant
7137 (delq article gnus-newsgroup-dormant))
7138 (setq gnus-newsgroup-expirable
7139 (delq article gnus-newsgroup-expirable))
7140 (if (= mark gnus-ticked-mark)
7141 (setq gnus-newsgroup-marked
7142 (cons article gnus-newsgroup-marked)))
7143 (if (= mark gnus-dormant-mark)
7144 (setq gnus-newsgroup-dormant
7145 (cons article gnus-newsgroup-dormant)))))
7147 (defalias 'gnus-summary-mark-as-unread-forward
7148 'gnus-summary-tick-article-forward)
7149 (make-obsolete 'gnus-summary-mark-as-unread-forward
7150 'gnus-summary-tick-article--forward)
7151 (defun gnus-summary-tick-article-forward (n)
7152 "Tick N articles forwards.
7153 If N is negative, tick backwards instead.
7154 The difference between N and the number of articles ticked is returned."
7156 (gnus-summary-mark-forward n gnus-ticked-mark))
7158 (defalias 'gnus-summary-mark-as-unread-backward 'gnus-summary-tick-article-backward)
7159 (make-obsolete 'gnus-summary-mark-as-unread-backward 'gnus-summary-tick-article-backward)
7160 (defun gnus-summary-tick-article-backward (n)
7161 "Tick N articles backwards.
7162 The difference between N and the number of articles ticked is returned."
7164 (gnus-summary-mark-forward (- n) gnus-ticked-mark))
7166 (defalias 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
7167 (make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
7168 (defun gnus-summary-tick-article (&optional article clear-mark)
7169 "Mark current article as unread.
7170 Optional 1st argument ARTICLE specifies article number to be marked as unread.
7171 Optional 2nd argument CLEAR-MARK remove any kinds of mark."
7172 (gnus-summary-mark-article article (if clear-mark gnus-unread-mark
7175 (defun gnus-summary-mark-as-read-forward (n)
7176 "Mark N articles as read forwards.
7177 If N is negative, mark backwards instead.
7178 The difference between N and the actual number of articles marked is
7181 (gnus-summary-mark-forward n))
7183 (defun gnus-summary-mark-as-read-backward (n)
7184 "Mark the N articles as read backwards.
7185 The difference between N and the actual number of articles marked is
7188 (gnus-summary-mark-forward (- n)))
7190 (defun gnus-summary-mark-as-read (&optional article mark)
7191 "Mark current article as read.
7192 ARTICLE specifies the article to be marked as read.
7193 MARK specifies a string to be inserted at the beginning of the line.
7194 Any kind of string (length 1) except for a space and `-' is ok."
7195 (gnus-summary-mark-article article mark))
7197 (defun gnus-summary-clear-mark-forward (n)
7198 "Clear marks from N articles forward.
7199 If N is negative, clear backward instead.
7200 The difference between N and the number of marks cleared is returned."
7202 (gnus-summary-mark-forward n gnus-unread-mark))
7204 (defun gnus-summary-clear-mark-backward (n)
7205 "Clear marks from N articles backward.
7206 The difference between N and the number of marks cleared is returned."
7208 (gnus-summary-mark-forward (- n) gnus-unread-mark))
7210 ;; Fix by Per Abrahamsen <amanda@iesd.auc.dk>.
7211 (defalias 'gnus-summary-delete-marked-as-read
7212 'gnus-summary-remove-lines-marked-as-read)
7213 (make-obsolete 'gnus-summary-delete-marked-as-read
7214 'gnus-summary-remove-lines-marked-as-read)
7215 (defun gnus-summary-remove-lines-marked-as-read ()
7216 "Remove lines that are marked as read."
7218 (gnus-summary-remove-lines-marked-with
7220 (lambda (char) (char-to-string (symbol-value char)))
7222 gnus-killed-mark gnus-kill-file-mark
7223 gnus-low-score-mark gnus-expirable-mark)
7226 (defalias 'gnus-summary-delete-marked-with
7227 'gnus-summary-remove-lines-marked-with)
7228 (make-obsolete 'gnus-summary-delete-marked-with
7229 'gnus-summary-remove-lines-marked-with)
7230 ;; Rewrite by Daniel Quinlan <quinlan@best.com>.
7231 (defun gnus-summary-remove-lines-marked-with (marks)
7232 "Remove lines that are marked with MARKS (e.g. \"DK\")."
7233 (interactive "sMarks: ")
7234 ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>.
7236 (set-buffer gnus-summary-buffer)
7237 (let ((buffer-read-only nil)
7238 (marks (concat "^[" marks "]"))
7240 (goto-char (point-min))
7241 (while (search-forward-regexp marks (point-max) t)
7246 ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>
7247 (append-to-buffer gnus-newsgroup-expunged-buffer beg (point))
7248 (delete-region beg (point)))))
7249 (or (zerop (buffer-size))
7251 (gnus-summary-prev-subject 1)
7252 (gnus-summary-position-cursor)))))
7254 (defun gnus-summary-expunge-below (score)
7255 "Remove articles with score less than SCORE."
7257 (setq score (if score
7258 (prefix-numeric-value score)
7259 gnus-summary-default-score))
7261 (set-buffer gnus-summary-buffer)
7262 (goto-char (point-min))
7263 (let ((buffer-read-only nil)
7266 (if (< (gnus-summary-article-score) score)
7270 (append-to-buffer gnus-newsgroup-expunged-buffer beg (point))
7271 (delete-region beg (point)))
7274 (or (zerop (buffer-size))
7276 (gnus-summary-prev-subject 1)
7277 (gnus-summary-position-cursor))))))
7279 (defun gnus-summary-mark-below (score mark)
7280 "Mark articles with score less than SCORE with MARK."
7281 (interactive "P\ncMark: ")
7282 (setq score (if score
7283 (prefix-numeric-value score)
7284 gnus-summary-default-score))
7286 (set-buffer gnus-summary-buffer)
7287 (goto-char (point-min))
7289 (if (< (gnus-summary-article-score) score)
7291 (gnus-summary-mark-article nil (char-to-string mark))
7293 (forward-line 1)))))
7295 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
7296 (defun gnus-summary-set-mark-below (score)
7297 "Automatically mark articles with score below SCORE as read."
7299 (setq score (if score
7300 (prefix-numeric-value score)
7301 gnus-summary-default-score))
7302 (setq gnus-summary-mark-below score)
7303 (gnus-summary-update-lines))
7305 (defun gnus-summary-kill-below (score)
7306 "Mark articles with score below SCORE as read."
7308 (gnus-summary-mark-below score gnus-killed-mark))
7310 (defun gnus-summary-clear-above (score)
7311 "Clear all marks from articles with score above SCORE."
7313 (gnus-summary-mark-above score gnus-unread-mark))
7315 (defun gnus-summary-tick-above (score)
7316 "Tick all articles with score above SCORE."
7318 (gnus-summary-mark-above score gnus-ticked-mark))
7320 (defun gnus-summary-mark-above (score mark)
7321 "Mark articles with score less than SCORE with MARK."
7322 (interactive "P\ncMark: ")
7323 (setq score (if score
7324 (prefix-numeric-value score)
7325 gnus-summary-default-score))
7327 (set-buffer gnus-summary-buffer)
7328 (goto-char (point-min))
7330 (if (> (gnus-summary-article-score) score)
7332 (gnus-summary-mark-article nil mark)
7334 (forward-line 1)))))
7336 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
7337 (defun gnus-summary-show-all-expunged ()
7338 "Show all previously expunge articles."
7340 (let ((buffer-read-only nil))
7342 (if (and gnus-newsgroup-expunged-buffer
7344 (set-buffer gnus-newsgroup-expunged-buffer)
7345 (not (zerop (buffer-size)))))
7347 (append-to-buffer gnus-summary-buffer (point-min) (point-max))
7349 (error "No lines expunged")))))
7351 (defun gnus-summary-show-all-dormant ()
7352 "Display all the hidden articles that are marked as dormant."
7354 (let ((int gnus-newsgroup-dormant-subjects)
7355 (buffer-read-only nil))
7357 (error "No dormant articles hidden."))
7358 (goto-char (point-min))
7361 (insert (cdr (car int)))
7362 (setq int (cdr int))))
7363 (gnus-summary-position-cursor)
7364 (setq gnus-newsgroup-dormant-subjects nil)))
7366 (defun gnus-summary-catchup (all &optional quietly to-here)
7367 "Mark all articles not marked as unread in this newsgroup as read.
7368 If prefix argument ALL is non-nil, all articles are marked as read.
7369 If QUIETLY is non-nil, no questions will be asked.
7370 If TO-HERE is non-nil, it should be a point in the buffer. All
7371 articles before this point will be marked as read.
7372 The number of articles marked as read is returned."
7375 (not gnus-interactive-catchup) ;Without confirmation?
7379 "Mark absolutely all articles as read? "
7380 "Mark all unread articles as read? ")))
7381 (let ((unreads (length gnus-newsgroup-unreads)))
7382 (if (gnus-summary-first-subject (not all))
7383 (while (and (gnus-summary-mark-as-read nil gnus-catchup-mark)
7384 (if to-here (< (point) to-here) t)
7385 (gnus-summary-search-subject nil (not all)))))
7386 (- unreads (length gnus-newsgroup-unreads)))))
7388 (defun gnus-summary-catchup-to-here (&optional all)
7389 "Mark all unticked articles before the current one as read.
7390 If ALL is non-nil, also mark ticked and dormant articles as read."
7393 (gnus-summary-catchup all nil (point))
7394 (gnus-summary-position-cursor))
7396 (defun gnus-summary-catchup-all (&optional quietly)
7397 "Mark all articles in this newsgroup as read."
7399 (gnus-summary-catchup t quietly))
7401 (defun gnus-summary-catchup-and-exit (all &optional quietly)
7402 "Mark all articles not marked as unread in this newsgroup as read, then exit.
7403 If prefix argument ALL is non-nil, all articles are marked as read."
7405 (gnus-summary-catchup all quietly)
7406 ;; Select next newsgroup or exit.
7407 (if (eq gnus-auto-select-next 'quietly)
7408 (gnus-summary-next-group nil)
7409 (gnus-summary-exit)))
7411 (defun gnus-summary-catchup-all-and-exit (&optional quietly)
7412 "Mark all articles in this newsgroup as read, and then exit."
7414 (gnus-summary-catchup-and-exit t quietly))
7416 ;; Thread-based commands.
7418 (defun gnus-summary-toggle-threads (arg)
7419 "Toggle showing conversation threads.
7420 If ARG is positive number, turn showing conversation threads on."
7422 (let ((current (gnus-summary-article-number)))
7423 (setq gnus-show-threads
7424 (if (null arg) (not gnus-show-threads)
7425 (> (prefix-numeric-value arg) 0)))
7426 (gnus-summary-prepare)
7427 (gnus-summary-goto-subject current)))
7429 (defun gnus-summary-show-all-threads ()
7432 (if gnus-show-threads
7434 (let ((buffer-read-only nil))
7435 (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)))))
7437 (defun gnus-summary-show-thread ()
7438 "Show thread subtrees."
7440 (if gnus-show-threads
7442 (let ((buffer-read-only nil))
7443 (subst-char-in-region
7444 (progn (beginning-of-line) (point))
7445 (progn (end-of-line) (point)) ?\^M ?\n t)))))
7447 (defun gnus-summary-hide-all-threads ()
7448 "Hide all thread subtrees."
7450 (if gnus-show-threads
7452 (goto-char (point-min))
7453 (gnus-summary-hide-thread)
7454 (while (gnus-summary-search-forward)
7455 (gnus-summary-hide-thread)))))
7457 (defun gnus-summary-hide-thread ()
7458 "Hide thread subtrees."
7460 (if gnus-show-threads
7462 (let ((buffer-read-only nil)
7464 (level (gnus-summary-thread-level))
7466 ;; Go forward until either the buffer ends or the subthread
7468 (while (and (zerop (forward-line 1))
7469 (> (gnus-summary-thread-level) level))
7471 (subst-char-in-region start end ?\n ?\^M t)))))
7473 (defun gnus-summary-go-to-next-thread (&optional previous)
7474 "Go to the same level (or less) next thread.
7475 If PREVIOUS is non-nil, go to previous thread instead.
7476 Return the article number moved to, or nil if moving was impossible."
7477 (let ((level (gnus-summary-thread-level))
7478 (article (gnus-summary-article-number)))
7480 (while (and (zerop (gnus-summary-prev-subject 1))
7481 (> (gnus-summary-thread-level) level)))
7482 (while (and (zerop (gnus-summary-next-subject 1))
7483 (> (gnus-summary-thread-level) level))))
7484 (let ((oart (gnus-summary-article-number)))
7485 (and (/= oart article) oart))))
7487 (defun gnus-summary-next-thread (n)
7488 "Go to the same level next N'th thread.
7489 If N is negative, search backward instead.
7490 Returns the difference between N and the number of skips actually
7493 (let ((backward (< n 0))
7496 (gnus-summary-go-to-next-thread backward))
7498 (gnus-summary-position-cursor)
7499 (if (/= 0 n) (message "No more threads" ))
7502 (defun gnus-summary-prev-thread (n)
7503 "Go to the same level previous N'th thread.
7504 Returns the difference between N and the number of skips actually
7507 (gnus-summary-next-thread (- n)))
7509 (defun gnus-summary-go-down-thread (&optional same)
7510 "Go down one level in the current thread.
7511 If SAME is non-nil, also move to articles of the same level."
7512 (let ((level (gnus-summary-thread-level))
7514 (if (and (zerop (forward-line 1))
7515 (> (gnus-summary-thread-level) level))
7520 (defun gnus-summary-go-up-thread ()
7521 "Go up one level in the current thread."
7522 (let ((level (gnus-summary-thread-level))
7524 (while (and (zerop (forward-line -1))
7525 (>= (gnus-summary-thread-level) level)))
7526 (if (>= (gnus-summary-thread-level) level)
7532 (defun gnus-summary-down-thread (n)
7533 "Go down thread N steps.
7534 If N is negative, go up instead.
7535 Returns the difference between N and how many steps down that were
7541 (if up (gnus-summary-go-up-thread)
7542 (gnus-summary-go-down-thread)))
7544 (gnus-summary-position-cursor)
7545 (if (/= 0 n) (message "Can't go further" ))
7548 (defun gnus-summary-up-thread (n)
7549 "Go up thread N steps.
7550 If N is negative, go up instead.
7551 Returns the difference between N and how many steps down that were
7554 (gnus-summary-down-thread (- n)))
7556 (defun gnus-summary-kill-thread (unmark)
7557 "Mark articles under current thread as read.
7558 If the prefix argument is positive, remove any kinds of marks.
7559 If the prefix argument is negative, tick articles instead."
7562 (setq unmark (prefix-numeric-value unmark)))
7564 (level (gnus-summary-thread-level)))
7567 ;; Mark the article...
7568 (cond ((null unmark) (gnus-summary-mark-as-read nil gnus-killed-mark))
7569 ((> unmark 0) (gnus-summary-tick-article nil t))
7570 (t (gnus-summary-tick-article)))
7571 ;; ...and go forward until either the buffer ends or the subtree
7573 (if (not (and (zerop (forward-line 1))
7574 (> (gnus-summary-thread-level) level)))
7575 (setq killing nil))))
7576 ;; Hide killed subtrees.
7578 gnus-thread-hide-killed
7579 (gnus-summary-hide-thread))
7580 ;; If marked as read, go to next unread subject.
7582 ;; Go to next unread subject.
7583 (gnus-summary-next-subject 1 t)))
7584 (gnus-set-mode-line 'summary))
7586 ;; Summary sorting commands
7588 (defun gnus-summary-sort-by-number (reverse)
7589 "Sort summary buffer by article number.
7590 Argument REVERSE means reverse order."
7592 (gnus-summary-sort 'gnus-summary-article-number reverse))
7594 (defun gnus-summary-sort-by-author (reverse)
7595 "Sort summary buffer by author name alphabetically.
7596 If case-fold-search is non-nil, case of letters is ignored.
7597 Argument REVERSE means reverse order."
7601 (let ((extract (gnus-extract-address-components
7602 (header-from (gnus-get-header-by-number
7603 (gnus-summary-article-number))))))
7604 (or (car extract) (cdr extract))))
7607 (defun gnus-summary-sort-by-subject (reverse)
7608 "Sort summary buffer by subject alphabetically. `Re:'s are ignored.
7609 If case-fold-search is non-nil, case of letters is ignored.
7610 Argument REVERSE means reverse order."
7614 (downcase (gnus-simplify-subject (gnus-summary-subject-string))))
7617 (defun gnus-summary-sort-by-date (reverse)
7618 "Sort summary buffer by date.
7619 Argument REVERSE means reverse order."
7624 (header-date (gnus-get-header-by-number (gnus-summary-article-number)))))
7627 (defun gnus-summary-sort-by-score (reverse)
7628 "Sort summary buffer by score.
7629 Argument REVERSE means reverse order."
7631 (gnus-summary-sort 'gnus-summary-article-score (not reverse)))
7633 (defun gnus-summary-sort (predicate reverse)
7634 ;; Sort summary buffer by PREDICATE. REVERSE means reverse order.
7635 (let (buffer-read-only)
7636 (goto-char (point-min))
7637 (sort-subr reverse 'forward-line 'end-of-line predicate)))
7639 (defun gnus-sortable-date (date)
7640 "Make sortable string by string-lessp from DATE.
7641 Timezone package is used."
7642 (let* ((date (timezone-fix-time date nil nil)) ;[Y M D H M S]
7643 (year (aref date 0))
7644 (month (aref date 1))
7645 (day (aref date 2)))
7646 (timezone-make-sortable-date year month day
7647 (timezone-make-time-string
7648 (aref date 3) (aref date 4) (aref date 5)))
7652 ;; Summary saving commands.
7654 (defun gnus-summary-save-article (n)
7655 "Save the current article using the default saver function.
7656 If N is a positive number, save the N next articles.
7657 If N is a negative number, save the N previous articles.
7658 If N is nil and any articles have been marked with the process mark,
7659 save those articles instead.
7660 The variable `gnus-default-article-saver' specifies the saver function."
7662 (let (articles process)
7663 (if (and n (numberp n))
7664 (let ((backward (< n 0))
7668 (setq articles (cons (gnus-summary-article-number)
7670 (gnus-summary-search-forward nil nil backward))
7672 (setq articles (sort articles (function <))))
7673 (if gnus-newsgroup-processable
7675 (setq articles (setq gnus-newsgroup-processable
7676 (nreverse gnus-newsgroup-processable)))
7678 (setq articles (list (gnus-summary-article-number)))))
7680 (let ((header (gnus-gethash (int-to-string (car articles))
7681 gnus-newsgroup-headers-hashtb-by-number)))
7682 (if (vectorp header)
7684 (gnus-summary-display-article (car articles) t)
7685 (if (not gnus-save-all-headers)
7686 (gnus-article-hide-headers t))
7687 (if gnus-default-article-saver
7688 (funcall gnus-default-article-saver)
7689 (error "No default saver is defined.")))
7690 (if (assq 'name header)
7691 (gnus-copy-file (cdr (assq 'name header)))
7692 (message "Article %d is unsaveable" (car articles)))))
7694 (gnus-summary-remove-process-mark (car articles)))
7695 (setq articles (cdr articles)))
7696 (if process (setq gnus-newsgroup-processable
7697 (nreverse gnus-newsgroup-processable)))
7698 (gnus-summary-position-cursor)
7701 (defun gnus-summary-pipe-output (arg)
7702 "Pipe the current article to a subprocess.
7703 If N is a positive number, pipe the N next articles.
7704 If N is a negative number, pipe the N previous articles.
7705 If N is nil and any articles have been marked with the process mark,
7706 pipe those articles instead."
7708 (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe))
7709 (gnus-summary-save-article arg)))
7711 (defun gnus-summary-save-article-mail (arg)
7712 "Append the current article to an mail file.
7713 If N is a positive number, save the N next articles.
7714 If N is a negative number, save the N previous articles.
7715 If N is nil and any articles have been marked with the process mark,
7716 save those articles instead."
7718 (let ((gnus-default-article-saver 'gnus-summary-save-in-mail))
7719 (gnus-summary-save-article arg)))
7721 (defun gnus-summary-save-in-rmail (&optional filename)
7722 "Append this article to Rmail file.
7723 Optional argument FILENAME specifies file name.
7724 Directory to save to is default to `gnus-article-save-directory' which
7725 is initialized from the SAVEDIR environment variable."
7728 (funcall gnus-rmail-save-name gnus-newsgroup-name
7729 gnus-current-headers gnus-newsgroup-last-rmail)))
7733 (concat "Save article in rmail file: (default "
7734 (file-name-nondirectory default-name) ") ")
7735 (file-name-directory default-name)
7737 (gnus-make-directory (file-name-directory filename))
7738 (gnus-eval-in-buffer-window
7743 (gnus-output-to-rmail filename))))
7744 ;; Remember the directory name to save articles.
7745 (setq gnus-newsgroup-last-rmail filename)))
7747 (defun gnus-summary-save-in-mail (&optional filename)
7748 "Append this article to Unix mail file.
7749 Optional argument FILENAME specifies file name.
7750 Directory to save to is default to `gnus-article-save-directory' which
7751 is initialized from the SAVEDIR environment variable."
7754 (funcall gnus-mail-save-name gnus-newsgroup-name
7755 gnus-current-headers gnus-newsgroup-last-mail)))
7759 (concat "Save article in Unix mail file: (default "
7760 (file-name-nondirectory default-name) ") ")
7761 (file-name-directory default-name)
7764 (expand-file-name filename
7766 (file-name-directory default-name))))
7767 (gnus-make-directory (file-name-directory filename))
7768 (gnus-eval-in-buffer-window
7773 (if (and (file-readable-p filename) (rmail-file-p filename))
7774 (gnus-output-to-rmail filename)
7775 (rmail-output filename 1 t t)))))
7776 ;; Remember the directory name to save articles.
7777 (setq gnus-newsgroup-last-mail filename)))
7779 (defun gnus-summary-save-in-file (&optional filename)
7780 "Append this article to file.
7781 Optional argument FILENAME specifies file name.
7782 Directory to save to is default to `gnus-article-save-directory' which
7783 is initialized from the SAVEDIR environment variable."
7786 (funcall gnus-file-save-name gnus-newsgroup-name
7787 gnus-current-headers gnus-newsgroup-last-file)))
7791 (concat "Save article in file: (default "
7792 (file-name-nondirectory default-name) ") ")
7793 (file-name-directory default-name)
7795 (gnus-make-directory (file-name-directory filename))
7796 (gnus-eval-in-buffer-window
7801 (gnus-output-to-file filename))))
7802 ;; Remember the directory name to save articles.
7803 (setq gnus-newsgroup-last-file filename)))
7805 (defun gnus-summary-save-in-pipe (&optional command)
7806 "Pipe this article to subprocess."
7808 (let ((command (read-string "Shell command on article: "
7809 gnus-last-shell-command)))
7810 (if (string-equal command "")
7811 (setq command gnus-last-shell-command))
7812 (gnus-eval-in-buffer-window
7816 (shell-command-on-region (point-min) (point-max) command nil)))
7817 (setq gnus-last-shell-command command)))
7819 ;; Summary extract commands
7821 (defun gnus-summary-insert-pseudos (pslist)
7822 (let ((buffer-read-only nil)
7823 (article (gnus-summary-article-number))
7825 (or (gnus-summary-goto-subject article)
7826 (error (format "No such article: %d" article)))
7827 (gnus-summary-position-cursor)
7832 (insert " " (file-name-nondirectory
7833 (cdr (assq 'name (car pslist))))
7834 ": " (or (cdr (assq 'execute (car pslist))) "") "\n")
7835 (add-text-properties
7836 b (1+ b) (list 'gnus-subject (cdr (assq 'name (car pslist)))
7837 'gnus-number gnus-reffed-article-number
7838 'gnus-mark gnus-unread-mark
7839 'gnus-pseudo (car pslist)
7841 (gnus-sethash (int-to-string gnus-reffed-article-number)
7842 (car pslist) gnus-newsgroup-headers-hashtb-by-number)
7843 (setq gnus-reffed-article-number (1- gnus-reffed-article-number))
7844 (setq pslist (cdr pslist))))))
7846 (defun gnus-request-pseudo-article (props)
7847 (cond ((assq 'execute props)
7848 (gnus-execute-command (cdr (assq 'execute props))))
7849 ((assq 'digest props)
7852 (let ((gnus-current-article (gnus-summary-article-number)))
7853 (run-hooks 'gnus-mark-article-hook)))
7855 (defun gnus-execute-command (command)
7857 (gnus-article-setup-buffer)
7858 (set-buffer gnus-article-buffer)
7859 (let ((command (read-string "Command: " command))
7860 (buffer-read-only nil))
7862 (insert "$ " command "\n\n")
7863 (if gnus-view-pseudo-asynchronously
7864 (start-process "gnus-execute" nil "sh" "-c" command)
7865 (call-process "sh" nil t nil "-c" command)))))
7867 (defun gnus-copy-file (file &optional to)
7870 (list (read-file-name "Copy file: " default-directory)
7871 (read-file-name "Copy file to: " default-directory)))
7872 (or to (setq to (read-file-name "Copy file to: " default-directory)))
7873 (and (file-directory-p to)
7874 (setq to (concat (file-name-as-directory to)
7875 (file-name-nondirectory file))))
7876 (copy-file file to))
7878 ;; Summary score file commands
7880 ;; Much modification of the kill (ahem, score) code and lots of the
7881 ;; functions are written by Per Abrahamsen <amanda@iesd.auc.dk>.
7883 (defun gnus-summary-header (header)
7884 ;; Return HEADER for current articles, or error.
7885 (let ((article (gnus-summary-article-number)))
7887 (aref (gnus-get-header-by-number article)
7888 (nth 1 (assoc header gnus-header-index)))
7889 (error "No article on current line"))))
7891 (defun gnus-summary-score-entry (header match type score date &optional prompt)
7892 "Enter score file entry.
7893 HEADER is the header being scored.
7894 MATCH is the string we are looking for.
7895 TYPE is a flag indicating if it is a regexp or substring.
7896 SCORE is the score to add.
7897 DATE is the expire date."
7898 (interactive (list (completing-read "Header: "
7900 (lambda (x) (fboundp (nth 2 x)))
7902 (read-string "Match: ")
7903 (y-or-n-p "Use regexp match? ")
7904 (prefix-numeric-value current-prefix-arg)
7905 (if (y-or-n-p "Expire kill? ")
7906 (current-time-string)
7910 (setq match (read-string "Match: " match)))
7911 (let ((score (or score gnus-score-interactive-default-score)))
7912 (gnus-summary-score-effect header match type score)
7914 (gnus-summary-score-effect header match type score)
7915 (gnus-score-set header
7916 (cons (list match type score date)
7917 (gnus-score-get header)))
7918 (gnus-score-set 'touched t)))
7920 (defun gnus-summary-score-effect (header match type score)
7921 "Simulate the effect of a score file entry.
7922 HEADER is the header being scored.
7923 MATCH is the string we are looking for.
7924 TYPE is a flag indicating if it is a regexp or substring.
7925 SCORE is the score to add."
7926 (interactive (list (completing-read "Header: "
7928 (lambda (x) (fboundp (nth 2 x)))
7930 (read-string "Match: ")
7931 (y-or-n-p "Use regexp match? ")
7932 (prefix-numeric-value current-prefix-arg)))
7934 (or (and (stringp match) (> (length match) 0))
7936 (goto-char (point-min))
7937 (let ((regexp (if type
7939 (concat "\\`.*" (regexp-quote match) ".*\\'"))))
7941 (let ((content (gnus-summary-header header))
7942 (case-fold-search t))
7944 (if (string-match regexp content)
7945 (gnus-summary-raise-score score))))
7946 (beginning-of-line 2)))))
7948 (defun gnus-summary-score-crossposting (score date)
7949 ;; Enter score file entry for current crossposting.
7950 ;; SCORE is the score to add.
7951 ;; DATE is the expire date.
7952 (let ((xref (gnus-summary-header "xref"))
7955 (or xref (error "This article is not crossposted"))
7956 (while (string-match " \\([^ \t]+\\):" xref start)
7957 (setq start (match-end 0))
7960 (substring xref (match-beginning 1) (match-end 1)))
7961 gnus-newsgroup-name))
7962 (gnus-summary-score-entry
7963 "xref" (concat " " group ":") nil score date)))))
7965 (defun gnus-summary-temporarily-lower-by-subject (level)
7966 "Temporarily lower score by LEVEL for current subject.
7967 See `gnus-kill-expiry-days'."
7969 (gnus-summary-score-entry
7970 "subject" (gnus-summary-header "subject") nil (- level) (current-time-string)))
7972 (defun gnus-summary-temporarily-lower-by-author (level)
7973 "Temporarily lower score by LEVEL for current author.
7974 See `gnus-kill-expiry-days'."
7976 (gnus-summary-score-entry
7977 "from" (gnus-summary-header "from") nil (- level) (current-time-string)))
7979 (defun gnus-summary-temporarily-lower-by-xref (level)
7980 "Temporarily lower score by LEVEL for current xref.
7981 See `gnus-kill-expiry-days'."
7983 (gnus-summary-score-crossposting (- level) (current-time-string)))
7985 (defun gnus-summary-temporarily-lower-by-thread (level)
7986 "Temporarily lower score by LEVEL for current thread.
7987 See `gnus-kill-expiry-days'."
7989 (gnus-summary-score-entry
7990 "references" (gnus-summary-header "id")
7991 nil (- level) (current-time-string)))
7993 (defun gnus-summary-lower-by-subject (level)
7994 "Lower score by LEVEL for current subject."
7996 (gnus-summary-score-entry
7997 "subject" (gnus-summary-header "subject") nil (- level) nil))
7999 (defun gnus-summary-lower-by-author (level)
8000 "Lower score by LEVEL for current author."
8002 (gnus-summary-score-entry
8003 "from" (gnus-summary-header "from") nil (- level) nil))
8005 (defun gnus-summary-lower-by-xref (level)
8006 "Lower score by LEVEL for current xref."
8008 (gnus-summary-score-crossposting (- level) nil))
8010 (defun gnus-summary-lower-followups-to-author (level)
8011 "Lower score by LEVEL for all followups to the current author."
8013 (gnus-kill-file-lower-followups-to-author
8015 (let ((article (gnus-summary-article-number)))
8016 (if article (gnus-get-header-by-number article)
8017 (error "No article on current line")))))
8019 (defun gnus-summary-temporarily-raise-by-subject (level)
8020 "Temporarily raise score by LEVEL for current subject.
8021 See `gnus-kill-expiry-days'."
8023 (gnus-summary-score-entry
8024 "subject" (gnus-summary-header "subject") nil level (current-time-string)))
8026 (defun gnus-summary-temporarily-raise-by-author (level)
8027 "Temporarily raise score by LEVEL for current author.
8028 See `gnus-kill-expiry-days'."
8030 (gnus-summary-score-entry
8031 "from" (gnus-summary-header "from") nil level (current-time-string)))
8033 (defun gnus-summary-temporarily-raise-by-xref (level)
8034 "Temporarily raise score by LEVEL for current xref.
8035 See `gnus-kill-expiry-days'."
8037 (gnus-summary-score-crossposting level (current-time-string)))
8039 (defun gnus-summary-temporarily-raise-by-thread (level)
8040 "Temporarily raise score by LEVEL for current thread.
8041 See `gnus-kill-expiry-days'."
8043 (gnus-summary-score-entry
8044 "references" (gnus-summary-header "id")
8045 nil level (current-time-string)))
8047 (defun gnus-summary-raise-by-subject (level)
8048 "Raise score by LEVEL for current subject."
8050 (gnus-summary-score-entry
8051 "subject" (gnus-summary-header "subject") nil level nil))
8053 (defun gnus-summary-raise-by-author (level)
8054 "Raise score by LEVEL for current author."
8056 (gnus-summary-score-entry
8057 "from" (gnus-summary-header "from") nil level nil t))
8059 (defun gnus-summary-raise-by-xref (level)
8060 "Raise score by LEVEL for current xref."
8062 (gnus-summary-score-crossposting level nil))
8064 (defun gnus-summary-edit-global-kill ()
8065 "Edit a global score file."
8067 (setq gnus-current-kill-article (gnus-summary-article-number))
8068 (gnus-kill-file-edit-file nil) ;Nil stands for global score file.
8070 (substitute-command-keys
8071 "Editing a global score file (Type \\[gnus-kill-file-exit] to exit)")))
8073 (defun gnus-summary-raise-followups-to-author (level)
8074 "Raise score by LEVEL for all followups to the current author."
8076 (gnus-kill-file-raise-followups-to-author
8078 (let ((article (gnus-summary-article-number)))
8079 (if article (gnus-get-header-by-number article)
8080 (error "No article on current line")))))
8082 (defun gnus-summary-edit-local-kill ()
8083 "Edit a local score file applied to the current newsgroup."
8085 (setq gnus-current-kill-article (gnus-summary-article-number))
8086 (gnus-kill-file-edit-file gnus-newsgroup-name)
8088 (substitute-command-keys
8089 "Editing a local score file (Type \\[gnus-kill-file-exit] to exit)")))
8094 ;;; Gnus article mode
8097 (if gnus-article-mode-map
8099 (setq gnus-article-mode-map (make-keymap))
8100 (suppress-keymap gnus-article-mode-map)
8101 (define-key gnus-article-mode-map " " 'gnus-article-next-page)
8102 (define-key gnus-article-mode-map "\177" 'gnus-article-prev-page)
8103 (define-key gnus-article-mode-map "\C-x^" 'gnus-article-refer-article)
8104 (define-key gnus-article-mode-map "h" 'gnus-article-show-summary)
8105 (define-key gnus-article-mode-map "s" 'gnus-article-show-summary)
8106 (define-key gnus-article-mode-map "\C-xm" 'gnus-article-mail)
8107 (define-key gnus-article-mode-map "\C-xM" 'gnus-article-mail-with-original)
8108 (define-key gnus-article-mode-map "?" 'gnus-article-describe-briefly)
8110 ;; Duplicate almost all summary keystrokes in the article mode map.
8112 (list "#" "\M-#" "\C-c\M-#" "\r" "n" "p"
8113 "N" "P" "\M-\C-n" "\M-\C-p" "." "\M-s" "\M-r"
8114 "<" ">" "l" "j" "^" "\M-^" "-" "u" "U" "d" "D"
8115 "\M-u" "\M-U" "k" "\C-k" "\M-\C-k" "c" "x" "X"
8116 "\M-\C-x" "\M-\177" "b" "B" "$" "w" "\C-c\C-r"
8117 "t" "\M-t" "a" "f" "F" "C" "S" "r" "R" "\C-c\C-f"
8118 "m" "o" "\C-o" "|" "\M-m" "\M-\C-m" "\M-k" "m" "M"
8119 "V" "\C-c\C-d" "q" "Q")))
8121 (define-key gnus-article-mode-map (car commands)
8122 'gnus-article-summary-command)
8123 (setq commands (cdr commands))))
8125 (if gnus-visual (gnus-article-make-menu-bar)))
8127 (defun gnus-article-mode ()
8128 "Major mode for reading an article.
8129 All normal editing commands are switched off.
8130 The following commands are available:
8132 \\<gnus-article-mode-map>
8133 \\[gnus-article-next-page]\t Scroll the article one page forwards
8134 \\[gnus-article-prev-page]\t Scroll the article one page backwards
8135 \\[gnus-article-refer-article]\t Go to the article referred to by an article id near point
8136 \\[gnus-article-show-summary]\t Display the summary buffer
8137 \\[gnus-article-mail]\t Send a reply to the address near point
8138 \\[gnus-article-mail-with-original]\t Send a reply to the address near point; include the original article
8139 \\[gnus-article-describe-briefly]\t Describe the current mode briefly
8140 \\[gnus-info-find-node]\t Go to the Gnus info node
8144 (kill-all-local-variables)
8145 (setq mode-line-modified "-- ")
8146 (make-local-variable 'mode-line-format)
8147 (setq mode-line-format (copy-sequence mode-line-format))
8148 (and (equal (nth 3 mode-line-format) " ")
8149 (setcar (nthcdr 3 mode-line-format) ""))
8150 (setq mode-name "Article")
8151 (setq major-mode 'gnus-article-mode)
8152 (make-local-variable 'minor-mode-alist)
8153 (or (assq 'gnus-show-mime minor-mode-alist)
8154 (setq minor-mode-alist
8155 (cons (list 'gnus-show-mime " MIME") minor-mode-alist)))
8156 (use-local-map gnus-article-mode-map)
8157 (make-local-variable 'page-delimiter)
8158 (setq page-delimiter gnus-page-delimiter)
8159 (make-local-variable 'mail-header-separator)
8160 (setq mail-header-separator "") ;For caesar function.
8161 (buffer-disable-undo (current-buffer))
8162 (setq buffer-read-only t) ;Disable modification
8163 (run-hooks 'gnus-article-mode-hook))
8165 (defun gnus-article-setup-buffer ()
8166 "Initialize article mode buffer."
8167 (or (get-buffer gnus-article-buffer)
8169 (set-buffer (get-buffer-create gnus-article-buffer))
8170 (gnus-add-current-to-buffer-list)
8171 (gnus-article-mode))
8174 (defun gnus-request-article-this-buffer (article &optional group)
8175 "Get an article and insert it into this buffer."
8176 (setq group (or group gnus-newsgroup-name))
8177 ;; Using `gnus-request-article' directly will insert the article into
8178 ;; `nntp-server-buffer' - so we'll save some time by not having to
8179 ;; copy it from the server buffer into the article buffer.
8181 ;; We only request an article by message-id when we do not have the
8182 ;; headers for it, so we'll have to get those.
8183 (and (stringp article) (gnus-read-header article))
8185 ;; If the article number is negative, that means that this article
8186 ;; doesn't belong in this newsgroup (possibly), so we find its
8187 ;; message-id and request it by id instead of number.
8188 (if (and (numberp article) (< article 0))
8190 (set-buffer gnus-summary-buffer)
8191 (let ((header (gnus-gethash (int-to-string article)
8192 gnus-newsgroup-headers-hashtb-by-number)))
8193 (if (vectorp header)
8194 ;; It's a real article.
8195 (setq article (header-id header))
8196 ;; It is an extracted pseudo-article.
8198 (gnus-request-pseudo-article header)))))
8199 ;; Get the article and into the article buffer.
8203 (and (gnus-request-article article group (current-buffer))
8207 (defun gnus-read-header (id)
8208 "Read the headers of article ID and enter them into the Gnus system."
8209 (or gnus-newsgroup-headers-hashtb-by-number
8210 (gnus-make-headers-hashtable-by-number))
8212 (if (not (setq header
8213 (car (if (let ((gnus-nov-is-evil t))
8214 (gnus-retrieve-headers
8215 (list id) gnus-newsgroup-name))
8216 (gnus-get-newsgroup-headers)))))
8219 (header-set-number header gnus-reffed-article-number))
8220 (setq gnus-newsgroup-headers (cons header gnus-newsgroup-headers))
8221 (gnus-sethash (int-to-string (header-number header)) header
8222 gnus-newsgroup-headers-hashtb-by-number)
8224 (setq gnus-reffed-article-number (1- gnus-reffed-article-number)))
8225 (setq gnus-current-headers header)
8228 (defun gnus-article-prepare (article &optional all-headers header)
8229 "Prepare ARTICLE in article mode buffer.
8230 ARTICLE should either be an article number or a Message-ID.
8231 If ARTICLE is an id, HEADER should be the article headers.
8232 If ALL-HEADERS is non-nil, no headers are hidden."
8234 ;; Make sure we start in a summary buffer.
8235 (or (eq major-mode 'gnus-summary-mode)
8236 (set-buffer gnus-summary-buffer))
8237 (setq gnus-summary-buffer (current-buffer))
8238 ;; Make sure the connection to the server is alive.
8239 (or (gnus-server-opened (gnus-find-method-for-group gnus-newsgroup-name))
8241 (gnus-check-news-server
8242 (gnus-find-method-for-group gnus-newsgroup-name))
8243 (gnus-request-group gnus-newsgroup-name t)))
8244 (or gnus-newsgroup-headers-hashtb-by-number
8245 (gnus-make-headers-hashtable-by-number))
8246 (let* ((article (if header (header-number header) article))
8247 (summary-buffer (current-buffer))
8248 (internal-hook gnus-article-internal-prepare-hook)
8249 (bookmark (cdr (assq article gnus-newsgroup-bookmarks)))
8250 (group gnus-newsgroup-name)
8253 (gnus-article-setup-buffer)
8254 (set-buffer gnus-article-buffer)
8255 (let ((buffer-read-only nil))
8256 (if (not (setq result (gnus-request-article-this-buffer
8258 ;; There is no such article.
8260 (and (numberp article)
8261 (gnus-summary-mark-as-read article gnus-canceled-mark))
8262 (message "No such article (may be canceled)")
8265 (if (not (eq result 'article))
8268 (set-buffer summary-buffer)
8269 (setq gnus-last-article gnus-current-article
8270 gnus-current-article 0
8271 gnus-current-headers nil
8272 gnus-article-current nil)
8273 (gnus-configure-windows 'article)
8274 (gnus-set-mode-line 'summary)
8275 (gnus-set-global-variables))
8276 (gnus-set-mode-line 'article))
8277 ;; The result from the `request' was an actual article -
8278 ;; or at least some text that is now displayed in the
8280 (if (and (numberp article)
8281 (not (eq article gnus-current-article)))
8282 ;; Seems like a new article has been selected.
8283 ;; `gnus-current-article' must be an article number.
8285 (set-buffer summary-buffer)
8286 (setq gnus-last-article gnus-current-article)
8287 (setq gnus-current-article article)
8288 (setq gnus-current-headers
8289 (gnus-get-header-by-number gnus-current-article))
8290 (setq gnus-article-current
8291 (cons gnus-newsgroup-name gnus-current-article))
8292 (gnus-set-mode-line 'summary)
8293 (run-hooks 'gnus-mark-article-hook)
8295 (run-hooks 'gnus-visual-mark-article-hook))
8296 ;; Set the global newsgroup variables here.
8297 ;; Suggested by Jim Sisolak
8298 ;; <sisolak@trans4.neep.wisc.edu>.
8299 (gnus-set-global-variables)))
8300 ;; gnus-have-all-headers must be either T or NIL.
8301 (setq gnus-have-all-headers
8302 (not (not (or all-headers gnus-show-all-headers))))
8303 ;; Hooks for getting information from the article.
8304 ;; This hook must be called before being narrowed.
8305 (run-hooks 'internal-hook)
8306 (run-hooks 'gnus-article-prepare-hook)
8307 ;; Decode MIME message.
8308 (if (and gnus-show-mime
8309 (gnus-fetch-field "Mime-Version"))
8310 (funcall gnus-show-mime-method))
8311 ;; Perform the article display hooks.
8312 (let ((buffer-read-only nil))
8313 (run-hooks 'gnus-article-display-hook))
8315 (goto-char (point-min))
8316 (and gnus-break-pages (gnus-narrow-to-page))
8317 (gnus-set-mode-line 'article)
8321 (message "Moved to bookmark")
8322 (search-forward "\n\n" nil t)
8323 (forward-line bookmark)))
8325 (get-buffer-window gnus-article-buffer) (point-min))
8328 (defun gnus-article-show-all-headers ()
8329 "Show all article headers in article mode buffer."
8331 (setq gnus-have-all-headers t)
8332 (gnus-article-setup-buffer)
8333 (set-buffer gnus-article-buffer)
8334 (let ((buffer-read-only nil))
8335 (remove-text-properties 1 (point-max) '(invisible t)))))
8337 (defun gnus-article-hide-headers-if-wanted ()
8338 "Hide unwanted headers if `gnus-have-all-headers' is nil.
8339 Provided for backwards compatability."
8340 (or gnus-have-all-headers
8341 (gnus-article-hide-headers)))
8343 (defun gnus-article-hide-headers (&optional delete)
8344 "Hide unwanted headers and possibly sort them as well."
8347 (let ((sorted gnus-sorted-header-list)
8348 (buffer-read-only nil)
8349 want want-list beg want-l)
8350 ;; First we narrow to just the headers.
8353 ;; Hide any "From " lines at the beginning of (mail) articles.
8354 (while (looking-at rmail-unix-mail-delimiter)
8357 (add-text-properties 1 (point) '(invisible t)))
8358 ;; Then treat the rest of the header lines.
8361 (progn (search-forward "\n\n" nil t) (forward-line -1) (point)))
8362 ;; Then we use the two regular expressions
8363 ;; `gnus-ignored-headers' and `gnus-visible-headers' to
8364 ;; select which header lines is to remain visible in the
8367 (while (re-search-forward "^[^ \t]*:" nil t)
8369 ;; We add the headers we want to keep to a list and delete
8370 ;; them from the buffer.
8371 (if (or (and (stringp gnus-visible-headers)
8372 (looking-at gnus-visible-headers))
8373 (and (not (stringp gnus-visible-headers))
8374 (stringp gnus-ignored-headers)
8375 (not (looking-at gnus-ignored-headers))))
8379 ;; Be sure to get multi-line headers...
8380 (re-search-forward "^[^ \t]*:" nil t)
8383 (cons (buffer-substring beg (point)) want-list))
8384 (delete-region beg (point))
8387 ;; Next we perform the sorting by looking at
8388 ;; `gnus-sorted-header-list'.
8390 (while (and sorted want-list)
8391 (setq want-l want-list)
8393 (not (string-match (car sorted) (car want-l))))
8394 (setq want-l (cdr want-l)))
8397 (insert (car want-l))
8398 (setq want-list (delq (car want-l) want-list))))
8399 (setq sorted (cdr sorted)))
8400 ;; Any headers that were not matched by the sorted list we
8401 ;; just tack on the end of the visible header list.
8403 (insert (car want-list))
8404 (setq want-list (cdr want-list)))
8405 ;; And finally we make the unwanted headers invisible.
8407 (delete-region (point) (point-max))
8408 ;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
8409 (add-text-properties (point) (point-max) '(invisible t)))))))
8411 (defun gnus-article-hide-signature ()
8412 "Hides the signature in an article.
8413 It does this by hiding everyting after \"^-- *$\", which is what all
8414 signatures should be preceded by. Note that this may mean that parts
8415 of an article may disappear if the article has such a line in the
8416 middle of the text."
8419 (goto-char (point-max))
8420 (if (re-search-backward "^-- *$" nil t)
8422 (add-text-properties (point) (point-max) '(invisible t))))))
8424 (defun gnus-article-hide-citation ()
8425 "Hide all cited text.
8426 This function uses the famous, extremely intelligent \"shoot in foot\"
8427 algorithm - which is simply deleting all lines that start with
8428 \">\". Your mileage may vary. If you come up with anything better,
8429 please do mail it to me."
8433 (search-forward "\n\n" nil t)
8435 (if (looking-at ">")
8436 (add-text-properties
8437 (point) (save-excursion (forward-line 1) (point))
8441 ;; Written by Per Abrahamsen <amanda@iesd.auc.dk>.
8442 (defun gnus-article-treat-overstrike ()
8443 ;; Prepare article for overstrike commands.
8446 (while (search-forward "\b" nil t)
8447 (let ((next (following-char))
8448 (previous (char-after (- (point) 2))))
8449 (cond ((eq next previous)
8450 (delete-region (- (point) 2) (point))
8451 (put-text-property (point) (1+ (point))
8454 (delete-region (1- (point)) (1+ (point)))
8455 (put-text-property (1- (point)) (point)
8458 (delete-region (- (point) 2) (point))
8459 (put-text-property (point) (1+ (point))
8460 'face 'underline)))))))
8462 (defun gnus-article-remove-cr ()
8464 (while (search-forward "\r" nil t)
8465 (replace-match "")))
8467 (defun gnus-article-de-quoted-unreadable ()
8472 (goto-char (point-min))
8473 (while (re-search-forward "=[0-9A-F][0-9A-F]" nil t)
8477 (* 16 (gnus-hex-char-to-integer
8478 (char-after (1+ (match-beginning 0)))))
8479 (gnus-hex-char-to-integer
8480 (char-after (1- (match-end 0)))))))))))
8482 ;; Taken from hexl.el.
8483 (defun gnus-hex-char-to-integer (character)
8484 "Take a char and return its value as if it was a hex digit."
8485 (if (and (>= character ?0) (<= character ?9))
8487 (let ((ch (logior character 32)))
8488 (if (and (>= ch ?a) (<= ch ?f))
8490 (error (format "Invalid hex digit `%c'." ch))))))
8494 (defun gnus-output-to-rmail (file-name)
8495 "Append the current article to an Rmail file named FILE-NAME."
8497 ;; Most of these codes are borrowed from rmailout.el.
8498 (setq file-name (expand-file-name file-name))
8499 (setq rmail-default-rmail-file file-name)
8500 (let ((artbuf (current-buffer))
8501 (tmpbuf (get-buffer-create " *Gnus-output*")))
8503 (or (get-file-buffer file-name)
8504 (file-exists-p file-name)
8506 (concat "\"" file-name "\" does not exist, create it? "))
8507 (let ((file-buffer (create-file-buffer file-name)))
8509 (set-buffer file-buffer)
8510 (rmail-insert-rmail-file-header)
8511 (let ((require-final-newline nil))
8512 (write-region (point-min) (point-max) file-name t 1)))
8513 (kill-buffer file-buffer))
8514 (error "Output file does not exist")))
8516 (buffer-disable-undo (current-buffer))
8518 (insert-buffer-substring artbuf)
8519 (gnus-convert-article-to-rmail)
8520 ;; Decide whether to append to a file or to an Emacs buffer.
8521 (let ((outbuf (get-file-buffer file-name)))
8523 (append-to-file (point-min) (point-max) file-name)
8524 ;; File has been visited, in buffer OUTBUF.
8526 (let ((buffer-read-only nil)
8527 (msg (and (boundp 'rmail-current-message)
8528 rmail-current-message)))
8529 ;; If MSG is non-nil, buffer is in RMAIL mode.
8532 (narrow-to-region (point-max) (point-max))))
8533 (insert-buffer-substring tmpbuf)
8536 (goto-char (point-min))
8538 (search-backward "\^_")
8539 (narrow-to-region (point) (point-max))
8540 (goto-char (1+ (point-min)))
8541 (rmail-count-new-messages t)
8542 (rmail-show-message msg))))))
8544 (kill-buffer tmpbuf)
8547 (defun gnus-output-to-file (file-name)
8548 "Append the current article to a file named FILE-NAME."
8549 (setq file-name (expand-file-name file-name))
8550 (let ((artbuf (current-buffer))
8551 (tmpbuf (get-buffer-create " *Gnus-output*")))
8554 (buffer-disable-undo (current-buffer))
8556 (insert-buffer-substring artbuf)
8557 ;; Append newline at end of the buffer as separator, and then
8559 (goto-char (point-max))
8561 (append-to-file (point-min) (point-max) file-name))
8562 (kill-buffer tmpbuf)
8565 (defun gnus-convert-article-to-rmail ()
8566 "Convert article in current buffer to Rmail message format."
8567 (let ((buffer-read-only nil))
8568 ;; Convert article directly into Babyl format.
8569 ;; Suggested by Rob Austein <sra@lcs.mit.edu>
8570 (goto-char (point-min))
8571 (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
8572 (while (search-forward "\n\^_" nil t) ;single char
8573 (replace-match "\n^_")) ;2 chars: "^" and "_"
8574 (goto-char (point-max))
8577 (defun gnus-narrow-to-page (&optional arg)
8578 "Make text outside current page invisible except for page delimiter.
8579 A numeric arg specifies to move forward or backward by that many pages,
8580 thus showing a page other than the one point was originally in."
8582 (setq arg (if arg (prefix-numeric-value arg) 0))
8584 (forward-page -1) ;Beginning of current page.
8589 (forward-page (1- arg))))
8590 ;; Find the end of the page.
8592 ;; If we stopped due to end of buffer, stay there.
8593 ;; If we stopped after a page delimiter, put end of restriction
8594 ;; at the beginning of that line.
8595 ;; These are commented out.
8596 ;; (if (save-excursion (beginning-of-line)
8597 ;; (looking-at page-delimiter))
8598 ;; (beginning-of-line))
8599 (narrow-to-region (point)
8601 ;; Find the top of the page.
8603 ;; If we found beginning of buffer, stay there.
8604 ;; If extra text follows page delimiter on same line,
8606 ;; Otherwise, show text starting with following line.
8607 (if (and (eolp) (not (bobp)))
8612 (defun gnus-gmt-to-local ()
8613 "Rewrite Date: field described in GMT to local in current buffer.
8614 The variable gnus-local-timezone is used for local time zone.
8615 Intended to be used with gnus-article-prepare-hook."
8619 (goto-char (point-min))
8620 (narrow-to-region (point-min)
8621 (progn (search-forward "\n\n" nil 'move) (point)))
8622 (goto-char (point-min))
8623 (if (re-search-forward "^Date:[ \t]\\(.*\\)$" nil t)
8624 (let ((buffer-read-only nil)
8625 (date (buffer-substring (match-beginning 1) (match-end 1))))
8626 (delete-region (match-beginning 1) (match-end 1))
8628 (timezone-make-date-arpa-standard date nil gnus-local-timezone))
8633 ;; Article mode commands
8635 (defun gnus-article-next-page (lines)
8636 "Show next page of current article.
8637 If end of article, return non-nil. Otherwise return nil.
8638 Argument LINES specifies lines to be scrolled up."
8640 (move-to-window-line -1)
8641 ;; Fixed by enami@ptgd.sony.co.jp (enami tsugutomo)
8644 (and (pos-visible-in-window-p) ;Not continuation line.
8646 ;; Nothing in this page.
8647 (if (or (not gnus-break-pages)
8650 (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer?
8652 (gnus-narrow-to-page 1) ;Go to next page.
8655 ;; More in this page.
8659 ;; Long lines may cause an end-of-buffer error.
8660 (goto-char (point-max))))
8664 (defun gnus-article-prev-page (lines)
8665 "Show previous page of current article.
8666 Argument LINES specifies lines to be scrolled down."
8668 (move-to-window-line 0)
8669 (if (and gnus-break-pages
8671 (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer?
8673 (gnus-narrow-to-page -1) ;Go to previous page.
8674 (goto-char (point-max))
8676 (scroll-down lines)))
8678 (defun gnus-article-next-digest (nth)
8679 "Move to head of NTH next digested message.
8680 Set mark at end of digested message."
8681 ;; Stop page breaking in digest mode.
8684 ;; Skip NTH - 1 digest.
8685 ;; Suggested by Khalid Sattar <admin@cs.exeter.ac.uk>.
8686 ;; Digest separator is customizable.
8687 ;; Suggested by Skip Montanaro <montanaro@sprite.crd.ge.com>.
8688 (while (and (> nth 1)
8689 (re-search-forward gnus-digest-separator nil 'move))
8690 (setq nth (1- nth)))
8691 (if (re-search-forward gnus-digest-separator nil t)
8692 (let ((begin (point)))
8693 ;; Search for end of this message.
8695 (if (re-search-forward gnus-digest-separator nil t)
8697 (search-backward "\n\n") ;This may be incorrect.
8699 (goto-char (point-max)))
8700 (push-mark) ;Set mark at end of digested message.
8703 ;; Show From and Subject fields.
8705 (message "End of message")
8708 (defun gnus-article-prev-digest (nth)
8709 "Move to head of NTH previous digested message."
8710 ;; Stop page breaking in digest mode.
8713 ;; Skip NTH - 1 digest.
8714 ;; Suggested by Khalid Sattar <admin@cs.exeter.ac.uk>.
8715 ;; Digest separator is customizable.
8716 ;; Suggested by Skip Montanaro <montanaro@sprite.crd.ge.com>.
8717 (while (and (> nth 1)
8718 (re-search-backward gnus-digest-separator nil 'move))
8719 (setq nth (1- nth)))
8720 (if (re-search-backward gnus-digest-separator nil t)
8721 (let ((begin (point)))
8722 ;; Search for end of this message.
8724 (if (re-search-forward gnus-digest-separator nil t)
8726 (search-backward "\n\n") ;This may be incorrect.
8728 (goto-char (point-max)))
8729 (push-mark) ;Set mark at end of digested message.
8731 ;; Show From: and Subject: fields.
8733 (goto-char (point-min))
8734 (message "Top of message")
8737 (defun gnus-article-refer-article ()
8738 "Read article specified by message-id around point."
8740 (search-forward ">" nil t) ;Move point to end of "<....>".
8741 (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t)
8743 (buffer-substring (match-beginning 1) (match-end 1))))
8744 (set-buffer gnus-summary-buffer)
8745 (gnus-summary-refer-article message-id))
8746 (error "No references around point")))
8748 (defun gnus-article-mail (yank)
8749 "Send a reply to the address near point.
8750 If YANK is non-nil, include the original article."
8754 (save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point)))
8755 (save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point))))))
8758 (switch-to-buffer gnus-summary-buffer)
8759 (funcall gnus-mail-reply-method yank address)))))
8761 (defun gnus-article-mail-with-original ()
8762 "Send a reply to the address near point and include the original article."
8764 (gnus-article-mail 'yank))
8766 (defun gnus-article-show-summary ()
8767 "Reconfigure windows to show summary buffer."
8769 (gnus-configure-windows 'article)
8770 (pop-to-buffer gnus-summary-buffer)
8771 (gnus-summary-goto-subject gnus-current-article))
8773 (defun gnus-article-describe-briefly ()
8774 "Describe article mode commands briefly."
8777 (substitute-command-keys "\\<gnus-article-mode-map>\\[gnus-article-next-page]:Next page \\[gnus-article-prev-page]:Prev page \\[gnus-article-show-summary]:Show summary \\[gnus-info-find-node]:Run Info \\[gnus-article-describe-briefly]:This help")))
8779 (defun gnus-article-summary-command ()
8780 "Execute the last keystroke in the summary buffer."
8783 (let ((obuf (current-buffer))
8784 (owin (current-window-configuration)))
8785 (switch-to-buffer gnus-summary-buffer 'norecord)
8786 (execute-kbd-macro (this-command-keys))
8788 (let ((npoint (point)))
8789 (set-window-configuration owin)
8790 (set-window-start (get-buffer-window (current-buffer)) (point)))))
8792 ;; caesar-region written by phr@prep.ai.mit.edu Nov 86
8793 ;; Modified by tower@prep Nov 86
8794 ;; Modified by umerin@flab.flab.Fujitsu.JUNET for ROT47.
8796 (defun gnus-caesar-region (&optional n)
8797 "Caesar rotation of region by N, default 13, for decrypting netnews.
8798 ROT47 will be performed for Japanese text in any case."
8799 (interactive (if current-prefix-arg ; Was there a prefix arg?
8800 (list (prefix-numeric-value current-prefix-arg))
8802 (cond ((not (numberp n)) (setq n 13))
8803 (t (setq n (mod n 26)))) ;canonicalize N
8804 (if (not (zerop n)) ; no action needed for a rot of 0
8806 (if (or (not (boundp 'caesar-translate-table))
8807 (not caesar-translate-table)
8808 (/= (aref caesar-translate-table ?a) (+ ?a n)))
8809 (let ((i 0) (lower "abcdefghijklmnopqrstuvwxyz") upper)
8810 (message "Building caesar-translate-table...")
8811 (setq caesar-translate-table (make-vector 256 0))
8813 (aset caesar-translate-table i i)
8815 (setq lower (concat lower lower) upper (upcase lower) i 0)
8817 (aset caesar-translate-table (+ ?a i) (aref lower (+ i n)))
8818 (aset caesar-translate-table (+ ?A i) (aref upper (+ i n)))
8820 ;; ROT47 for Japanese text.
8821 ;; Thanks to ichikawa@flab.fujitsu.junet.
8823 (let ((t1 (logior ?O 128))
8824 (t2 (logior ?! 128))
8825 (t3 (logior ?~ 128)))
8827 (aset caesar-translate-table i
8828 (let ((v (aref caesar-translate-table i)))
8829 (if (<= v t1) (if (< v t2) v (+ v 47))
8830 (if (<= v t3) (- v 47) v))))
8832 (message "Building caesar-translate-table... done")))
8833 (let ((from (region-beginning))
8836 (setq str (buffer-substring from to))
8837 (setq len (length str))
8839 (aset str i (aref caesar-translate-table (aref str i)))
8842 (delete-region from to)
8847 ;;; Gnus Score File Mode
8850 (if gnus-kill-file-mode-map
8852 (setq gnus-kill-file-mode-map (copy-keymap emacs-lisp-mode-map))
8853 (define-key gnus-kill-file-mode-map "\C-c\C-x"
8854 'gnus-kill-file-set-expunge-below)
8855 (define-key gnus-kill-file-mode-map "\C-c@"
8856 'gnus-kill-file-set-mark-below)
8857 (define-key gnus-kill-file-mode-map "\C-c\C-k\C-s"
8858 'gnus-kill-file-temporarily-lower-by-subject)
8859 (define-key gnus-kill-file-mode-map "\C-c\C-k\C-a"
8860 'gnus-kill-file-temporarily-lower-by-author)
8861 (define-key gnus-kill-file-mode-map "\C-c\C-k\C-x"
8862 'gnus-kill-file-temporarily-lower-by-xref)
8863 (define-key gnus-kill-file-mode-map "\C-c\C-ks"
8864 'gnus-kill-file-lower-by-subject)
8865 (define-key gnus-kill-file-mode-map "\C-c\C-ka"
8866 'gnus-kill-file-lower-by-author)
8867 (define-key gnus-kill-file-mode-map "\C-c\C-kt"
8868 'gnus-kill-file-lower-by-thread)
8869 (define-key gnus-kill-file-mode-map "\C-c\C-kx"
8870 'gnus-kill-file-lower-by-xref)
8871 (define-key gnus-kill-file-mode-map "\C-c\C-kf"
8872 'gnus-kill-file-lower-followups-to-author)
8873 (define-key gnus-kill-file-mode-map "\C-c\C-i\C-s"
8874 'gnus-kill-file-temporarily-raise-by-subject)
8875 (define-key gnus-kill-file-mode-map "\C-c\C-i\C-a"
8876 'gnus-kill-file-temporarily-raise-by-author)
8877 (define-key gnus-kill-file-mode-map "\C-c\C-i\C-t"
8878 'gnus-kill-file-temporarily-raise-by-thread)
8879 (define-key gnus-kill-file-mode-map "\C-c\C-i\C-x"
8880 'gnus-kill-file-temporarily-raise-by-xref)
8881 (define-key gnus-kill-file-mode-map "\C-c\C-is"
8882 'gnus-kill-file-raise-by-subject)
8883 (define-key gnus-kill-file-mode-map "\C-c\C-ia"
8884 'gnus-kill-file-raise-by-author)
8885 (define-key gnus-kill-file-mode-map "\C-c\C-ix"
8886 'gnus-kill-file-raise-by-xref)
8887 (define-key gnus-kill-file-mode-map "\C-c\C-if"
8888 'gnus-kill-file-raise-followups-to-author)
8889 (define-key gnus-kill-file-mode-map "\C-c\C-a" 'gnus-kill-file-apply-buffer)
8890 (define-key gnus-kill-file-mode-map "\C-c\C-e" 'gnus-kill-file-apply-last-sexp)
8891 (define-key gnus-kill-file-mode-map "\C-c\C-c" 'gnus-kill-file-exit)
8892 (define-key gnus-kill-file-mode-map "\C-c\C-i" 'gnus-info-find-node))
8894 (defun gnus-kill-file-mode ()
8895 "Major mode for editing score files.
8897 In addition to Emacs-Lisp mode, the following commands are available:
8899 \\[gnus-kill-file-set-expunge-below] Automatically expunge articles below LEVEL.
8900 \\[gnus-kill-file-set-mark-below] Automatically mark articles below LEVEL.
8901 \\[gnus-kill-file-temporarily-lower-by-author] Insert temporary lower command for current author.
8902 \\[gnus-kill-file-temporarily-lower-by-thread] Insert temporary lower command for current thread.
8903 \\[gnus-kill-file-temporarily-lower-by-xref] Insert temporary lower command for current cross-posting.
8904 \\[gnus-kill-file-lower-by-subject] Insert permanent lower command for current subject.
8905 \\[gnus-kill-file-lower-by-author] Insert permanent lower command for current author.
8906 \\[gnus-kill-file-lower-followups-to-author] Insert permanent lower command for followups to the current author.
8907 \\[gnus-kill-file-lower-by-xref] Insert permanent lower command for current cross-posting.
8908 \\[gnus-kill-file-temporarily-raise-by-subject] Insert temporary raise command for current subject.
8909 \\[gnus-kill-file-temporarily-raise-by-author] Insert temporary raise command for current author.
8910 \\[gnus-kill-file-temporarily-raise-by-thread] Insert temporary raise command for current thread.
8911 \\[gnus-kill-file-temporarily-raise-by-xref] Insert temporary raise command for current cross-posting.
8912 \\[gnus-kill-file-raise-by-subject] Insert permanent raise command for current subject.
8913 \\[gnus-kill-file-raise-by-author] Insert permanent raise command for current author.
8914 \\[gnus-kill-file-raise-followups-to-author] Insert permanent raise command for followups to the current author.
8915 \\[gnus-kill-file-raise-by-xref] Insert permanent raise command for current cross-posting.
8916 \\[gnus-kill-file-apply-buffer] Apply current buffer to selected newsgroup.
8917 \\[gnus-kill-file-apply-last-sexp] Apply sexp before point to selected newsgroup.
8918 \\[gnus-kill-file-exit] Save file and exit editing score file.
8919 \\[gnus-info-find-node] Read Info about score files.
8921 A score file contains Lisp expressions to be applied to a selected
8922 newsgroup. The purpose is to mark articles as read on the basis of
8923 some set of regexps. A global score file is applied to every
8924 newsgroup, and a local score file is applied to a specified newsgroup.
8925 Since a global score file is applied to every newsgroup, for better
8926 performance use a local one.
8928 A score file can contain any kind of Emacs Lisp expressions expected
8929 to be evaluated in the summary buffer. Writing Lisp programs for this
8930 purpose is not so easy because the internal working of Gnus must be
8931 well-known. For this reason, Gnus provides a general function which
8932 does this easily for non-Lisp programmers.
8934 The `gnus-kill' function executes commands available in summary mode
8935 by their key sequences. `gnus-kill' should be called with FIELD,
8936 REGEXP and optional COMMAND and ALL. FIELD is a string representing
8937 the header field or an empty string. If FIELD is an empty string, the
8938 entire article body is searched for. REGEXP is a string which is
8939 compared with FIELD value. COMMAND is a string representing a valid
8940 key sequence in summary mode or Lisp expression. COMMAND defaults to
8941 '(gnus-summary-mark-as-read nil \"X\"). Make sure that COMMAND is
8942 executed in the summary buffer. If the second optional argument ALL
8943 is non-nil, the COMMAND is applied to articles which are already
8944 marked as read or unread. Articles which are marked are skipped over
8947 For example, if you want to mark articles of which subjects contain
8948 the string `AI' as read, a possible score file may look like:
8950 (gnus-kill \"Subject\" \"AI\")
8952 If you want to mark articles with `D' instead of `X', you can use
8953 the following expression:
8955 (gnus-kill \"Subject\" \"AI\" \"d\")
8957 In this example it is assumed that the command
8958 `gnus-summary-mark-as-read-forward' is assigned to `d' in summary mode.
8960 It is possible to remove unnecessary headers which are marked with
8961 `X' in a score file as follows:
8963 (gnus-expunge \"X\")
8965 If the summary buffer is empty after applying score files, Gnus will
8966 exit the selected newsgroup normally. If headers which are marked
8967 with `D' are deleted in a score file, it is impossible to read articles
8968 which are marked as read in the previous Gnus sessions. Marks other
8969 than `D' should be used for articles which should really be deleted.
8971 Entry to this mode calls emacs-lisp-mode-hook and
8972 gnus-kill-file-mode-hook with no arguments, if that value is non-nil."
8974 (kill-all-local-variables)
8975 (use-local-map gnus-kill-file-mode-map)
8976 (set-syntax-table emacs-lisp-mode-syntax-table)
8977 (setq major-mode 'gnus-kill-file-mode)
8978 (setq mode-name "score-file")
8979 (lisp-mode-variables nil)
8980 (run-hooks 'emacs-lisp-mode-hook 'gnus-kill-file-mode-hook))
8982 (defun gnus-kill-file-edit-file (newsgroup)
8983 "Begin editing a score file for NEWSGROUP.
8984 If NEWSGROUP is nil, the global score file is selected."
8985 (interactive "sNewsgroup: ")
8986 (let ((file (gnus-newsgroup-kill-file newsgroup)))
8987 (gnus-make-directory (file-name-directory file))
8988 ;; Save current window configuration if this is first invocation.
8989 (or (and (get-file-buffer file)
8990 (get-buffer-window (get-file-buffer file)))
8991 (setq gnus-winconf-kill-file (current-window-configuration)))
8993 (let ((buffer (find-file-noselect file)))
8994 (cond ((get-buffer-window buffer)
8995 (pop-to-buffer buffer))
8996 ((eq major-mode 'gnus-group-mode)
8997 (gnus-configure-windows '(1 0 0)) ;Take all windows.
8998 (pop-to-buffer gnus-group-buffer)
8999 ;; Fix by sachs@SLINKY.CS.NYU.EDU (Jay Sachs).
9000 (let ((gnus-summary-buffer buffer))
9001 (gnus-configure-windows '(1 1 0))) ;Split into two.
9002 (pop-to-buffer buffer))
9003 ((eq major-mode 'gnus-summary-mode)
9004 (gnus-configure-windows 'article)
9005 (pop-to-buffer gnus-article-buffer)
9006 (bury-buffer gnus-article-buffer)
9007 (switch-to-buffer buffer))
9009 (find-file-other-window file))
9011 (gnus-kill-file-mode)
9014 ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>.
9015 (defun gnus-kill-set-kill-buffer ()
9016 (let* ((file (gnus-newsgroup-kill-file gnus-newsgroup-name))
9017 (buffer (find-file-noselect file)))
9019 (gnus-kill-file-mode)
9020 (bury-buffer buffer)))
9022 (defun gnus-kill-save-kill-buffer ()
9024 (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name)))
9025 (if (get-file-buffer file)
9027 (set-buffer (get-file-buffer file))
9028 (and (buffer-modified-p) (save-buffer))
9029 (kill-buffer (current-buffer)))))))
9031 (defun gnus-article-fetch-field (field)
9033 (set-buffer gnus-article-buffer)
9037 (narrow-to-region 1 (save-excursion
9038 (search-forward "\n\n" nil t) (point)))
9041 (mail-fetch-field field)
9044 (defun gnus-kill-file-enter-kill (field regexp level date edit)
9045 ;; Enter score file entry.
9046 ;; FIELD: String containing the name of the header field to score.
9047 ;; REGEXP: The string to score.
9048 ;; LEVEL: How much to raise the score by.
9049 ;; DATE: A date string for expire score or nil for permanent kills.
9050 ;; EDIT: Allow the user to edit REGEXP iff non-nil.
9052 (gnus-kill-set-kill-buffer)
9053 (goto-char (point-min))
9055 (if edit (read-string
9056 (format "Add %d to articles with %s matching: "
9057 level (downcase field))
9060 entry string kill beg)
9061 (setq entry (if date (cons regexp date) regexp)
9062 string (format "(gnus-raise %S (quote %S) %S)\n"
9064 (while (and (setq beg (point))
9066 (setq kill (read (current-buffer)))
9068 (or (not (eq (nth 0 kill) 'gnus-raise))
9069 (not (string= (downcase (nth 1 kill)) (downcase field)))
9070 (not (eq (nth 3 kill) level))))
9074 (goto-char (point-min))
9076 (let ((list (nth 2 kill)))
9077 (if (and (listp list) (eq 'quote (car list)))
9078 (setq list (car (cdr list))))
9081 (if (and (listp list) (listp (cdr list)))
9082 (list 'quote (cons entry list))
9083 (list 'quote (list entry list)))))
9084 (delete-region beg (point))
9085 (insert (gnus-pp-gnus-kill kill)))
9086 (gnus-kill-file-apply-string string))
9087 ;; Added by Sudish Joseph <joseph@cis.ohio-state.edu>.
9089 (message "Added kill file entry %s: %s" (downcase field) regexp))))
9091 (defun gnus-kill-file-set-variable (symbol value)
9092 ;; Set SYMBOL to VALUE in the score file.
9094 (gnus-kill-set-kill-buffer)
9095 (goto-char (point-min))
9096 (let ((string (format "(setq %S %S)\n" symbol value))
9098 (while (and (setq beg (point))
9100 (setq kill (read (current-buffer)))
9102 (or (not (eq (nth 0 kill) 'setq))
9103 (not (eq (nth 1 kill) symbol))))
9107 (goto-char (point-min))
9109 (delete-region beg (point))
9112 (defun gnus-kill-file-set-expunge-below (level)
9113 "Automatically expunge articles with score below LEVEL."
9115 (setq level (if level
9116 (prefix-numeric-value level)
9117 gnus-summary-default-score))
9118 (if (eq major-mode 'gnus-summary-mode)
9120 (gnus-score-set 'expunge level)
9121 (gnus-score-set 'touched t))
9122 (gnus-kill-file-set-variable 'expunge-below level))
9123 (message "Set expunge below level to %d." level))
9125 (defun gnus-kill-file-set-mark-below (level)
9126 "Automatically mark articles with score below LEVEL as read."
9128 (setq level (if level
9129 (prefix-numeric-value level)
9130 gnus-summary-default-score))
9131 (if (eq major-mode 'gnus-summary-mode)
9133 (gnus-score-set 'mark level)
9134 (gnus-score-set 'touched t)
9135 (gnus-summary-set-mark-below level))
9136 (gnus-kill-file-set-variable 'mark-below level))
9137 (message "Set mark below level to %d." level))
9139 (defun gnus-kill-file-temporarily-raise-by-subject (level &optional header)
9140 "Temporarily raise score by LEVEL for current subject.
9141 See `gnus-kill-expiry-days'."
9143 (gnus-kill-file-raise-by-subject level header (current-time-string)))
9145 (defun gnus-kill-file-temporarily-raise-by-author (level &optional header)
9146 "Temporarily raise score by LEVEL for current author.
9147 See `gnus-kill-expiry-days'."
9149 (gnus-kill-file-raise-by-author level header (current-time-string)))
9151 (defun gnus-kill-file-temporarily-raise-by-thread (level &optional header)
9152 "Temporarily raise score by LEVEL for current thread.
9153 See `gnus-kill-expiry-days'."
9155 (gnus-kill-file-enter-kill
9157 (regexp-quote (header-id (or header gnus-current-headers)))
9159 (current-time-string)
9162 (defun gnus-kill-file-temporarily-raise-by-xref (level &optional header)
9163 "Insert temporary score commands for articles that have been crossposted.
9164 By default use the current crossposted groups.
9165 See `gnus-kill-expiry-days'."
9167 (gnus-kill-file-raise-by-xref level header (current-time-string)))
9169 (defun gnus-kill-file-raise-by-subject (level &optional header date)
9170 "Raise score by LEVEL for current subject."
9172 (gnus-kill-file-enter-kill
9175 (gnus-simplify-subject
9176 (header-subject (or header gnus-current-headers))))
9181 (defun gnus-kill-file-raise-by-author (level &optional header date)
9182 "Raise score by LEVEL for current author."
9184 (gnus-kill-file-enter-kill
9186 (regexp-quote (header-from (or header gnus-current-headers)))
9191 (defun gnus-kill-file-raise-by-xref (level &optional header date)
9192 "Raise score by LEVEL for articles that have been crossposted.
9193 By default use the current crossposted groups."
9195 (let ((xref (header-xref (or header gnus-current-headers)))
9199 (while (string-match " \\([^ \t]+\\):" xref start)
9200 (setq start (match-end 0))
9203 (substring xref (match-beginning 1) (match-end 1)))
9204 gnus-newsgroup-name))
9205 (gnus-kill-file-enter-kill
9207 (concat " " (regexp-quote group) ":")
9212 (defun gnus-kill-file-raise-followups-to-author
9213 (level &optional header)
9214 "Raise score for all followups to the current author."
9216 (let ((name (header-from (or header gnus-current-headers)))
9219 (gnus-kill-set-kill-buffer)
9220 (goto-char (point-min))
9221 (setq name (read-string (concat "Add " level
9222 " to followup articles to: ")
9223 (regexp-quote name)))
9225 (format "(gnus-kill %S %S '(gnus-summary-temporarily-raise-by-thread %S))\n"
9228 (gnus-kill-file-apply-string string))
9229 (message "Added permanent score file entry for followups to %s." name)))
9231 (defun gnus-kill-file-temporarily-lower-by-subject (level &optional header)
9232 "Temporarily lower score by LEVEL for current subject.
9233 See `gnus-kill-expiry-days'."
9235 (gnus-kill-file-lower-by-subject level header (current-time-string)))
9237 (defun gnus-kill-file-temporarily-lower-by-author (level &optional header)
9238 "Temporarily lower score by LEVEL for current author.
9239 See `gnus-kill-expiry-days'."
9241 (gnus-kill-file-lower-by-author level header (current-time-string)))
9243 (defun gnus-kill-file-temporarily-lower-by-thread (level &optional header)
9244 "Temporarily lower score by LEVEL for current thread.
9245 See `gnus-kill-expiry-days'."
9247 (gnus-kill-file-temporarily-raise-by-thread (- level) header))
9249 (defun gnus-kill-file-temporarily-lower-by-xref (level &optional header)
9250 "Insert temporary score commands for articles that have been crossposted.
9251 By default use the current crossposted groups.
9252 See `gnus-kill-expiry-days'."
9254 (gnus-kill-file-lower-by-xref level header (current-time-string)))
9256 (defun gnus-kill-file-lower-by-subject (level &optional header date)
9257 "Lower score by LEVEL for current subject."
9259 (gnus-kill-file-raise-by-subject (- level) header date))
9261 (defun gnus-kill-file-lower-by-author (level &optional header date)
9262 "Lower score by LEVEL for current author."
9264 (gnus-kill-file-raise-by-author (- level) header date))
9266 (defun gnus-kill-file-lower-by-xref (level &optional header date)
9267 "Lower score by LEVEL for articles that have been crossposted.
9268 By default use the current crossposted groups."
9269 (gnus-kill-file-raise-by-xref (- level) header date))
9271 (defun gnus-kill-file-lower-followups-to-author
9272 (level &optional header)
9273 "Lower score for all followups to the current author."
9275 (gnus-kill-file-raise-followups-to-author (- level) header))
9277 (defun gnus-kill-file-apply-buffer ()
9278 "Apply current buffer to current newsgroup."
9280 (if (and gnus-current-kill-article
9281 (get-buffer gnus-summary-buffer))
9282 ;; Assume newsgroup is selected.
9283 (gnus-kill-file-apply-string (buffer-string))
9284 (ding) (message "No newsgroup is selected.")))
9286 (defun gnus-kill-file-apply-string (string)
9287 "Apply STRING to current newsgroup."
9289 (let ((string (concat "(progn \n" string "\n)" )))
9291 (save-window-excursion
9292 (pop-to-buffer gnus-summary-buffer)
9293 (eval (car (read-from-string string)))))))
9295 (defun gnus-kill-file-apply-last-sexp ()
9296 "Apply sexp before point in current buffer to current newsgroup."
9298 (if (and gnus-current-kill-article
9299 (get-buffer gnus-summary-buffer))
9300 ;; Assume newsgroup is selected.
9303 (save-excursion (forward-sexp -1) (point)) (point))))
9305 (save-window-excursion
9306 (pop-to-buffer gnus-summary-buffer)
9307 (eval (car (read-from-string string))))))
9308 (ding) (message "No newsgroup is selected.")))
9310 (defun gnus-kill-file-exit ()
9311 "Save a score file, then return to the previous buffer."
9314 (let ((killbuf (current-buffer)))
9315 ;; We don't want to return to article buffer.
9316 (and (get-buffer gnus-article-buffer)
9317 (bury-buffer gnus-article-buffer))
9318 ;; Delete the KILL file windows.
9319 (delete-windows-on killbuf)
9320 ;; Restore last window configuration if available.
9321 (and gnus-winconf-kill-file
9322 (set-window-configuration gnus-winconf-kill-file))
9323 (setq gnus-winconf-kill-file nil)
9324 ;; Kill the KILL file buffer. Suggested by tale@pawl.rpi.edu.
9325 (kill-buffer killbuf)))
9327 ;; Basic ideas by emv@math.lsa.umich.edu (Edward Vielmetti)
9329 (defalias 'gnus-batch-kill 'gnus-batch-score)
9331 (defun gnus-batch-score ()
9332 "Run batched scoring.
9333 Usage: emacs -batch -l gnus -f gnus-batch-kill <newsgroups> ...
9334 Newsgroups is a list of strings on the .newsrc options -n format.
9335 If you want to score the comp hierarchy, you'd say \"comp.all\". If
9336 you would not like to score the alt hierarchy, you'd say
9339 ; (or noninteractive
9340 ; (error "gnus-batch-kill is to be used only with -batch"))
9342 (gnus-parse-n-options
9343 (apply (function concat)
9344 (mapcar (lambda (g) (concat g " "))
9345 command-line-args-left))))
9346 (yes (car yes-and-no))
9347 (no (cdr yes-and-no))
9348 group subscribed newsrc entry
9349 ;; Disable verbose message.
9350 gnus-novice-user gnus-large-newsgroup)
9351 ;; Eat all arguments.
9352 (setq command-line-args-left nil)
9355 ;; Apply kills to specified newsgroups in command line arguments.
9356 (setq newsrc gnus-newsrc-assoc)
9358 (setq group (car (car newsrc)))
9359 (setq entry (gnus-gethash group gnus-newsrc-hashtb))
9360 (if (and (<= (nth 1 (car newsrc)) 5)
9362 (or (eq (car entry) t)
9363 (not (zerop (car entry)))))
9364 (if yes (string-match yes group) t)
9365 (or (null no) (not (string-match no group))))
9367 (gnus-summary-read-group group nil t)
9368 (and (eq (current-buffer) (get-buffer gnus-summary-buffer))
9369 (gnus-summary-exit))))
9370 (setq newsrc (cdr newsrc)))
9372 (set-buffer gnus-group-buffer)
9377 (defun gnus-Newsgroup-kill-file (newsgroup)
9378 "Return the name of a score file for NEWSGROUP.
9379 If NEWSGROUP is nil, return the global score file instead."
9380 (cond ((or (null newsgroup)
9381 (string-equal newsgroup ""))
9382 ;; The global score file is placed at top of the directory.
9383 (expand-file-name gnus-kill-file-name
9384 (or gnus-kill-files-directory "~/News")))
9385 (gnus-use-long-file-name
9386 ;; Append ".KILL" to capitalized newsgroup name.
9387 (expand-file-name (concat (gnus-capitalize-newsgroup newsgroup)
9388 "." gnus-kill-file-name)
9389 (or gnus-kill-files-directory "~/News")))
9391 ;; Place "KILL" under the hierarchical directory.
9392 (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
9393 "/" gnus-kill-file-name)
9394 (or gnus-kill-files-directory "~/News")))
9397 (defun gnus-newsgroup-kill-file (newsgroup)
9398 "Return the name of a score file name for NEWSGROUP.
9399 If NEWSGROUP is nil, return the global score file name instead."
9400 (cond ((or (null newsgroup)
9401 (string-equal newsgroup ""))
9402 ;; The global KILL file is placed at top of the directory.
9403 (expand-file-name gnus-kill-file-name
9404 (or gnus-kill-files-directory "~/News")))
9405 (gnus-use-long-file-name
9406 ;; Append ".KILL" to newsgroup name.
9407 (expand-file-name (concat newsgroup "." gnus-kill-file-name)
9408 (or gnus-kill-files-directory "~/News")))
9410 ;; Place "KILL" under the hierarchical directory.
9411 (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
9412 "/" gnus-kill-file-name)
9413 (or gnus-kill-files-directory "~/News")))
9417 (defalias 'gnus-expunge 'gnus-summary-remove-lines-marked-with)
9419 (defun gnus-apply-kill-file ()
9420 "Apply a score file to the current newsgroup.
9421 Returns the number of articles marked as read."
9422 (let* ((kill-files (list (gnus-newsgroup-kill-file nil)
9423 (gnus-newsgroup-kill-file gnus-newsgroup-name)))
9424 (unreads (length gnus-newsgroup-unreads))
9425 (gnus-summary-inhibit-highlight t)
9426 (mark-below (or gnus-summary-mark-below gnus-summary-default-score))
9427 (expunge-below gnus-summary-expunge-below)
9429 (setq gnus-newsgroup-kill-headers nil)
9430 (or gnus-newsgroup-headers-hashtb-by-number
9431 (gnus-make-headers-hashtable-by-number))
9432 ;; If there are any previously scored articles, we remove these
9433 ;; from the `gnus-newsgroup-headers' list that the score functions
9434 ;; will see. This is probably pretty wasteful when it comes to
9435 ;; conses, but is, I think, faster than having to assq in every
9436 ;; single score funtion.
9437 (let ((files kill-files))
9439 (if (file-exists-p (car files))
9440 (let ((headers gnus-newsgroup-headers))
9441 (if gnus-kill-killed
9442 (setq gnus-newsgroup-kill-headers
9443 (mapcar (lambda (header) (header-number header))
9446 (or (gnus-member-of-range
9447 (header-number (car headers))
9448 gnus-newsgroup-killed)
9449 (setq gnus-newsgroup-kill-headers
9450 (cons (header-number (car headers))
9451 gnus-newsgroup-kill-headers)))
9452 (setq headers (cdr headers))))
9454 (setq files (cdr files)))))
9455 (if gnus-newsgroup-kill-headers
9458 (if (file-exists-p (car kill-files))
9460 (message "Processing kill file %s..." (car kill-files))
9461 (find-file (car kill-files))
9462 (goto-char (point-min))
9465 (setq form (condition-case nil
9466 (read (current-buffer))
9468 (if (or (eq (car form) 'gnus-kill)
9469 (eq (car form) 'gnus-raise)
9470 (eq (car form) 'gnus-lower))
9472 (delete-region beg (point))
9473 (insert (or (eval form) "")))
9475 (and (buffer-modified-p) (save-buffer))
9476 (message "Processing kill file %s...done" (car kill-files))))
9477 (setq kill-files (cdr kill-files)))))
9478 (if expunge-below (gnus-summary-expunge-below expunge-below))
9479 (let (gnus-summary-inhibit-highlight)
9480 (gnus-summary-set-mark-below mark-below))
9482 (let ((nunreads (- unreads (length gnus-newsgroup-unreads))))
9484 (message "Marked %d articles as read" nunreads))
9488 ;; Kill changes and new format by suggested by JWZ and Sudish Joseph
9489 ;; <joseph@cis.ohio-state.edu>.
9490 (defun gnus-kill (field regexp &optional exe-command all)
9491 "If FIELD of an article matches REGEXP, execute COMMAND.
9492 Optional 1st argument COMMAND is default to
9493 (gnus-summary-mark-as-read nil \"X\").
9494 If optional 2nd argument ALL is non-nil, articles marked are also applied to.
9495 If FIELD is an empty string (or nil), entire article body is searched for.
9496 COMMAND must be a lisp expression or a string representing a key sequence."
9497 ;; We don't want to change current point nor window configuration.
9499 (save-window-excursion
9500 ;; Selected window must be summary buffer to execute keyboard
9501 ;; macros correctly. See command_loop_1.
9502 (switch-to-buffer gnus-summary-buffer 'norecord)
9503 (goto-char (point-min)) ;From the beginning.
9504 (let ((kill-list regexp)
9505 (date (current-time-string))
9506 (command (or exe-command '(gnus-summary-mark-as-read
9507 nil gnus-kill-file-mark)))
9509 (if (listp kill-list)
9511 (if (not (consp (cdr kill-list)))
9512 ;; It's on the form (regexp . date).
9513 (if (zerop (gnus-execute field (car kill-list)
9514 command nil (not all)))
9515 (if (> (gnus-days-between date (cdr kill-list))
9516 gnus-kill-expiry-days)
9518 (setcdr kill-list date))
9519 (while (setq kill (car kill-list))
9521 ;; It's a temporary kill.
9523 (setq kdate (cdr kill))
9524 (if (zerop (gnus-execute
9525 field (car kill) command nil (not all)))
9526 (if (> (gnus-days-between date kdate)
9527 gnus-kill-expiry-days)
9528 ;; Time limit has been exceeded, so we
9529 ;; remove the match.
9531 (setcdr prev (cdr kill-list))
9532 (setq regexp (cdr regexp))))
9533 ;; Successful kill. Set the date to today.
9534 (setcdr kill date)))
9535 ;; It's a permanent kill.
9536 (gnus-execute field kill command nil (not all)))
9537 (setq prev kill-list)
9538 (setq kill-list (cdr kill-list))))
9539 (gnus-execute field kill-list command nil (not all)))
9543 (nconc (list 'gnus-kill field
9544 (if (consp regexp) (list 'quote regexp) regexp))
9545 (if (or exe-command all) (list (list 'quote exe-command)))
9546 (if all (list t) nil)))))
9548 (defun gnus-pp-gnus-kill (object)
9549 (if (or (not (consp (nth 2 object)))
9550 (not (consp (cdr (nth 2 object))))
9551 (and (eq 'quote (car (nth 2 object)))
9552 (not (consp (cdr (car (cdr (nth 2 object))))))))
9553 (concat "\n" (prin1-to-string object))
9555 (set-buffer (get-buffer-create "*Gnus PP*"))
9556 (buffer-disable-undo (current-buffer))
9558 (insert (format "\n(%S %S\n '(" (nth 0 object) (nth 1 object)))
9559 (let ((klist (car (cdr (nth 2 object))))
9562 (insert (if first (progn (setq first nil) "") "\n ")
9563 (prin1-to-string (car klist)))
9564 (setq klist (cdr klist))))
9568 (if (and (consp (nth 3 object))
9569 (not (eq 'quote (car (nth 3 object)))))
9571 (prin1-to-string (nth 3 object))))
9576 (buffer-substring (point-min) (point-max))
9577 (kill-buffer (current-buffer))))))
9579 (defun gnus-execute-1 (function regexp form header)
9585 ;; Compare with header field.
9589 (setq value (funcall function header))
9590 ;; Number (Lines:) or symbol must be converted to string.
9592 (setq value (prin1-to-string value)))
9593 (setq did-kill (string-match regexp value)))
9594 (if (stringp form) ;Keyboard macro.
9595 (execute-kbd-macro form)
9597 ;; Search article body.
9598 (let ((gnus-current-article nil) ;Save article pointer.
9599 (gnus-last-article nil)
9600 (gnus-break-pages nil) ;No need to break pages.
9601 (gnus-mark-article-hook nil)) ;Inhibit marking as read.
9602 (message "Searching for article: %d..." (header-number header))
9603 (gnus-article-setup-buffer)
9604 (gnus-article-prepare (header-number header) t)
9606 (set-buffer gnus-article-buffer)
9607 (goto-char (point-min))
9608 (setq did-kill (re-search-forward regexp nil t)))
9609 (if (stringp form) ;Keyboard macro.
9610 (execute-kbd-macro form)
9614 (defun gnus-execute (field regexp form &optional backward ignore-marked)
9615 "If FIELD of article header matches REGEXP, execute lisp FORM (or a string).
9616 If FIELD is an empty string (or nil), entire article body is searched for.
9617 If optional 1st argument BACKWARD is non-nil, do backward instead.
9618 If optional 2nd argument IGNORE-MARKED is non-nil, articles which are
9619 marked as read or ticked are ignored."
9622 function header article)
9623 (if (or (null field) (string-equal field ""))
9625 ;; Get access function of header filed.
9626 (setq function (intern-soft (concat "gnus-header-" (downcase field))))
9627 (if (and function (fboundp function))
9628 (setq function (symbol-function function))
9629 (error "Unknown header field: \"%s\"" field))
9630 ;; Make FORM funcallable.
9631 (if (and (listp form) (not (eq (car form) 'lambda)))
9632 (setq form (list 'lambda nil form)))
9633 ;; Starting from the current article.
9634 (while (or (and (not article)
9635 (setq article (gnus-summary-article-number))
9638 (gnus-summary-search-subject
9639 backward (not ignore-marked))))
9640 (and (memq article gnus-newsgroup-kill-headers)
9641 (gnus-execute-1 function regexp form
9642 (gnus-get-header-by-number article))
9643 (setq killed-no (1+ killed-no)))))
9649 ;; All score code written by Per Abrahamsen <abraham@iesd.auc.dk>.
9651 (defun gnus-score-set (symbol value &optional alist)
9652 ;; Set SYMBOL to VALUE in ALIST.
9653 (let* ((alist (or alist gnus-score-alist
9655 (gnus-score-load gnus-newsgroup-name)
9657 (entry (assoc symbol alist)))
9659 (setcdr entry value))
9661 (error "Empty alist"))
9663 (setcdr alist (cons (cons symbol value) (cdr alist)))))))
9665 (defun gnus-score-get (symbol &optional alist)
9666 ;; Get SYMBOL's definition in ALIST.
9667 (cdr (assoc symbol (or alist gnus-score-alist
9669 (gnus-score-load gnus-newsgroup-name)
9670 gnus-score-alist)))))
9672 (defun gnus-score-edit-file (group)
9673 "Edit score file for GROUP."
9674 (interactive (list (read-string "Edit SCORE file for: "
9675 (cons (or gnus-newsgroup-name "") 1))))
9676 (and (get-buffer gnus-summary-buffer) (gnus-score-save))
9677 (find-file (gnus-score-file-name group))
9680 (defun gnus-score-load-file (file)
9681 ;; Load score file FILE.
9682 (let ((cache (assoc file gnus-score-cache)))
9684 (setq gnus-score-alist (cdr cache))
9685 (setq gnus-score-alist nil)
9687 (or gnus-score-alist
9688 (setq gnus-score-alist (copy-alist '((touched . nil)))))
9689 (setq gnus-score-cache
9690 (cons (cons file gnus-score-alist) gnus-score-cache))))
9691 (let ((mark (gnus-score-get 'mark))
9692 (expunge (gnus-score-get 'expunge))
9693 (files (gnus-score-get 'files))
9694 (eval (gnus-score-get 'eval)))
9695 (if files (mapcar (lambda (file) (gnus-score-load-file file)) files))
9696 (if eval (eval eval))
9697 (if mark (setq gnus-summary-mark-below mark))
9698 (if expunge (setq gnus-summary-expunge-below expunge))))
9700 (defun gnus-score-load (group)
9701 ;; Load score file for GROUP.
9702 ;; If optional argument NO-RECURSE is set, the files and eval
9703 ;; members will be ignored.
9704 ;; Updates free variables `gnus-score-alist' and `scores'.
9706 (let ((cache (assoc group gnus-score-cache)))
9708 (setq gnus-score-alist (cdr cache))
9709 (setq gnus-score-alist nil)
9710 (load (gnus-score-file-name group) t nil t)
9711 (or gnus-score-alist
9712 (setq gnus-score-alist (copy-alist '((touched . nil)))))
9713 (setq gnus-score-cache
9714 (cons (cons (gnus-score-file-name group)
9715 gnus-score-alist) gnus-score-cache))))
9716 (let ((mark (gnus-score-get 'mark))
9717 (expunge (gnus-score-get 'expunge))
9718 (files (gnus-score-get 'files))
9719 (eval (gnus-score-get 'eval)))
9720 (if eval (eval eval))
9721 (if mark (setq gnus-summary-mark-below mark))
9722 (if expunge (setq gnus-summary-expunge-below expunge))
9723 (if files (mapcar (lambda (file) (gnus-score-load-file file)) files))))
9725 (defun gnus-score-save ()
9726 ;; Save all SCORE information.
9729 (set-buffer gnus-summary-buffer)
9730 (setq cache gnus-score-cache
9731 gnus-score-cache nil))
9733 (setq gnus-score-alist nil)
9734 (set-buffer (get-buffer-create "*Score*"))
9735 (buffer-disable-undo)
9736 (let (entry score file)
9738 (setq entry (car cache)
9742 (if (null (gnus-score-get 'touched score))
9744 (gnus-score-set 'touched nil score)
9746 (pp (list 'setq 'gnus-score-alist (list 'quote score))
9748 (make-directory (file-name-directory file) t)
9749 (write-region (point-min) (point-max) file nil 'silent))))
9750 (kill-buffer (current-buffer)))))
9752 (defun gnus-score-headers ()
9753 ;; Score `gnus-newsgroup-headers'.
9754 (let ((score-files (gnus-score-files-for-group gnus-newsgroup-name))
9756 ;; Load the SCORE files.
9758 (gnus-score-load-file (car score-files))
9759 (if (< 1 (length gnus-score-alist))
9760 (setq scores (cons gnus-score-alist scores)))
9761 (setq score-files (cdr score-files)))
9762 (if (not (and gnus-summary-default-score
9764 (> (length gnus-newsgroup-headers)
9765 (length gnus-newsgroup-scored))))
9767 (let* ((entries gnus-header-index)
9768 (now (current-time-string))
9769 (expire (- (gnus-useful-date now) gnus-kill-expiry-days))
9770 (headers gnus-newsgroup-headers)
9771 entry articles header)
9772 (message "Scoring...")
9773 ;; Create articles, an alist of the form `(HEADER . SCORE)'.
9775 (setq header (car headers)
9776 headers (cdr headers))
9777 ;; WARNING: The assq makes the function O(N*S) while it could
9778 ;; be written as O(N+S), where N is (length gnus-newsgroup-headers)
9779 ;; and S is (length gnus-newsgroup-scored).
9780 (or (assq (header-number header) gnus-newsgroup-scored)
9781 (setq articles ;Total of 2 * N cons-cells used.
9782 (cons (cons header gnus-summary-default-score)
9786 (set-buffer (get-buffer-create "*Headers*"))
9787 (buffer-disable-undo)
9788 ;; Run each header through the score process.
9790 (setq entry (car entries)
9791 header (nth 0 entry)
9792 entries (cdr entries))
9793 (setq gnus-score-index (nth 1 (assoc header gnus-header-index)))
9794 (if (< 0 (apply 'max (mapcar
9796 (length (gnus-score-get header score)))
9799 ;; Sorting the articles costs os O(N*log N) but will
9800 ;; allow us to only match with each unique header.
9801 ;; Thus the actual matching will be O(M*U) where M
9802 ;; is the number of strings to match with, and U is
9803 ;; the number of unique headers. It is assumed (but
9804 ;; untested) this will be a net win because of the
9805 ;; large constant factor involved with string
9807 (message "Scoring...%s sort" header)
9808 (setq articles (sort articles 'gnus-score-compare-articles))
9809 (funcall (nth 2 entry) scores header articles now expire))))
9810 ;; Remove the buffer.
9811 (kill-buffer (current-buffer)))
9813 (message "Scoring...")
9814 ;; Add articles to `gnus-newsgroup-scored'.
9816 (or (= gnus-summary-default-score (cdr (car articles)))
9817 (setq gnus-newsgroup-scored
9818 (cons (cons (header-number (car (car articles)))
9819 (cdr (car articles)))
9820 gnus-newsgroup-scored)))
9821 (setq articles (cdr articles)))
9823 (message "Scoring...done")))))
9825 (defun gnus-score-integer (scores header articles now expire)
9828 (defun gnus-score-date (scores header articles now expire)
9831 (defun gnus-score-string (scores header articles now expire)
9832 ;; Score ARTICLES according to HEADER in SCORES.
9833 ;; Update matches entries to NOW and remove unmatched entried older
9836 ;; Insert the unique article headers in the buffer.
9837 (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
9838 ;; gnus-score-index is used as a free variable.
9839 alike last this art entries alist)
9841 (message "Scoring...%s build" header)
9844 (setq art (car articles)
9845 this (aref (car art) gnus-score-index)
9846 articles (cdr articles))
9847 (if (equal last this)
9848 ;; O(N*H) cons-cells used here, where H is the number of
9850 (setq alike (cons art alike))
9853 ;; Insert the line, with a text property on the
9854 ;; terminating newline refering to the articles with
9857 (put-text-property (1- (point)) (point) 'articles alike)))
9858 (setq alike (list art)
9860 (and last ; Bwadr, duplicate code.
9863 (put-text-property (1- (point)) (point) 'articles alike)))
9866 (message "Scoring...%s match" header)
9868 (setq alist (car scores)
9870 entries (assoc header alist))
9871 (while (cdr entries) ;First entry is the header index.
9872 (let* ((rest (cdr entries))
9874 (match (nth 0 kill))
9876 (score (nth 2 kill))
9879 (case-fold-search t)
9881 (goto-char (point-min))
9883 (re-search-forward match nil t)
9884 (search-forward match nil t))
9887 arts (get-text-property (point) 'articles))
9888 ;; Found a match, update scores.
9890 (setq art (car arts)
9892 (setcdr art (+ score (cdr art)))))
9893 ;; Update expire date
9894 (cond ((null date)) ;Permanent entry.
9895 (found ;Match, update date.
9896 (gnus-score-set 'touched t alist)
9897 (setcar (nthcdr 3 kill) now))
9898 ((< (gnus-useful-date date) expire) ;Old entry, remove.
9899 (gnus-score-set 'touched t alist)
9900 (setcdr entries (cdr rest))
9901 (setq rest entries)))
9902 (setq entries rest))))))
9904 (defun gnus-score-compare-articles (a1 a2)
9905 ;; Compare headers in articles A2 and A2.
9906 ;; The header index used is the free variable `gnus-score-index'.
9907 (string-lessp (aref (car a1) gnus-score-index)
9908 (aref (car a2) gnus-score-index)))
9910 (defun gnus-useful-date (date)
9911 ;; Return the numeric day corresponding to the DATE string.
9912 (let ((d (mapcar (lambda (s) (and s (string-to-int s)) )
9913 (timezone-parse-date date))))
9914 (timezone-absolute-from-gregorian (nth 1 d) (nth 2 d) (car d))))
9916 (defun gnus-score-build-cons (article)
9917 ;; Build a `gnus-newsgroup-scored' type cons from ARTICLE.
9918 (cons (header-number (car article)) (cdr article)))
9920 (defconst gnus-header-index
9921 ;; Name to index alist.
9922 '(("number" 0 gnus-score-integer)
9923 ("subject" 1 gnus-score-string)
9924 ("from" 2 gnus-score-string)
9925 ("date" 3 gnus-score-date)
9926 ("id" 4 gnus-score-string)
9927 ("references" 5 gnus-score-string)
9928 ("chars" 6 gnus-score-integer)
9929 ("lines" 7 gnus-score-integer)
9930 ("xref" 8 gnus-score-string)))
9932 (defvar gnus-score-file-suffix "SCORE"
9933 "Suffix of the score files.")
9935 (defun gnus-score-file-name (newsgroup)
9936 "Return the name of a score file for NEWSGROUP."
9937 (cond ((or (null newsgroup)
9938 (string-equal newsgroup ""))
9939 ;; The global score file is placed at top of the directory.
9940 (expand-file-name gnus-score-file-suffix
9941 (or gnus-kill-files-directory "~/News")))
9942 (gnus-use-long-file-name
9943 ;; Append ".SCORE" to newsgroup name.
9944 (expand-file-name (concat newsgroup "." gnus-score-file-suffix)
9945 (or gnus-kill-files-directory "~/News")))
9947 ;; Place "KILL" under the hierarchical directory.
9948 (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
9949 "/" gnus-score-file-suffix)
9950 (or gnus-kill-files-directory "~/News")))))
9952 (defun gnus-score-score-files (group)
9953 "Return a list of all possible score files."
9954 (or gnus-kill-files-directory (setq gnus-kill-files-directory "~/News/"))
9955 (if (not (file-exists-p gnus-kill-files-directory))
9956 (setq gnus-score-file-list nil)
9957 (if gnus-use-long-file-name
9958 (if (or (not gnus-score-file-list)
9959 (gnus-file-newer-than gnus-kill-files-directory
9960 (car gnus-score-file-list)))
9961 (setq gnus-score-file-list
9962 (cons (nth 5 (file-attributes gnus-kill-files-directory))
9964 gnus-kill-files-directory t
9965 (concat gnus-score-file-suffix "$")))))
9966 (let ((dir (expand-file-name
9967 (concat gnus-kill-files-directory
9968 (gnus-replace-chars-in-string group ?. ?/))))
9969 (mdir (length (expand-file-name gnus-kill-files-directory)))
9971 (if (file-exists-p (concat dir "/" gnus-score-file-suffix))
9972 (setq files (list (concat dir "/" gnus-score-file-suffix))))
9973 (while (>= (1+ (length dir)) mdir)
9974 (and (file-exists-p (concat dir "/all/" gnus-score-file-suffix))
9975 (setq files (cons (concat dir "/all/" gnus-score-file-suffix)
9977 (string-match "/[^/]*$" dir)
9978 (setq dir (substring dir (match-beginning 0))))
9979 (setq gnus-score-file-list (cons nil files)))))
9980 (cdr gnus-score-file-list))
9982 (defun gnus-score-files-for-group (group)
9983 "Return a list of score files for GROUP."
9984 (if (and gnus-score-find-score-files-function
9985 (fboundp gnus-score-find-score-files-function))
9986 (funcall gnus-score-find-score-files-function group)
9987 (if (not gnus-score-hierarchical)
9988 (let ((file (gnus-score-file-name group)))
9989 (and (file-exists-p file)
9991 (let ((sfiles (gnus-score-score-files group))
9992 (klen (length (expand-file-name gnus-kill-files-directory)))
9993 ofiles not-match regexp)
9995 (set-buffer (get-buffer-create "*gnus score files*"))
9996 (buffer-disable-undo)
9999 (insert (car sfiles))
10001 (re-search-forward (concat "." gnus-score-file-suffix "$"))
10005 (while (search-forward "all" nil t)
10006 (replace-match ".+"))
10008 (if (looking-at "not.")
10011 (setq regexp (buffer-substring 5 (point-max))))
10012 (setq regexp (buffer-substring 1 (point-max)))
10013 (setq not-match nil))
10014 (if (or (and not-match
10015 (not (string-match regexp group)))
10016 (and (not not-match)
10017 (string-match regexp group)))
10018 (setq ofiles (cons (car sfiles) ofiles)))
10019 (setq sfiles (cdr sfiles)))
10020 (kill-buffer (current-buffer))
10025 ;;; Gnus Posting Functions
10028 (defvar gnus-organization-file "/usr/lib/news/organization"
10029 "*Local news organization file.")
10031 (defvar gnus-post-news-buffer "*post-news*")
10032 (defvar gnus-winconf-post-news nil)
10034 (autoload 'news-reply-mode "rnewspost")
10036 ;;; Post news commands of Gnus group mode and summary mode
10038 (defun gnus-group-post-news ()
10041 ;; Save window configuration.
10042 (setq gnus-winconf-post-news (current-window-configuration))
10043 ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>.
10044 (or gnus-newsgroup-name (setq gnus-newsgroup-name (gnus-group-group-name)))
10046 (gnus-post-news 'post nil)
10047 (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer))
10048 (not (zerop (buffer-size))))
10049 ;; Restore last window configuration.
10050 (and gnus-winconf-post-news
10051 (set-window-configuration gnus-winconf-post-news))))
10052 ;; We don't want to return to summary buffer nor article buffer later.
10053 (setq gnus-winconf-post-news nil)
10054 (if (get-buffer gnus-summary-buffer)
10055 (bury-buffer gnus-summary-buffer))
10056 (if (get-buffer gnus-article-buffer)
10057 (bury-buffer gnus-article-buffer)))
10059 (defun gnus-summary-post-news ()
10062 ;; Save window configuration.
10063 (setq gnus-winconf-post-news (current-window-configuration))
10065 (gnus-post-news 'post gnus-newsgroup-name)
10066 (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer))
10067 (not (zerop (buffer-size))))
10068 ;; Restore last window configuration.
10069 (and gnus-winconf-post-news
10070 (set-window-configuration gnus-winconf-post-news))))
10071 ;; We don't want to return to article buffer later.
10072 (setq gnus-winconf-post-news nil)
10073 (if (get-buffer gnus-article-buffer)
10074 (bury-buffer gnus-article-buffer)))
10076 (defun gnus-summary-followup (yank)
10077 "Compose a followup to an article.
10078 If prefix argument YANK is non-nil, original article is yanked automatically."
10080 (gnus-summary-select-article t)
10081 (let ((headers gnus-current-headers)
10082 (gnus-newsgroup-name gnus-newsgroup-name))
10083 ;; Check Followup-To: poster.
10084 (set-buffer gnus-article-buffer)
10085 (if (and gnus-use-followup-to
10086 (string-equal "poster" (gnus-fetch-field "followup-to"))
10087 (or (not (eq gnus-use-followup-to t))
10089 "Do you want to ignore `Followup-To: poster'? "))))
10090 ;; Mail to the poster. Gnus is now RFC1036 compliant.
10091 (gnus-summary-reply yank)
10092 ;; Save window configuration.
10093 (setq gnus-winconf-post-news (current-window-configuration))
10095 (gnus-post-news 'followup headers gnus-article-buffer yank)
10096 (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer))
10097 (not (zerop (buffer-size))))
10098 ;; Restore last window configuration.
10099 (and gnus-winconf-post-news
10100 (set-window-configuration gnus-winconf-post-news))))
10101 ;; We don't want to return to article buffer later.
10102 (setq gnus-winconf-post-news nil)
10103 (bury-buffer gnus-article-buffer))))
10105 (defun gnus-summary-followup-with-original ()
10106 "Compose a followup to an article and include the original article."
10108 (gnus-summary-followup t))
10110 (defun gnus-summary-cancel-article ()
10111 "Cancel an article you posted."
10113 (gnus-summary-select-article t)
10114 (gnus-eval-in-buffer-window gnus-article-buffer
10115 (gnus-cancel-news)))
10117 (defun gnus-summary-supersede-article ()
10118 "Compose an article that will supersede a previous article.
10119 This is done simply by taking the old article and adding a Supersedes
10120 header line with the old Message-ID."
10124 (downcase (mail-strip-quoted-names
10125 (header-from gnus-current-headers)))
10126 (downcase (mail-strip-quoted-names (gnus-inews-user-name)))))
10127 (error "This article is not yours."))
10128 (gnus-summary-select-article t)
10130 (set-buffer gnus-article-buffer)
10131 (let ((buffer-read-only nil))
10132 (goto-char (point-min))
10133 (search-forward "\n\n" nil t)
10134 (if (not (re-search-backward "^Message-ID: " nil t))
10135 (error "No Message-ID in this article"))))
10136 (if (gnus-post-news 'post gnus-newsgroup-name)
10139 (insert-buffer gnus-article-buffer)
10140 (goto-char (point-min))
10141 (search-forward "\n\n" nil t)
10142 (if (not (re-search-backward "^Message-ID: " nil t))
10143 (error "No Message-ID in this article")
10144 (replace-match "Supersedes: "))
10145 (search-forward "\n\n")
10147 (insert mail-header-separator))))
10150 ;;; Post a News using NNTP
10153 (fset 'sendnews 'gnus-post-news)
10156 (fset 'postnews 'gnus-post-news)
10158 (defun gnus-post-news (method &optional header article-buffer yank)
10159 "Begin editing a new USENET news article to be posted.
10160 Type \\[describe-mode] in the buffer to get a list of commands."
10162 (if (or (not gnus-novice-user)
10166 (format "%s" (car (gnus-find-method-for-group
10167 gnus-newsgroup-name)))
10168 gnus-valid-select-methods))))
10169 (y-or-n-p "Are you sure you want to post to all of USENET? "))
10170 (let ((sumart (if (eq method 'followup)
10172 (set-buffer gnus-summary-buffer)
10173 (cons (current-buffer) gnus-current-article))))
10175 (if (and gnus-interactive-post
10176 (not gnus-expert-user)
10180 (completing-read "Group: " gnus-active-hashtb nil t)))
10181 (setq mail-reply-buffer article-buffer)
10182 (setq gnus-post-news-buffer
10184 (gnus-request-post-buffer
10185 method (if (stringp header)
10186 (gnus-group-real-name header) header)
10188 (if (eq method 'post)
10190 (delete-other-windows)
10191 (switch-to-buffer post-buf))
10192 (delete-other-windows)
10195 (switch-to-buffer article-buffer)
10196 (pop-to-buffer post-buf))
10197 (switch-to-buffer post-buf)))
10198 (gnus-overload-functions)
10199 (make-local-variable 'gnus-article-reply)
10200 (make-local-variable 'gnus-article-check-size)
10201 (setq gnus-article-reply sumart)
10202 ;; Handle author copy using BCC field.
10203 (if gnus-mail-self-blind
10205 (mail-position-on-field "BCC")
10206 (insert (if (stringp gnus-mail-self-blind)
10207 gnus-mail-self-blind
10208 (user-login-name)))))
10209 ;; Handle author copy using FCC field.
10210 (if gnus-author-copy
10212 (mail-position-on-field "FCC")
10213 (insert gnus-author-copy)))
10214 (goto-char (point-min))
10215 (if (and (eq method 'post) (not header))
10217 (search-forward (concat "\n" mail-header-separator "\n"))
10220 (run-hooks 'news-reply-header-hook)
10221 (mail-yank-original nil)))
10222 (if gnus-post-prepare-function
10223 (funcall gnus-post-prepare-function
10224 (if (stringp header) header gnus-newsgroup-name))))))
10225 (setq gnus-article-check-size (cons (buffer-size) (gnus-article-checksum)))
10229 (defun gnus-inews-news ()
10230 "Send a news message."
10232 ;; Check whether the article is a Good Net Citizen.
10233 (if (and gnus-article-check-size (not (gnus-inews-check-post)))
10236 ;; Looks ok, so we do the nasty.
10237 (let* ((case-fold-search nil)
10238 (server-running (gnus-server-opened gnus-select-method))
10239 (reply gnus-article-reply))
10241 ;; Connect to default NNTP server if necessary.
10242 ;; Suggested by yuki@flab.fujitsu.junet.
10243 (gnus-start-news-server) ;Use default server.
10244 ;; NNTP server must be opened before current buffer is modified.
10246 (goto-char (point-min))
10247 (run-hooks 'news-inews-hook)
10252 (goto-char (point-min))
10253 (search-forward (concat "\n" mail-header-separator "\n"))
10256 ;; Correct newsgroups field: change sequence of spaces to comma and
10257 ;; eliminate spaces around commas. Eliminate imbedded line breaks.
10258 (goto-char (point-min))
10259 (if (search-forward-regexp "^Newsgroups: +" nil t)
10263 (if (re-search-forward "^[^ \t]" nil 'end)
10264 (match-beginning 0)
10266 (goto-char (point-min))
10267 (replace-regexp "\n[ \t]+" " ") ;No line breaks (too confusing)
10268 (goto-char (point-min))
10269 (replace-regexp "[ \t\n]*,[ \t\n]*\\|[ \t]+" ",")))
10271 ;; Added by Per Abrahamsen <abraham@iesd.auc.dk>.
10272 ;; Help save the the world!
10275 (let ((newsgroups (mail-fetch-field "newsgroups"))
10276 (followup-to (mail-fetch-field "followup-to"))
10278 (if (and (string-match "," newsgroups) (not followup-to))
10280 (while (string-match "," newsgroups)
10282 (cons (list (substring newsgroups
10283 0 (match-beginning 0)))
10285 (setq newsgroups (substring newsgroups (match-end 0))))
10286 (setq groups (nreverse (cons (list newsgroups) groups)))
10289 (completing-read "Followups to: (default all groups) "
10291 (if (> (length to) 0)
10293 (goto-char (point-min))
10294 (insert "Followup-To: " to "\n")))))))
10296 ;; Cleanup Followup-To.
10297 (goto-char (point-min))
10298 (if (search-forward-regexp "^Followup-To: +" nil t)
10302 (if (re-search-forward "^[^ \t]" nil 'end)
10303 (match-beginning 0)
10305 (goto-char (point-min))
10306 (replace-regexp "\n[ \t]+" " ") ;No line breaks (too confusing)
10307 (goto-char (point-min))
10308 (replace-regexp "[ \t\n]*,[ \t\n]*\\|[ \t]+" ",")))
10310 ;; Mail the message too if To:, Bcc:. or Cc: exists.
10311 (if (or (mail-fetch-field "to" nil t)
10312 (mail-fetch-field "bcc" nil t)
10313 (mail-fetch-field "cc" nil t))
10314 (if gnus-mail-send-method
10316 (message "Sending via mail...")
10318 (funcall gnus-mail-send-method)
10319 (message "Sending via mail... done"))
10321 (message "No mailer defined. To: and/or Cc: fields ignored.")
10324 ;; Send to NNTP server.
10325 (message "Posting to USENET...")
10326 (if (gnus-inews-article)
10328 (message "Posting to USENET... done")
10330 (get-buffer (car reply))
10331 (buffer-name (car reply)))
10334 (set-buffer gnus-summary-buffer)
10335 (gnus-summary-mark-article-as-replied
10337 ;; We cannot signal an error.
10338 (ding) (message "Article rejected: %s"
10339 (gnus-status-message gnus-select-method)))
10340 (set-buffer-modified-p nil))
10341 ;; If NNTP server is opened by gnus-inews-news, close it by myself.
10343 (gnus-close-server (gnus-find-method-for-group gnus-newsgroup-name)))
10344 (and (fboundp 'bury-buffer) (bury-buffer))
10345 ;; Restore last window configuration.
10346 (and gnus-winconf-post-news
10347 (set-window-configuration gnus-winconf-post-news))
10348 (setq gnus-winconf-post-news nil))))
10350 (defun gnus-inews-check-post ()
10351 "Check whether the post looks ok."
10353 ;; Check excessive size.
10354 (if (> (buffer-size) 60000)
10355 (y-or-n-p (format "The article is %d octets long. Really post? "
10358 ;; Check for commands in Subject.
10361 (goto-char (point-min))
10362 (narrow-to-region (point) (search-forward mail-header-separator))
10363 (if (string-match "^cmsg " (mail-fetch-field "subject"))
10365 "The control code \"cmsg \" is in the subject. Really post? ")
10367 ;; Check for control characters.
10369 (if (re-search-forward "[\000-\007\013\015-\037\200-\237]" nil t)
10370 (y-or-n-p "The article contains control characters. Really post? ")
10372 ;; Check for multiple identical headers.
10376 (goto-char (point-min))
10377 (narrow-to-region (point) (search-forward mail-header-separator))
10378 (goto-char (point-min))
10379 (while (and (not found) (re-search-forward "^[^ \t:]+: " nil t))
10381 (or (re-search-forward
10382 (concat "^" (setq found
10383 (buffer-substring (match-beginning 0)
10386 (setq found nil))))
10388 (y-or-n-p (format "Multiple %s headers. Really post? " found))
10390 ;; Check for version and sendsys.
10393 (goto-char (point-min))
10394 (narrow-to-region (point) (search-forward mail-header-separator))
10395 (if (re-search-backward "^Sendsys:\\|^Version:" nil t)
10397 (format "The article contains a %s command. Really post? "
10398 (buffer-substring (match-beginning 0) (match-end 0))))
10402 (goto-char (point-min))
10403 (narrow-to-region (point) (search-forward mail-header-separator))
10404 (let* ((case-fold-search t)
10405 (from (mail-fetch-field "from")))
10407 (string-match "@" from)
10408 (not (string-match "@[^\\.]*\\." from)))
10410 (format "The domain looks strange: \"%s\". Really post? "
10413 ;; Use the (size . checksum) variable to see whether the
10414 ;; article is empty or has only quoted text.
10415 (if (and (= (buffer-size) (car gnus-article-check-size))
10416 (= (gnus-article-checksum) (cdr gnus-article-check-size)))
10417 (yes-or-no-p "It looks like there's no new text in your article. Really post? ")
10420 (defun gnus-article-checksum ()
10423 (while (not (eobp))
10424 (setq sum (logxor sum (following-char)))
10428 (defun gnus-cancel-news ()
10429 "Cancel an article you posted."
10431 (if (yes-or-no-p "Do you really want to cancel this article? ")
10435 (distribution nil))
10437 ;; Get header info. from original article.
10439 (gnus-article-show-all-headers)
10440 (goto-char (point-min))
10441 (search-forward "\n\n" nil 'move)
10442 (narrow-to-region (point-min) (point))
10443 (setq from (mail-fetch-field "from"))
10444 (setq newsgroups (mail-fetch-field "newsgroups"))
10445 (setq message-id (mail-fetch-field "message-id"))
10446 (setq distribution (mail-fetch-field "distribution")))
10447 ;; Verify if the article is absolutely user's by comparing
10448 ;; user id with value of its From: field.
10451 (downcase (mail-strip-quoted-names from))
10452 (downcase (mail-strip-quoted-names (gnus-inews-user-name)))))
10454 (ding) (message "This article is not yours."))
10455 ;; Make control article.
10456 (set-buffer (get-buffer-create " *Gnus-canceling*"))
10457 (buffer-disable-undo (current-buffer))
10459 (insert "Newsgroups: " newsgroups "\n"
10460 "Subject: cancel " message-id "\n"
10461 "Control: cancel " message-id "\n"
10462 mail-header-separator "\n"
10463 "This is a cancel message from " from ".\n")
10464 ;; Send the control article to NNTP server.
10465 (message "Canceling your article...")
10466 (if (gnus-inews-article)
10467 (message "Canceling your article... done")
10468 (ding) (message "Failed to cancel your article"))
10469 ;; Kill the article buffer.
10470 (kill-buffer (current-buffer))
10475 ;;; Lowlevel inews interface
10477 (defun gnus-inews-article ()
10478 "Post an article in current buffer using NNTP protocol."
10479 (let ((artbuf (current-buffer))
10480 (tmpbuf (get-buffer-create " *Gnus-posting*")))
10482 (goto-char (point-max))
10483 ;; require a newline at the end for inews to append .signature to
10484 (or (= (preceding-char) ?\n)
10486 ;; Prepare article headers. All message body such as signature
10487 ;; must be inserted before Lines: field is prepared.
10489 (goto-char (point-min))
10493 (search-forward (concat "\n" mail-header-separator "\n"))
10496 (gnus-inews-insert-headers)
10499 (set-buffer tmpbuf)
10500 (buffer-disable-undo (current-buffer))
10502 (insert-buffer-substring artbuf)
10503 ;; Remove the header separator.
10504 (goto-char (point-min))
10505 (search-forward (concat "\n" mail-header-separator "\n"))
10506 (replace-match "\n\n")
10507 ;; This hook may insert a signature.
10508 (run-hooks 'gnus-prepare-article-hook)
10509 ;; Run final inews hooks. This hook may do FCC.
10510 ;; The article must be saved before being posted because
10511 ;; `gnus-request-post' modifies the buffer.
10512 (run-hooks 'gnus-inews-article-hook)
10513 ;; Post an article to NNTP server.
10514 ;; Return NIL if post failed.
10516 (gnus-request-post (gnus-find-method-for-group gnus-newsgroup-name))
10517 (kill-buffer (current-buffer)))
10520 (defun gnus-inews-insert-headers ()
10521 "Prepare article headers.
10522 Headers already prepared in the buffer are not modified.
10523 Headers in `gnus-required-headers' will be generated."
10524 (let ((Date (gnus-inews-date))
10525 (Message-ID (gnus-inews-message-id))
10526 (Organization (gnus-inews-organization))
10527 (From (gnus-inews-user-name))
10528 (Path (gnus-inews-path))
10532 (Lines (gnus-inews-lines))
10533 (X-Newsreader gnus-version)
10534 (headers gnus-required-headers)
10535 (case-fold-search t)
10537 ;; First we remove any old Message-IDs. This might be slightly
10538 ;; fascist, but if the user really wants to generate Message-IDs
10539 ;; by herself, she should remove it from the `gnus-required-list'.
10540 (goto-char (point-min))
10541 (and (memq 'Message-ID headers)
10542 (re-search-forward "^Message-ID:" nil t)
10543 (delete-region (progn (beginning-of-line) (point))
10544 (progn (forward-line 1) (point))))
10545 ;; Remove NNTP-posting-host.
10546 (goto-char (point-min))
10547 (and (re-search-forward "nntp-posting-host^:" nil t)
10548 (delete-region (progn (beginning-of-line) (point))
10549 (progn (forward-line 1) (point))))
10550 ;; Insert new Sender if the From is strange.
10551 (let ((from (mail-fetch-field "from")))
10552 (if (and from (not (string= (downcase from) (downcase From))))
10554 (goto-char (point-min))
10555 (and (re-search-forward "^Sender:" nil t)
10556 (delete-region (progn (beginning-of-line) (point))
10557 (progn (forward-line 1) (point))))
10558 (insert "Sender: " From "\n"))))
10559 ;; If there are References, and no "Re: ", then the thread has
10560 ;; changed name. See Son-of-1036.
10561 (if (and (mail-fetch-field "references")
10562 (get-buffer gnus-article-buffer))
10563 (let ((psubject (gnus-simplify-subject-re
10564 (mail-fetch-field "subject")))
10567 (set-buffer (get-buffer gnus-article-buffer))
10569 (gnus-narrow-to-headers)
10570 (if (setq subject (mail-fetch-field "subject"))
10572 (and gnus-summary-gather-subject-limit
10573 (> (length subject) gnus-summary-gather-subject-limit)
10575 (substring subject 0
10576 gnus-summary-gather-subject-limit)))
10577 (setq subject (gnus-simplify-subject-re subject))))))
10578 (or (and psubject subject (string= subject psubject))
10580 (string-match "@" Message-ID)
10582 (concat (substring Message-ID 0 (match-beginning 0))
10584 (substring Message-ID (match-beginning 0))))))))
10585 ;; Go through all the required headers and see if they are in the
10586 ;; articles already. If they are not, or are empty, they are
10587 ;; inserted automatically - except for Subject, Newsgroups and
10590 (goto-char (point-min))
10591 (setq header (car headers))
10592 (if (or (not (re-search-forward
10593 (concat "^" (downcase (symbol-name header)) ":") nil t))
10595 (if (= (following-char) ? ) (forward-char 1) (insert " "))
10596 (looking-at "[ \t]*$")))
10598 (setq value (or (and (boundp header) (symbol-value header))
10599 (read-from-minibuffer
10600 (format "Empty header for %s; enter value: "
10604 (goto-char (point-max))
10605 (insert (symbol-name header) ": " value "\n"))
10606 (replace-match value))))
10607 (setq headers (cdr headers)))))
10609 (defun gnus-inews-insert-signature ()
10610 "Insert a signature file.
10611 If `gnus-signature-function' is bound and returns a string, this
10612 string is used instead of the variable `gnus-signature-file'.
10613 In either case, if the string is a file name, this file is
10614 inserted. If the string is not a file name, the string itself is
10616 If you never want any signature inserted, set both those variables to
10620 (or (and gnus-signature-function
10621 (fboundp gnus-signature-function)
10622 (funcall gnus-signature-function gnus-newsgroup-name))
10623 gnus-signature-file))
10626 (or (file-exists-p signature)
10627 (string-match " " signature)
10629 "^/[^/]+/" (expand-file-name signature)))))
10631 (goto-char (point-max))
10632 ;; Delete any previous signatures.
10633 (if (and mail-signature (search-backward "\n-- \n" nil t))
10634 (delete-region (1+ (point)) (point-max)))
10636 (and (< 4 (setq b (count-lines
10639 (if (file-exists-p signature)
10640 (insert-file-contents signature)
10641 (insert signature))
10642 (goto-char (point-max))
10643 (or (bolp) (insert "\n"))
10645 (not gnus-expert-user)
10649 "Your .sig is %d lines; it should be max 4. Really post? "
10651 (if (file-exists-p signature)
10652 (error (format "Edit %s." signature))
10653 (error "Trim your signature."))))))))
10655 (defun gnus-inews-do-fcc ()
10656 "Process FCC: fields in current article buffer.
10657 Unless the first character of the field is `|', the article is saved
10658 to the specified file using the function specified by the variable
10659 gnus-author-copy-saver. The default function rmail-output saves in
10660 Unix mailbox format.
10661 If the first character is `|', the contents of the article is send to
10662 a program specified by the rest of the value."
10663 (let ((fcc-list nil)
10665 (case-fold-search t)) ;Should ignore case.
10668 (goto-char (point-min))
10669 (search-forward "\n\n")
10670 (narrow-to-region (point-min) (point))
10671 (goto-char (point-min))
10672 (while (re-search-forward "^FCC:[ \t]*" nil t)
10674 (cons (buffer-substring
10678 (skip-chars-backward " \t")
10681 (delete-region (match-beginning 0)
10682 (progn (forward-line 1) (point))))
10683 ;; Process FCC operations.
10686 (setq fcc-file (car fcc-list))
10687 (setq fcc-list (cdr fcc-list))
10688 (cond ((string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" fcc-file)
10689 (let ((program (substring fcc-file
10690 (match-beginning 1) (match-end 1))))
10691 ;; Suggested by yuki@flab.fujitsu.junet.
10692 ;; Send article to named program.
10693 (call-process-region (point-min) (point-max) shell-file-name
10694 nil nil nil "-c" program)
10697 ;; Suggested by hyoko@flab.fujitsu.junet.
10698 ;; Save article in Unix mail format by default.
10699 (if (and gnus-author-copy-saver
10700 (not (eq gnus-author-copy-saver 'rmail-output)))
10701 (funcall gnus-author-copy-saver fcc-file)
10702 (if (and (file-readable-p fcc-file) (rmail-file-p fcc-file))
10703 (gnus-output-to-rmail fcc-file)
10704 (rmail-output fcc-file 1 t t)))
10710 (defun gnus-inews-path ()
10711 "Return uucp path."
10712 (let ((login-name (gnus-inews-login-name)))
10713 (cond ((null gnus-use-generic-path)
10714 (concat (nth 1 gnus-select-method) "!" login-name))
10715 ((stringp gnus-use-generic-path)
10716 ;; Support GENERICPATH. Suggested by vixie@decwrl.dec.com.
10717 (concat gnus-use-generic-path "!" login-name))
10721 (defun gnus-inews-user-name ()
10722 "Return user's network address as \"NAME@DOMAIN (FULL-NAME)\"."
10723 (let ((full-name (gnus-inews-full-name)))
10724 (concat (if (or gnus-user-login-name gnus-use-generic-from
10725 gnus-local-domain (getenv "DOMAINNAME"))
10726 (concat (gnus-inews-login-name) "@"
10727 (gnus-inews-domain-name gnus-use-generic-from))
10729 ;; User's full name.
10730 (cond ((string-equal full-name "") "")
10731 ((string-equal full-name "&") ;Unix hack.
10732 (concat " (" (user-login-name) ")"))
10734 (concat " (" full-name ")"))))))
10736 (defun gnus-inews-login-name ()
10737 "Return login name."
10738 (or gnus-user-login-name (getenv "LOGNAME") (user-login-name)))
10740 (defun gnus-inews-full-name ()
10741 "Return full user name."
10742 (or gnus-user-full-name (getenv "NAME") (user-full-name)))
10744 (defun gnus-inews-domain-name (&optional genericfrom)
10745 "Return user's domain name.
10746 If optional argument GENERICFROM is a string, use it as the domain
10747 name; if it is non-nil, strip off local host name from the domain name.
10748 If the function `system-name' returns full internet name and the
10749 domain is undefined, the domain name is got from it."
10750 (if (or genericfrom gnus-local-domain (getenv "DOMAINNAME"))
10752 (or (if (stringp genericfrom) genericfrom)
10753 (getenv "DOMAINNAME")
10755 ;; Function `system-name' may return full internet name.
10756 ;; Suggested by Mike DeCorte <mrd@sun.soe.clarkson.edu>.
10757 (if (string-match "\\." (system-name))
10758 (substring (system-name) (match-end 0)))
10759 (read-string "Domain name (no host): ")))
10760 (host (or (if (string-match "\\." (system-name))
10761 (substring (system-name) 0 (match-beginning 0)))
10763 (if (string-equal "." (substring domain 0 1))
10764 (setq domain (substring domain 1)))
10765 ;; Support GENERICFROM as same as standard Bnews system.
10766 ;; Suggested by ohm@kaba.junet and vixie@decwrl.dec.com.
10767 (cond ((null genericfrom)
10768 (concat host "." domain))
10769 ;;((stringp genericfrom) genericfrom)
10771 (substring user-mail-address (1+ (string-match "@" user-mail-address)))))
10773 (defun gnus-inews-full-address ()
10774 (let ((domain (gnus-inews-domain-name))
10775 (system (system-name))
10776 (case-fold-search t))
10777 (if (string-match "\\." system) system
10778 (if (string-match (concat "^" (regexp-quote system)) domain) domain
10779 (concat system "." domain)))))
10781 (defun gnus-inews-message-id ()
10782 "Generate unique Message-ID for user."
10783 ;; Message-ID should not contain a slash and should be terminated by
10784 ;; a number. I don't know the reason why it is so.
10785 (concat "<" (gnus-inews-unique-id) "@" (gnus-inews-full-address) ">"))
10787 (defconst gnus-inews-unique-id-char ?a)
10789 (defun gnus-inews-unique-id ()
10790 "Generate unique ID from user name and current time."
10791 (let* ((char (char-to-string
10792 (setq gnus-inews-unique-id-char
10793 (if (or (> gnus-inews-unique-id-char ?z)
10794 (< gnus-inews-unique-id-char ?a))
10795 ?a (1+ gnus-inews-unique-id-char)))))
10796 (date (timezone-parse-date (current-time-string)))
10797 (time (aref date 3))
10798 (user-name (downcase (gnus-inews-login-name)))
10801 (set-buffer (get-buffer-create " *gnus id work*"))
10802 (buffer-disable-undo)
10806 (goto-char (point-min))
10807 (while (re-search-forward "[^-a-zA-Z0-9\\.]" nil t)
10808 (replace-match (char-to-string (+ (random 26) ?a))))
10809 (setq user-name (buffer-substring (point-min) (point-max)))
10810 (kill-buffer (current-buffer)))
10816 (substring time 0 1)
10817 (substring time 3 4)
10818 (substring time 7 8)
10820 (let ((i (1- (length string)))
10823 (setq c (aref string i))
10824 (if (and (>= c ?0) (<= c ?9))
10825 (aset string i (- ?z (- c ?0))))
10829 (defun gnus-inews-date ()
10830 "Current time string."
10831 (timezone-make-date-arpa-standard (current-time-string)))
10833 (defun gnus-inews-organization ()
10834 "Return user's organization.
10835 The ORGANIZATION environment variable is used if defined.
10836 If not, the variable `gnus-local-organization' is used instead.
10837 If it is a function, the function will be called with the current
10838 newsgroup name as the argument.
10839 If this is a file name, the contents of this file will be used as the
10841 (let* ((organization
10842 (or (getenv "ORGANIZATION")
10843 (if gnus-local-organization
10844 (if (and (symbolp gnus-local-organization)
10845 (fboundp gnus-local-organization))
10846 (funcall gnus-local-organization gnus-newsgroup-name)
10847 gnus-local-organization))
10848 gnus-organization-file
10849 "~/.organization")))
10850 (and (stringp organization)
10851 (> (length organization) 0)
10852 (or (file-exists-p organization)
10853 (string-match " " organization)
10854 (not (string-match "^/[^/]+/" (expand-file-name organization))))
10856 (set-buffer (get-buffer-create " *Gnus organization*"))
10857 (buffer-disable-undo (current-buffer))
10859 (if (file-exists-p organization)
10860 (insert-file-contents organization)
10861 (insert organization))
10862 (goto-char (point-min))
10863 (while (re-search-forward " *\n *" nil t)
10864 (replace-match " "))
10865 (buffer-substring (point-min) (point-max))))))
10867 (defun gnus-inews-lines ()
10868 "Count the number of lines and return numeric string."
10872 (goto-char (point-min))
10873 (search-forward "\n\n" nil 'move)
10874 (int-to-string (count-lines (point) (point-max))))))
10878 ;;; Gnus Mail Functions
10881 (autoload 'news-mail-reply "rnewspost")
10882 (autoload 'news-mail-other-window "rnewspost")
10884 ;;; Mail reply commands of Gnus summary mode
10886 (defun gnus-summary-reply (yank)
10887 "Reply mail to news author.
10888 If prefix argument YANK is non-nil, original article is yanked automatically.
10889 Customize the variable gnus-mail-reply-method to use another mailer."
10891 ;; Bug fix by jbw@bigbird.bu.edu (Joe Wells)
10892 ;; Stripping headers should be specified with mail-yank-ignored-headers.
10893 (gnus-summary-select-article t)
10894 (setq gnus-winconf-post-news (current-window-configuration))
10895 (let ((gnus-newsgroup-name gnus-newsgroup-name))
10896 (bury-buffer gnus-article-buffer)
10897 (funcall gnus-mail-reply-method yank)))
10899 (defun gnus-summary-reply-with-original ()
10900 "Reply mail to news author with original article.
10901 Customize the variable gnus-mail-reply-method to use another mailer."
10903 (gnus-summary-reply t))
10905 (defun gnus-summary-mail-forward ()
10906 "Forward the current message to another user.
10907 Customize the variable gnus-mail-forward-method to use another mailer."
10909 (gnus-summary-select-article t)
10910 (set-buffer gnus-article-buffer)
10911 (let ((gnus-newsgroup-name gnus-newsgroup-name))
10912 (funcall gnus-mail-forward-method)))
10914 (defun gnus-summary-mail-other-window ()
10915 "Compose mail in other window.
10916 Customize the variable `gnus-mail-other-window-method' to use another
10919 (let ((gnus-newsgroup-name gnus-newsgroup-name))
10920 (funcall gnus-mail-other-window-method)))
10922 (defun gnus-mail-reply-using-mail (&optional yank to-address)
10924 (set-buffer gnus-summary-buffer)
10925 (let ((info (nth 2 (gnus-gethash gnus-newsgroup-name gnus-newsrc-hashtb)))
10926 (group (gnus-group-real-name gnus-newsgroup-name))
10927 (cur (cons (current-buffer) gnus-current-article))
10928 from subject date to reply-to message-of
10929 references message-id sender follow-to cc)
10930 (set-buffer (get-buffer-create "*mail*"))
10932 (make-local-variable 'gnus-article-reply)
10933 (setq gnus-article-reply cur)
10934 (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)
10935 (if (and (buffer-modified-p)
10936 (> (buffer-size) 0)
10937 (not (y-or-n-p "Unsent article being composed; erase it? ")))
10941 (set-buffer gnus-article-buffer)
10942 (let ((buffer-read-only nil))
10943 (goto-char (point-min))
10944 (narrow-to-region (point-min)
10945 (progn (search-forward "\n\n") (point)))
10946 (add-text-properties (point-min) (point-max) '(invisible nil)))
10947 (if (and (boundp 'gnus-reply-to-function)
10948 gnus-reply-to-function)
10951 (gnus-narrow-to-headers)
10952 (setq follow-to (funcall gnus-reply-to-function group)))))
10953 (setq from (mail-fetch-field "from"))
10954 (setq date (mail-fetch-field "date"))
10957 (string-match " *at \\| *@ \\| *(\\| *<" from)))
10959 (concat (if stop-pos (substring from 0 stop-pos) from)
10960 "'s message of " date))))
10961 (setq sender (mail-fetch-field "sender"))
10962 (setq subject (or (mail-fetch-field "subject")
10964 (or (string-match "^[Rr][Ee]:" subject)
10965 (setq subject (concat "Re: " subject)))
10966 (setq cc (mail-fetch-field "cc"))
10967 (setq reply-to (mail-fetch-field "reply-to"))
10968 (setq references (mail-fetch-field "references"))
10969 (setq message-id (mail-fetch-field "message-id"))
10971 (setq news-reply-yank-from from)
10972 (setq news-reply-yank-message-id message-id)
10973 (mail-setup (or to-address follow-to reply-to from sender "")
10974 subject message-of nil gnus-article-buffer nil)
10975 ;; Fold long references line to follow RFC1036.
10976 (mail-position-on-field "References")
10977 (let ((begin (- (point) (length "References: ")))
10979 (fill-prefix "\t"))
10980 (if references (insert references))
10981 (if (and references message-id) (insert " "))
10982 (if message-id (insert message-id))
10983 ;; The region must end with a newline to fill the region
10984 ;; without inserting extra newline.
10985 (fill-region-as-paragraph begin (1+ (point))))
10986 (goto-char (point-min))
10987 (search-forward (concat "\n" mail-header-separator "\n"))
10989 (let ((last (point)))
10990 (run-hooks 'news-reply-header-hook)
10991 (mail-yank-original nil)
10992 (goto-char last))))
10994 (let ((mail (current-buffer)))
10995 (switch-to-buffer gnus-article-buffer)
10996 (delete-other-windows)
10997 (switch-to-buffer-other-window mail))
10998 (delete-other-windows)
10999 (switch-to-buffer (current-buffer))))))
11001 (defun gnus-mail-yank-original ()
11003 (run-hooks 'news-reply-header-hook)
11004 (mail-yank-original nil))
11006 (defun gnus-mail-send-and-exit ()
11008 (let ((cbuf (current-buffer)))
11009 (mail-send-and-exit nil)
11010 (if (get-buffer gnus-group-buffer)
11014 (let ((reply gnus-article-reply))
11016 (get-buffer (car reply))
11017 (buffer-name (car reply)))
11019 (set-buffer (car reply))
11020 (gnus-summary-mark-article-as-replied
11022 (and gnus-winconf-post-news
11023 (set-window-configuration gnus-winconf-post-news))
11024 (setq gnus-winconf-post-news nil)))))
11026 (defun gnus-mail-forward-using-mail ()
11027 "Forward the current message to another user using mail."
11028 ;; This is almost a carbon copy of rmail-forward in rmail.el.
11029 (let ((forward-buffer (current-buffer))
11031 (concat "[" gnus-newsgroup-name "] "
11032 (or (gnus-fetch-field "Subject") "")))
11034 ;; If only one window, use it for the mail buffer.
11035 ;; Otherwise, use another window for the mail buffer
11036 ;; so that the Rmail buffer remains visible
11037 ;; and sending the mail will get back to it.
11038 (if (if (one-window-p t)
11039 (mail nil nil subject)
11040 (mail-other-window nil nil subject))
11042 (setq beg (goto-char (point-max)))
11043 (insert "------- Start of forwarded message -------\n")
11044 (insert-buffer forward-buffer)
11045 (goto-char (point-max))
11046 (insert "------- End of forwarded message -------\n")
11047 ;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
11049 (while (setq beg (next-single-property-change (point) 'invisible))
11051 (delete-region beg (or (next-single-property-change
11052 (point) 'invisible)
11054 ;; You have a chance to arrange the message.
11055 (run-hooks 'gnus-mail-forward-hook)))))
11057 (defun gnus-mail-other-window-using-mail ()
11058 "Compose mail other window using mail."
11059 (news-mail-other-window)
11060 (gnus-overload-functions))
11067 (defvar gnus-dribble-ignore nil)
11069 (defun gnus-dribble-file-name ()
11070 (concat gnus-startup-file "-dribble"))
11072 (defun gnus-dribble-open ()
11075 (setq gnus-dribble-buffer (find-file-noselect (gnus-dribble-file-name))))
11076 (buffer-disable-undo (current-buffer))
11077 (bury-buffer gnus-dribble-buffer)
11079 (goto-char (point-max))))
11081 (defun gnus-dribble-enter (string)
11082 (if (not gnus-dribble-ignore)
11083 (let ((obuf (current-buffer)))
11084 (set-buffer gnus-dribble-buffer)
11085 (insert string "\n")
11086 (set-window-point (get-buffer-window (current-buffer)) (point-max))
11087 (set-buffer obuf))))
11089 (defun gnus-dribble-read-file ()
11090 (let ((dribble-file (gnus-dribble-file-name)))
11092 (set-buffer (setq gnus-dribble-buffer
11094 (file-name-nondirectory dribble-file))))
11095 (gnus-add-current-to-buffer-list)
11097 (set-visited-file-name dribble-file)
11098 (buffer-disable-undo (current-buffer))
11099 (bury-buffer (current-buffer))
11100 (set-buffer-modified-p nil)
11101 (let ((auto (make-auto-save-file-name))
11102 (gnus-dribble-ignore t))
11103 (if (or (file-exists-p auto) (file-exists-p dribble-file))
11105 (if (file-newer-than-file-p auto dribble-file)
11106 (setq dribble-file auto))
11107 (insert-file-contents dribble-file)
11108 (if (not (zerop (buffer-size)))
11109 (set-buffer-modified-p t))
11110 (if (y-or-n-p "Auto-save file exists. Do you want to read it? ")
11112 (message "Reading %s..." dribble-file)
11113 (eval-current-buffer)
11114 (message "Reading %s...done" dribble-file)))))))))
11116 (defun gnus-dribble-delete-file ()
11118 (set-buffer gnus-dribble-buffer)
11119 (let ((auto (make-auto-save-file-name)))
11120 (if (file-exists-p auto)
11121 (delete-file auto))
11122 (if (file-exists-p (gnus-dribble-file-name))
11123 (delete-file (gnus-dribble-file-name)))
11125 (set-buffer-modified-p nil))))
11127 (defun gnus-dribble-save ()
11128 (if (and gnus-dribble-buffer
11129 (buffer-name gnus-dribble-buffer))
11131 (set-buffer gnus-dribble-buffer)
11134 (defun gnus-dribble-clear ()
11136 (if (and gnus-dribble-buffer
11137 (buffer-name (get-buffer gnus-dribble-buffer)))
11139 (set-buffer gnus-dribble-buffer)
11141 (set-buffer-modified-p nil)
11142 (setq buffer-saved-size (buffer-size))))))
11145 ;;; Server Communication
11148 (defun gnus-start-news-server (&optional confirm)
11149 "Open a method for getting news.
11150 If CONFIRM is non-nil, the user will be asked for an NNTP server."
11152 (if gnus-current-select-method
11153 ;; Stream is already opened.
11155 ;; Open NNTP server.
11156 (if (null gnus-nntp-service) (setq gnus-nntp-server nil))
11159 ;; Read server name with completion.
11160 (setq gnus-nntp-server
11161 (completing-read "NNTP server: "
11162 (mapcar (lambda (server) (list server))
11163 (cons (list gnus-nntp-server)
11164 gnus-secondary-servers))
11165 nil nil gnus-nntp-server))
11166 (setq gnus-select-method
11167 (list 'nntp gnus-nntp-server)))
11169 (if (and gnus-nntp-server
11170 (stringp gnus-nntp-server)
11171 (not (string= gnus-nntp-server "")))
11172 (setq gnus-select-method
11173 (cond ((or (string= gnus-nntp-server "")
11174 (string= gnus-nntp-server "::"))
11175 (list 'nnspool (system-name)))
11176 ((string-match ":" gnus-nntp-server)
11177 (list 'nnmh gnus-nntp-server))
11179 (list 'nntp gnus-nntp-server))))))
11181 (setq how (car gnus-select-method))
11182 (setq where (car (cdr gnus-select-method)))
11183 (cond ((eq how 'nnspool)
11185 (message "Looking up local news spool..."))
11188 (message "Looking up mh spool..."))
11191 (setq gnus-current-select-method gnus-select-method)
11192 (run-hooks 'gnus-open-server-hook)
11194 ;; gnus-open-server-hook might have opened it
11195 (gnus-server-opened gnus-select-method)
11196 (gnus-open-server gnus-select-method)
11197 (error "%s" (gnus-nntp-message
11198 (format "Cannot open NNTP server on %s"
11200 gnus-select-method)))
11202 (defun gnus-check-news-server (method)
11203 "If the news server is down, start it up again."
11204 (let ((method (if method method gnus-select-method)))
11205 (if (gnus-server-opened method)
11206 ;; Stream is already opened.
11209 (message "Opening server %s on %s..." (car method) (nth 1 method))
11210 (run-hooks 'gnus-open-server-hook)
11211 (or (gnus-server-opened method)
11212 (gnus-open-server method))
11215 (defun gnus-nntp-message (&optional message)
11216 "Check the status of the NNTP server.
11217 If the status of the server is clear and MESSAGE is non-nil, MESSAGE
11218 is returned insted of the status string."
11219 (let ((status (gnus-status-message (gnus-find-method-for-group
11220 gnus-newsgroup-name)))
11221 (message (or message "")))
11222 (if (and (stringp status) (> (length status) 0))
11225 (defun gnus-get-function (method function)
11226 (let ((func (intern (format "%s-%s" (car method) function))))
11227 (if (not (fboundp func))
11229 (require (car method))
11230 (if (not (fboundp func))
11231 (error "No such function: %s" func))))
11234 ;; Specifying port number suggested by Stephane Laveau <laveau@corse.inria.fr>.
11235 (defun gnus-open-server (method)
11236 (apply (gnus-get-function method 'open-server) (cdr method)))
11238 (defun gnus-close-server (method)
11239 (funcall (gnus-get-function method 'close-server) (nth 1 method)))
11241 (defun gnus-request-list (method)
11242 (funcall (gnus-get-function method 'request-list) (nth 1 method)))
11244 (defun gnus-request-list-newsgroups (method)
11245 (funcall (gnus-get-function method 'request-list-newsgroups) (nth 1 method)))
11247 (defun gnus-request-newgroups (date method)
11248 (funcall (gnus-get-function method 'request-newgroups)
11249 date (nth 1 method)))
11251 (defun gnus-server-opened (method)
11252 (funcall (gnus-get-function method 'server-opened) (nth 1 method)))
11254 (defun gnus-status-message (method)
11255 (funcall (gnus-get-function method 'status-message) (nth 1 method)))
11257 (defun gnus-request-group (group &optional dont-check)
11258 (let ((method (gnus-find-method-for-group group)))
11259 (funcall (gnus-get-function method 'request-group)
11260 (gnus-group-real-name group) (nth 1 method) dont-check)))
11262 (defun gnus-close-group (group)
11263 (let ((method (gnus-find-method-for-group group)))
11264 (funcall (gnus-get-function method 'close-group)
11265 (gnus-group-real-name group) (nth 1 method))))
11267 (defun gnus-retrieve-headers (articles group)
11268 (let ((method (gnus-find-method-for-group group)))
11269 (funcall (gnus-get-function method 'retrieve-headers)
11270 articles (gnus-group-real-name group) (nth 1 method))))
11272 (defun gnus-request-article (article group buffer)
11273 (let ((method (gnus-find-method-for-group group)))
11274 (funcall (gnus-get-function method 'request-article)
11275 article (gnus-group-real-name group) (nth 1 method) buffer)))
11277 (defun gnus-request-head (article group)
11278 (let ((method (gnus-find-method-for-group group)))
11279 (funcall (gnus-get-function method 'request-head)
11280 article (gnus-group-real-name group) (nth 1 method))))
11282 ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>.
11283 (defun gnus-request-post-buffer (post header artbuf)
11284 (let* ((group gnus-newsgroup-name)
11285 (info (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))
11287 (if (and gnus-post-method
11288 ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>.
11290 (format "%s" (car (gnus-find-method-for-group
11291 gnus-newsgroup-name)))
11292 gnus-valid-select-methods)))
11294 (gnus-find-method-for-group gnus-newsgroup-name))))
11295 (funcall (gnus-get-function method 'request-post-buffer)
11296 post header artbuf (gnus-group-real-name group) info)))
11298 (defun gnus-request-post (method)
11299 (and gnus-post-method
11300 (memq 'post (assoc (format "%s" (car method))
11301 gnus-valid-select-methods))
11302 (setq method gnus-post-method))
11303 (funcall (gnus-get-function method 'request-post)
11306 (defun gnus-request-expire-articles (articles group &optional force)
11307 (let ((method (gnus-find-method-for-group group)))
11308 (funcall (gnus-get-function method 'request-expire-articles)
11309 articles (gnus-group-real-name group) (nth 1 method)
11312 (defun gnus-request-move-article (article group server accept-function)
11313 (let ((method (gnus-find-method-for-group group)))
11314 (funcall (gnus-get-function method 'request-move-article)
11315 article (gnus-group-real-name group)
11316 (nth 1 method) accept-function)))
11318 (defun gnus-request-accept-article (group)
11319 (let ((func (if (symbolp group) group
11320 (car (gnus-find-method-for-group group)))))
11321 (funcall (intern (format "%s-request-accept-article" func))
11322 (if (stringp group) (gnus-group-real-name group)
11325 (defun gnus-find-method-for-group (group)
11326 (let ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))))
11328 (not (nth 4 info)))
11332 (defun gnus-check-backend-function (func group)
11333 (let ((method (if (stringp group) (car (gnus-find-method-for-group group))
11335 (fboundp (intern (format "%s-%s" method func)))))
11337 (defun gnus-methods-using (method)
11338 (let ((valids gnus-valid-select-methods)
11341 (if (memq method (car valids))
11342 (setq outs (cons (car valids) outs)))
11343 (setq valids (cdr valids)))
11347 ;;; Active & Newsrc File Handling
11350 ;; Newsrc related functions.
11351 ;; Gnus internal format of gnus-newsrc-assoc:
11352 ;; (("alt.general" 3 (1 . 1))
11353 ;; ("alt.misc" 3 ((1 . 10) (12 . 15)))
11354 ;; ("alt.test" 7 (1 . 99) (45 57 93)) ...)
11355 ;; The first item is the group name; the second is the subscription
11356 ;; level; the third is either a range of a list of ranges of read
11357 ;; articles, the optional fourth element is a list of marked articles,
11358 ;; the optional fifth element is the select method.
11360 ;; Gnus internal format of gnus-newsrc-hashtb:
11361 ;; (95 ("alt.general" 3 (1 . 1)) ("alt.misc" 3 ((1 . 10) (12 . 15))) ...)
11362 ;; This is the entry for "alt.misc". The first element is the number
11363 ;; of unread articles in "alt.misc". The cdr of this entry is the
11364 ;; element *before* "alt.misc" in gnus-newsrc-assoc, which makes is
11365 ;; trivial to remove or add new elements into gnus-newsrc-assoc
11366 ;; without scanning the entire list. So, to get the actual information
11367 ;; of "alt.misc", you'd say something like
11368 ;; (nth 2 (gnus-gethash "alt.misc" gnus-newsrc-hashtb))
11370 ;; Gnus internal format of gnus-active-hashtb:
11374 ;; The only element in each entry in this hash table is a range of
11375 ;; (possibly) available articles. (Articles in this range may have
11376 ;; been expired or cancelled.)
11378 ;; Gnus internal format of gnus-killed-list and gnus-zombie-list:
11379 ;; ("alt.misc" "alt.test" "alt.general" ...)
11381 (defun gnus-setup-news (&optional rawfile level)
11382 "Setup news information.
11383 If RAWFILE is non-nil, the .newsrc file will also be read.
11384 If LEVEL is non-nil, the news will be set up at level LEVEL."
11385 (let ((init (not (and gnus-newsrc-assoc gnus-active-hashtb (not rawfile)))))
11386 ;; Clear some variables to re-initialize news information.
11387 (if init (setq gnus-newsrc-assoc nil gnus-active-hashtb nil))
11388 ;; Read the active file and create `gnus-active-hashtb'.
11389 ;; If `gnus-read-active-file' is nil, then we just create an empty
11390 ;; hash table. The partial filling out of the hash table will be
11391 ;; done in `gnus-get-unread-articles'.
11392 (if (and gnus-read-active-file (not level))
11393 (gnus-read-active-file)
11394 (setq gnus-active-hashtb (make-vector 4095 0)))
11396 ;; Read the newsrc file and create `gnus-newsrc-hashtb'.
11397 (if init (gnus-read-newsrc-file rawfile))
11398 ;; Find the number of unread articles in each non-dead group.
11399 (gnus-get-unread-articles (or level 6))
11400 ;; Find new newsgroups and treat them.
11401 (if (and init gnus-check-new-newsgroups gnus-read-active-file (not level))
11402 (gnus-find-new-newsgroups))
11403 (if (and init gnus-check-bogus-newsgroups
11404 gnus-read-active-file (not level))
11405 (gnus-check-bogus-newsgroups))))
11407 (defun gnus-find-new-newsgroups ()
11408 "Search for new newsgroups and add them.
11409 Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.'
11410 The `-n' option line from .newsrc is respected."
11412 (or (gnus-check-first-time-used)
11413 (if (eq gnus-check-new-newsgroups 'ask-server)
11414 (gnus-ask-server-for-new-groups)
11416 group new-newsgroups)
11417 (or gnus-have-read-active-file (gnus-read-active-file))
11418 (setq gnus-newsrc-last-checked-date (current-time-string))
11419 (if (not gnus-killed-hashtb) (gnus-make-hashtable-from-killed))
11420 ;; Go though every newsgroup in `gnus-active-hashtb' and compare
11421 ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'.
11424 (setq group (symbol-name sym))
11425 (if (or (gnus-gethash group gnus-killed-hashtb)
11426 (gnus-gethash group gnus-newsrc-hashtb))
11428 (if (and gnus-newsrc-options-n-yes
11429 (string-match gnus-newsrc-options-n-yes group))
11431 (setq groups (1+ groups))
11432 (gnus-sethash group group gnus-killed-hashtb)
11433 (funcall gnus-subscribe-options-newsgroup-method group))
11434 (if (or (null gnus-newsrc-options-n-no)
11435 (not (string-match gnus-newsrc-options-n-no group)))
11438 (setq groups (1+ groups))
11439 (gnus-sethash group group gnus-killed-hashtb)
11440 (if gnus-subscribe-hierarchical-interactive
11441 (setq new-newsgroups (cons group new-newsgroups))
11442 (funcall gnus-subscribe-newsgroup-method group)))))))
11443 gnus-active-hashtb)
11445 (gnus-subscribe-hierarchical-interactive new-newsgroups))
11446 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
11448 (message "%d new newsgroup%s arrived."
11449 groups (if (> groups 1) "s have" " has")))))))
11451 (defun gnus-ask-server-for-new-groups ()
11452 (let* ((date (timezone-parse-date (or gnus-newsrc-last-checked-date
11453 (current-time-string))))
11454 (methods (cons gnus-select-method gnus-secondary-select-methods))
11456 (format "%s%02d%02d %s%s%s"
11457 (substring (aref date 0) 2) (string-to-int (aref date 1))
11458 (string-to-int (aref date 2)) (substring (aref date 3) 0 2)
11459 (substring (aref date 3) 3 5) (substring (aref date 3) 6 8)))
11461 (new-date (current-time-string))
11462 hashtb group new-newsgroups)
11464 (if (gnus-request-newgroups time-string (car methods))
11466 (or hashtb (setq hashtb (gnus-make-hashtable
11467 (count-lines (point-min) (point-max)))))
11468 (set-buffer nntp-server-buffer)
11469 (gnus-active-to-gnus-format (car methods) hashtb)))
11470 (setq methods (cdr methods)))
11472 (lambda (group-sym)
11473 (setq group (symbol-name group-sym))
11474 (gnus-sethash group (symbol-value group-sym) gnus-active-hashtb)
11475 (if (and gnus-newsrc-options-n-yes
11476 (string-match gnus-newsrc-options-n-yes group))
11478 (setq groups (1+ groups))
11479 (funcall gnus-subscribe-options-newsgroup-method group))
11480 (if (or (null gnus-newsrc-options-n-no)
11481 (not (string-match gnus-newsrc-options-n-no group)))
11484 (setq groups (1+ groups))
11485 (if gnus-subscribe-hierarchical-interactive
11486 (setq new-newsgroups (cons group new-newsgroups))
11487 (funcall gnus-subscribe-newsgroup-method group))))))
11490 (gnus-subscribe-hierarchical-interactive new-newsgroups))
11491 (setq gnus-newsrc-last-checked-date new-date)
11492 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
11494 (message "%d new newsgroup%s arrived."
11495 groups (if (> groups 1) "s have" " has")))))
11497 (defun gnus-check-first-time-used ()
11498 (if (or (file-exists-p gnus-startup-file)
11499 (file-exists-p (concat gnus-startup-file ".el"))
11500 (file-exists-p (concat gnus-startup-file ".eld")))
11502 (message "First time user; subscribing you to default groups")
11503 (or gnus-have-read-active-file (gnus-read-active-file))
11504 (setq gnus-newsrc-last-checked-date (current-time-string))
11505 (let ((groups gnus-default-subscribed-newsgroups)
11509 (setq groups (or groups gnus-backup-default-subscribed-newsgroups))
11512 (setq group (symbol-name sym))
11513 (if (and gnus-newsrc-options-n-yes
11514 (string-match gnus-newsrc-options-n-yes group))
11515 (funcall gnus-subscribe-options-newsgroup-method group)
11516 (and (or (null gnus-newsrc-options-n-no)
11517 (not (string-match gnus-newsrc-options-n-no group)))
11518 (setq gnus-killed-list (cons group gnus-killed-list)))))
11519 gnus-active-hashtb)
11521 (if (gnus-gethash (car groups) gnus-active-hashtb)
11522 (gnus-group-change-level (car groups) 3 9))
11523 (setq groups (cdr groups)))))))
11525 ;; `gnus-group-change-level' is the fundamental function for changing
11526 ;; subscription levels of newsgroups. This might mean just changing
11527 ;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back
11528 ;; again, which subscribes/unsubscribes a group, which is equally
11529 ;; trivial. Changing from 1-7 to 8-9 means that you kill a group, and
11530 ;; from 8-9 to 1-7 means that you remove the group from the list of
11531 ;; killed (or zombie) groups and add them to the (kinda) subscribed
11532 ;; groups. And last but not least, moving from 8 to 9 and 9 to 8,
11533 ;; which is trivial.
11534 ;; ENTRY can either be a string (newsgroup name) or a list (if
11535 ;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST),
11536 ;; otherwise it's a list in the format of the `gnus-newsrc-hashtb'
11538 ;; LEVEL is the new level of the group, OLDLEVEL is the old level and
11539 ;; PREVIOUS is the group (in hashtb entry format) to insert this group
11541 (defun gnus-group-change-level (entry level &optional oldlevel
11542 previous fromkilled)
11543 (let (group info active num)
11544 ;; Glean what info we can from the arguments
11546 (if fromkilled (setq group (nth 1 entry))
11547 (setq group (car (nth 2 entry))))
11548 (setq group entry))
11549 (if (and (stringp entry)
11552 (setq entry (gnus-gethash entry gnus-newsrc-hashtb)))
11553 (if (and (not oldlevel)
11555 (setq oldlevel (car (cdr (nth 2 entry)))))
11556 (if (stringp previous)
11557 (setq previous (gnus-gethash previous gnus-newsrc-hashtb)))
11559 (gnus-dribble-enter
11560 (format "(gnus-group-change-level %S %S %S %S %S)"
11561 group level oldlevel (car (nth 2 previous)) fromkilled))
11563 ;; Then we remove the newgroup from any old structures, if needed.
11564 ;; If the group was killed, we remove it from the killed or zombie
11565 ;; list. If not, and it is in fact going to be killed, we remove
11566 ;; it from the newsrc hash table and assoc.
11567 (cond ((>= oldlevel 8)
11569 (setq gnus-zombie-list (delete group gnus-zombie-list))
11570 (setq gnus-killed-list (delete group gnus-killed-list))))
11574 (gnus-sethash (car (nth 2 entry))
11575 nil gnus-newsrc-hashtb)
11577 (setcdr (gnus-gethash (car (nth 3 entry))
11578 gnus-newsrc-hashtb)
11580 (setcdr (cdr entry) (cdr (cdr (cdr entry))))))))
11582 ;; Finally we enter (if needed) the list where it is supposed to
11583 ;; go, and change the subscription level. If it is to be killed,
11584 ;; we enter it into the killed or zombie list.
11585 (cond ((>= level 8)
11587 (setq gnus-zombie-list (cons group gnus-zombie-list))
11588 (setq gnus-killed-list (cons group gnus-killed-list))))
11590 ;; If the list is to be entered into the newsrc assoc, and
11591 ;; it was killed, we have to create an entry in the newsrc
11592 ;; hashtb format and fix the pointers in the newsrc assoc.
11593 (if (>= oldlevel 8)
11597 (setq info (cdr entry))
11598 (setq num (car entry)))
11599 (setq active (gnus-gethash group gnus-active-hashtb))
11600 (setq num (- (1+ (cdr active)) (car active)))
11601 ;; Check whether the group is foreign. If so, the
11602 ;; foreign select method has to be entered into the
11604 (let ((method (gnus-group-method-name group)))
11605 (if (eq method gnus-select-method)
11606 (setq info (list group level
11607 (cons 1 (1- (car active)))))
11608 (setq info (list group level (cons 1 (1- (car active)))
11610 (setq entry (cons info (if previous (cdr (cdr previous))
11611 (cdr gnus-newsrc-assoc))))
11612 (setcdr (if previous (cdr previous) gnus-newsrc-assoc)
11614 (gnus-sethash group (cons num (if previous (cdr previous)
11615 gnus-newsrc-assoc))
11616 gnus-newsrc-hashtb)
11618 (setcdr (gnus-gethash (car (car (cdr entry)))
11619 gnus-newsrc-hashtb)
11621 ;; It was alive, and it is going to stay alive, so we
11622 ;; just change the level and don't change any pointers or
11623 ;; hash table entries.
11624 (setcar (cdr (car (cdr (cdr entry)))) level))))))
11626 (defun gnus-kill-newsgroup (newsgroup)
11627 "Obsolete function. Kills a newsgroup."
11628 (gnus-group-change-level (gnus-gethash newsgroup gnus-newsrc-hashtb) 9))
11630 (defun gnus-check-bogus-newsgroups (&optional confirm)
11631 "Remove bogus newsgroups.
11632 If CONFIRM is non-nil, the user has to confirm the deletion of every
11634 (let ((newsrc (cdr gnus-newsrc-assoc))
11636 (message "Checking bogus newsgroups...")
11637 (or gnus-have-read-active-file (gnus-read-active-file))
11638 ;; Find all bogus newsgroup that are subscribed.
11640 (setq group (car (car newsrc)))
11641 (if (or (gnus-gethash group gnus-active-hashtb)
11642 (nth 4 (car newsrc))
11645 (format "Remove bogus newsgroup: %s " group)))))
11646 ;; Active newsgroup.
11648 ;; Found a bogus newsgroup.
11649 (setq bogus (cons group bogus)))
11650 (setq newsrc (cdr newsrc)))
11651 ;; Remove all bogus subscribed groups by first killing them, and
11652 ;; then removing them from the list of killed groups.
11654 (gnus-group-change-level
11655 (gnus-gethash (car bogus) gnus-newsrc-hashtb) 9)
11656 (setq gnus-killed-list (delete (car bogus) gnus-killed-list))
11657 (setq bogus (cdr bogus)))
11658 ;; Then we remove all bogus groups from the list of killed and
11659 ;; zombie groups. They are are removed without confirmation.
11660 (let ((dead-lists '(gnus-killed-list gnus-zombie-list))
11663 (setq killed (symbol-value (car dead-lists)))
11665 (setq group (car killed))
11666 (or (gnus-gethash group gnus-active-hashtb)
11667 ;; The group is bogus.
11668 (set (car dead-lists)
11669 (delete group (symbol-value (car dead-lists)))))
11670 (setq killed (cdr killed)))
11671 (setq dead-lists (cdr dead-lists))))
11672 ;; While we're at it, we check the killed list for duplicates.
11673 ;; This has nothing to do with bogosity, but it's a convenient
11674 ;; place to put the check.
11675 (let ((killed gnus-killed-list))
11677 (message "%d" (length killed))
11678 (setcdr killed (delete (car killed) (cdr killed)))
11679 (setq killed (cdr killed))))
11680 (message "Checking bogus newsgroups... done")))
11682 ;; Go though `gnus-newsrc-assoc' and compare with `gnus-active-hashtb'
11683 ;; and compute how many unread articles there are in each group.
11684 (defun gnus-get-unread-articles (&optional level)
11685 (let ((newsrc (cdr gnus-newsrc-assoc))
11686 (level (or level 6))
11688 (message "Checking new news...")
11690 (setq info (car newsrc))
11691 (setq group (car info))
11692 (setq active (gnus-gethash group gnus-active-hashtb))
11694 ;; Check newsgroups. If the user doesn't want to check them, or
11695 ;; they can't be checked (for instance, if the news server can't
11696 ;; be reached) we just set the number of unread articles in this
11697 ;; newsgroup to t. This means that Gnus thinks that there are
11698 ;; unread articles, but it has no idea how many.
11700 (if (or (and gnus-activate-foreign-newsgroups
11701 (not (numberp gnus-activate-foreign-newsgroups)))
11702 (and (numberp gnus-activate-foreign-newsgroups)
11703 (<= (nth 1 info) gnus-activate-foreign-newsgroups)
11704 (<= (nth 1 info) level)))
11705 (or (eq (car (nth 4 info)) 'nnvirtual)
11706 (setq active (gnus-activate-newsgroup (car info)))))
11707 (if (and (not gnus-read-active-file)
11708 (<= (nth 1 info) level))
11710 (setq active (gnus-activate-newsgroup (car info))))))
11712 (or active (progn (gnus-sethash group nil gnus-active-hashtb)
11713 (setcar (gnus-gethash group gnus-newsrc-hashtb) t)))
11714 (and active (gnus-get-unread-articles-in-group info active))
11715 (setq newsrc (cdr newsrc)))
11716 (message "Checking new news... done")))
11718 ;; Create a hash table out of the newsrc alist. The `car's of the
11719 ;; alist elements are used as keys.
11720 (defun gnus-make-hashtable-from-newsrc-alist ()
11721 (let ((alist gnus-newsrc-assoc)
11723 (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist)))
11725 (setq prev (setq gnus-newsrc-assoc
11726 (cons (list "dummy.group" 0 (cons 0 0)) alist))))
11728 (gnus-sethash (car (car alist)) (cons nil prev) gnus-newsrc-hashtb)
11730 (setq alist (cdr alist)))))
11732 (defun gnus-make-hashtable-from-killed ()
11733 "Create a hash table from the killed and zombie lists."
11734 (let ((lists '(gnus-killed-list gnus-zombie-list))
11736 (setq gnus-killed-hashtb
11737 (gnus-make-hashtable
11738 (+ (length gnus-killed-list) (length gnus-zombie-list))))
11740 (setq list (symbol-value (car lists)))
11741 (setq lists (cdr lists))
11743 (gnus-sethash (car list) (car list) gnus-killed-hashtb)
11744 (setq list (cdr list))))))
11746 (defun gnus-get-unread-articles-in-group (info active)
11747 (let* (num srange lowest range group)
11748 ;; Modify the list of read articles according to what articles
11749 ;; are available; then tally the unread articles and add the
11750 ;; number to the group hash table entry.
11751 (setq range (nth 2 info))
11753 (cond ((zerop (cdr active))
11756 (setq num (- (1+ (cdr active)) (car active))))
11757 ((atom (car range))
11758 ;; Fix a single (num . num) range according to the
11759 ;; active hash table.
11760 (if (< (cdr range) (car active)) (setcdr range (car active)))
11761 ;; Compute number of unread articles.
11762 (setq num (max 0 (- (cdr active)
11763 (- (1+ (cdr range)) (car range))))))
11765 ;; The read list is a list of ranges. Fix them according to
11766 ;; the active hash table.
11767 (setq srange range)
11768 (setq lowest (1- (car active)))
11769 (while (and (< (cdr (car srange)) lowest))
11770 (if (and (cdr srange)
11771 (<= (cdr (car srange)) (1+ lowest)))
11773 (setcdr (car srange) (cdr (car (cdr srange))))
11774 (setcdr srange (cdr (cdr srange))))
11775 (setcdr (car srange) lowest)))
11776 ;; Compute the number of unread articles.
11778 (setq num (+ num (- (1+ (cdr (car range)))
11779 (car (car range)))))
11780 (setq range (cdr range)))
11781 (setq num (max 0 (- (cdr active) num)))))
11782 (setcar (gnus-gethash (car info) gnus-newsrc-hashtb) num)
11785 (defun gnus-activate-newsgroup (group)
11787 (and (gnus-request-group group)
11789 (set-buffer nntp-server-buffer)
11791 (and (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+")
11793 (goto-char (match-beginning 1))
11795 group (setq active (cons (read (current-buffer))
11796 (read (current-buffer))))
11797 gnus-active-hashtb)))))
11800 (defun gnus-update-read-articles
11801 (group unread unselected ticked &optional domarks replied expirable killed
11802 dormant bookmark score)
11803 "Update the list of read and ticked articles in GROUP using the
11804 UNREAD and TICKED lists.
11805 Note: UNSELECTED has to be sorted over `<'."
11806 (let* ((active (gnus-gethash group gnus-active-hashtb))
11807 (entry (gnus-gethash group gnus-newsrc-hashtb))
11808 (number (car entry))
11809 (info (nth 2 entry))
11810 (marked (nth 3 info))
11812 (unread (sort (copy-sequence unread) (function <)))
11815 ;; There is no info on this group if it was, in fact,
11816 ;; killed. Gnus stores no information on killed groups, so
11817 ;; there's nothing to be done.
11818 ;; One could store the information somewhere temporarily,
11819 ;; perhaps... Hmmm...
11821 ;; Remove any negative articles numbers.
11822 (while (and unread (< (car unread) 0))
11823 (setq unread (cdr unread)))
11824 (if (not (and (numberp number) (zerop number)))
11825 (setq unread (nconc unselected unread)))
11826 ;; Set the number of unread articles in gnus-newsrc-hashtb.
11827 ; (or (eq 'nnvirtual (car (gnus-find-method-for-group
11828 ; gnus-newsgroup-name)))
11829 (setcar entry (length unread))
11830 ;; Compute the ranges of read articles by looking at the list of
11831 ;; unread articles.
11833 (if (/= (car unread) prev)
11834 (setq read (cons (cons prev (1- (car unread))) read)))
11835 (setq prev (1+ (car unread)))
11836 (setq unread (cdr unread)))
11837 (if (<= prev (cdr active))
11838 (setq read (cons (cons prev (cdr active)) read)))
11839 ;; Enter this list into the group info.
11840 (setcar (cdr (cdr info))
11841 (if (> (length read) 1) (nreverse read) (car read)))
11842 ;; Enter the list of ticked articles.
11843 (gnus-set-marked-articles
11845 (if domarks replied (cdr (assq 'reply marked)))
11846 (if domarks expirable (cdr (assq 'expire marked)))
11847 (if domarks killed (cdr (assq 'killed marked)))
11848 (if domarks dormant (cdr (assq 'dormant marked)))
11849 (if domarks bookmark (cdr (assq 'bookmark marked)))
11850 (if domarks score (cdr (assq 'score marked)))))))
11852 (defun gnus-make-articles-unread (group articles)
11853 "Mark ARTICLES in GROUP as unread."
11854 (let ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))))
11855 (setcar (nthcdr 2 info)
11856 (gnus-remove-from-range (nth 2 info) articles))
11857 (gnus-group-update-group group t)))
11859 (defun gnus-read-active-file ()
11860 "Get active file from NNTP server."
11861 (gnus-group-set-mode-line)
11862 (let ((methods (cons gnus-select-method gnus-secondary-select-methods)))
11863 (setq gnus-have-read-active-file nil)
11865 (let* ((where (nth 1 (car methods)))
11866 (mesg (format "Reading active file%s via %s..."
11867 (if (and where (not (zerop (length where))))
11868 (concat " from " where) "")
11869 (car (car methods)))))
11871 (if (gnus-request-list (car methods)) ; Get active
11873 (set-buffer nntp-server-buffer)
11874 (gnus-active-to-gnus-format
11875 (and gnus-have-read-active-file (car methods)))
11876 (setq gnus-have-read-active-file t)
11877 (message "%s...done" mesg))
11878 (message "Cannot read active file from %s server."
11879 (car (car methods)))
11881 (setq methods (cdr methods)))))
11883 ;; rewritten by jwz based on ideas from Rick Sladkey <jrs@world.std.com>
11884 ;; Further rewrites by lmi.
11885 (defun gnus-active-to-gnus-format (method &optional hashtb)
11886 "Convert active file format to internal format.
11887 Lines matching `gnus-ignored-newsgroups' are ignored."
11888 (let ((cur (current-buffer))
11892 (setq gnus-active-hashtb
11893 (gnus-make-hashtable
11894 (count-lines (point-min) (point-max))))))))
11895 ;; Delete unnecessary lines.
11896 (goto-char (point-min))
11897 (delete-matching-lines gnus-ignored-newsgroups)
11898 (and method (not (eq method gnus-select-method))
11899 (let ((prefix (gnus-group-prefixed-name "" method)))
11900 (goto-char (point-min))
11901 (while (and (not (eobp))
11902 (null (insert prefix))
11903 (zerop (forward-line 1))))))
11904 (goto-char (point-min))
11905 ;; Store active file in hashtable.
11907 (if (or (re-search-forward "\n.\r?$" nil t)
11908 (goto-char (point-max)))
11910 (beginning-of-line)
11911 (narrow-to-region (point-min) (point))))
11912 (goto-char (point-min))
11913 (if (string-match "%[oO]" gnus-group-line-format)
11914 ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
11915 ;; If we want information on moderated groups, we use this
11918 (let ((mod-hashtb (make-vector 7 0))
11920 (while (not (eobp))
11921 (setq group (let ((obarray hashtb))
11923 (setq max (read cur))
11924 (set group (cons (read cur) max))
11925 ;; Enter moderated groups into a list.
11927 (symbol-name (let ((obarray mod-hashtb)) (read cur)))
11929 (setq gnus-moderated-list
11930 (cons (symbol-name group) gnus-moderated-list)))
11933 (progn (ding) (message "Possible error in active file."))))
11934 ;; And if we do not care about moderation, we use this loop,
11935 ;; which is faster.
11938 (while (not (eobp))
11939 ;; group gets set to a symbol interned in the hash table
11941 (setq group (let ((obarray hashtb)) (read cur)))
11942 (setq max (read cur))
11943 (set group (cons (read cur) max))
11946 (progn (ding) (message "Possible error in active file."))))))))
11948 (defun gnus-read-newsrc-file (&optional force)
11949 "Read startup file.
11950 If FORCE is non-nil, the .newsrc file is read."
11951 (setq gnus-current-startup-file (gnus-make-newsrc-file gnus-startup-file))
11952 ;; Reset variables that might be defined in the .newsrc.eld file.
11953 (let ((variables gnus-variable-list))
11955 (set (car variables) nil)
11956 (setq variables (cdr variables))))
11957 (let* ((newsrc-file gnus-current-startup-file)
11958 (quick-file (concat newsrc-file ".el")))
11960 ;; We always load the .newsrc.eld file. If always contains
11961 ;; much information that can not be gotten from the .newsrc
11962 ;; file (ticked articles, killed groups, foreign methods, etc.)
11963 (gnus-read-newsrc-el-file quick-file)
11966 (and (file-newer-than-file-p newsrc-file quick-file)
11967 (file-newer-than-file-p newsrc-file
11968 (concat quick-file "d")))
11969 (not gnus-newsrc-assoc))
11970 ;; We read the .newsrc file. Note that if there if a
11971 ;; .newsrc.eld file exists, it has already been read, and
11972 ;; the `gnus-newsrc-hashtb' has been created. While reading
11973 ;; the .newsrc file, Gnus will only use the information it
11974 ;; can find there for changing the data already read -
11975 ;; ie. reading the .newsrc file will not trash the data
11976 ;; already read (except for read articles).
11978 (message "Reading %s..." newsrc-file)
11979 (set-buffer (find-file-noselect newsrc-file))
11980 (buffer-disable-undo (current-buffer))
11981 (gnus-newsrc-to-gnus-format)
11982 (kill-buffer (current-buffer))
11983 (message "Reading %s... done" newsrc-file)))
11984 (gnus-dribble-read-file))))
11986 (defun gnus-read-newsrc-el-file (file)
11987 (let ((ding-file (concat file "d")))
11988 ;; We always, always read the .eld file.
11989 (message "Reading %s..." ding-file)
11990 (condition-case nil
11991 (load ding-file t t t)
11993 (gnus-make-hashtable-from-newsrc-alist)
11994 (if (not (file-newer-than-file-p file ding-file))
11996 ;; Old format quick file
11997 (message "Reading %s..." file)
11998 ;; The .el file is newer than the .eld file, so we read that one
12000 (gnus-read-old-newsrc-el-file file))))
12002 ;; Parse the old-style quick startup file
12003 (defun gnus-read-old-newsrc-el-file (file)
12004 (let (newsrc killed marked group g m len info)
12006 (let (gnus-killed-assoc gnus-marked-assoc gnus-newsrc-assoc)
12008 (condition-case nil
12011 (setq newsrc gnus-newsrc-assoc
12012 killed gnus-killed-assoc
12013 marked gnus-marked-assoc)))
12014 (setq gnus-newsrc-assoc nil)
12016 (setq group (car newsrc))
12017 (let ((info (nth 2 (gnus-gethash (car group) gnus-newsrc-hashtb))))
12020 (setcar (nthcdr 2 info) (cdr (cdr group)))
12021 (setcar (cdr info) (if (nth 1 group) 3 6))
12022 (setq gnus-newsrc-assoc (cons info gnus-newsrc-assoc)))
12023 (setq gnus-newsrc-assoc
12027 (if (nth 1 group) 3 6) (cdr (cdr group))))
12028 gnus-newsrc-assoc)))
12029 (if (setq m (assoc (car group) marked))
12030 (setcdr (cdr (cdr info)) (cons (list (cons 'tick (cdr m))) nil))))
12031 (setq newsrc (cdr newsrc)))
12032 (setq newsrc killed)
12034 (setcar newsrc (car (car newsrc)))
12035 (setq newsrc (cdr newsrc)))
12036 (setq gnus-killed-list killed))
12037 (setq gnus-newsrc-assoc (nreverse gnus-newsrc-assoc))
12038 (gnus-make-hashtable-from-newsrc-alist)))
12040 (defun gnus-make-newsrc-file (file)
12041 "Make server dependent file name by catenating FILE and server host name."
12042 (let* ((file (expand-file-name file nil))
12043 (real-file (concat file "-" (nth 1 gnus-select-method))))
12044 (if (file-exists-p real-file)
12048 ;; jwz: rewrote this function to be much more efficient, and not be subject
12049 ;; to regexp overflow errors when it encounters very long lines -- the old
12050 ;; behavior was to blow off the rest of the *file* when a line was encountered
12051 ;; that was too long to match!! Now it uses only simple looking-at calls, and
12052 ;; doesn't create as many temporary strings. It also now handles multiple
12053 ;; consecutive options lines (before it only handled the first.)
12054 ;; Tiny rewrite by lmi.
12055 (defun gnus-newsrc-to-gnus-format ()
12056 "Parse current buffer as .newsrc file."
12057 ;; We have to re-initialize these variables (except for
12058 ;; gnus-killed-list) because the quick startup file may contain bogus
12060 (setq gnus-newsrc-options nil)
12061 (setq gnus-newsrc-options-n-yes nil)
12062 (setq gnus-newsrc-options-n-no nil)
12063 (setq gnus-newsrc-assoc nil)
12064 (gnus-parse-options-lines)
12065 (gnus-parse-newsrc-body))
12067 (defun gnus-parse-options-lines ()
12068 ;; newsrc.5 seems to indicate that the options line can come anywhere
12069 ;; in the file, and that there can be any number of them:
12071 ;; An options line starts with the word options (left-
12072 ;; justified). Then there are the list of options just as
12073 ;; they would be on the readnews command line. For instance:
12075 ;; options -n all !net.sf-lovers !mod.human-nets -r
12078 ;; A string of lines beginning with a space or tab after the
12079 ;; initial options line will be considered continuation
12082 ;; For now, we only accept it at the beginning of the file.
12084 (goto-char (point-min))
12085 (skip-chars-forward " \t\n")
12086 (setq gnus-newsrc-options nil)
12087 (while (looking-at "^options[ \t]*\\(.*\\)\n")
12088 ;; handle consecutive options lines
12089 (setq gnus-newsrc-options (concat gnus-newsrc-options
12090 (if gnus-newsrc-options "\n\t")
12091 (buffer-substring (match-beginning 1)
12094 (while (looking-at "[ \t]+\\(.*\\)\n")
12095 ;; handle subsequent continuation lines of this options line
12096 (setq gnus-newsrc-options (concat gnus-newsrc-options "\n\t"
12097 (buffer-substring (match-beginning 1)
12100 ;; Gather all "-n" options lines.
12103 (if gnus-newsrc-options
12104 (while (and (string-match "^[ \t]*-n\\([^\n]*\\)$"
12105 gnus-newsrc-options
12107 (setq start (match-end 0)))
12108 (setq result (concat result
12110 (substring gnus-newsrc-options
12111 (match-beginning 1)
12113 (let ((yes-and-no (and result (gnus-parse-n-options result))))
12114 (setq gnus-newsrc-options-n-yes (car yes-and-no))
12115 (setq gnus-newsrc-options-n-no (cdr yes-and-no)))
12118 (defun gnus-parse-newsrc-body ()
12119 ;; Point has been positioned after the options lines. We shouldn't
12120 ;; see any more in here.
12122 (let ((subscribe nil)
12124 (line (1+ (count-lines (point-min) (point))))
12128 (skip-chars-forward " \t")
12129 (while (not (eobp))
12131 ((= (following-char) ?\n)
12132 ;; skip blank lines
12136 (skip-chars-forward "^:!\n")
12137 (if (= (following-char) ?\n)
12138 (error "line %d is unparsable in %s" line (buffer-name)))
12140 (skip-chars-backward " \t")
12142 ;; #### note: we could avoid consing a string here by binding obarray
12143 ;; and reading the newsgroup directly into the gnus-newsrc-hashtb,
12144 ;; then setq'ing newsgroup to symbol-name of that, like we do in
12145 ;; gnus-active-to-gnus-format.
12146 (setq newsgroup (buffer-substring p (point)))
12149 (setq subscribe (= (following-char) ?:))
12150 (setq read-list nil)
12152 (forward-char 1) ; after : or !
12153 (skip-chars-forward " \t")
12154 (while (not (= (following-char) ?\n))
12155 (skip-chars-forward " \t")
12158 ((looking-at "\\([0-9]+\\)-\\([0-9]+\\)") ; a range
12163 ;; faster that buffer-substring/string-to-int
12164 (narrow-to-region (point-min) (match-end 1))
12165 (read (current-buffer)))
12167 (narrow-to-region (point-min) (match-end 2))
12168 (forward-char) ; skip over "-"
12170 (read (current-buffer))
12174 ((looking-at "[0-9]+")
12175 ;; faster that buffer-substring/string-to-int
12176 (narrow-to-region (point-min) (match-end 0))
12177 (setq p (read (current-buffer)))
12179 (setq read-list (cons (cons p p) read-list))
12182 ;; bogus chars in ranges
12185 (goto-char (match-end 0))
12186 (skip-chars-forward " \t")
12187 (cond ((= (following-char) ?,)
12190 ((= (following-char) ?\n)
12193 ;; bogus char after range
12195 ;; if we get here, the parse failed
12197 (end-of-line) ; give up on this line
12199 (message "Ignoring bogus line %d for %s in %s"
12200 line newsgroup (buffer-name))
12202 ;; We have already read .newsrc.eld, so we gently update the
12203 ;; data in the hash table with the information we have just
12205 (let ((info (nth 2 (gnus-gethash newsgroup gnus-newsrc-hashtb))))
12208 (setcar (nthcdr 2 info) (nreverse read-list))
12209 (setcar (cdr info) (if subscribe 3 (if read-list 6 7)))
12210 (setq gnus-newsrc-assoc (cons info gnus-newsrc-assoc)))
12211 (setq gnus-newsrc-assoc
12212 (cons (list newsgroup (if subscribe 3 (if read-list 6 7))
12213 (nreverse read-list))
12214 gnus-newsrc-assoc))))))
12215 (setq line (1+ line))
12216 (forward-line 1))))
12217 (setq gnus-newsrc-assoc (nreverse gnus-newsrc-assoc))
12218 (gnus-make-hashtable-from-newsrc-alist)
12221 (defun gnus-parse-n-options (options)
12222 "Parse -n NEWSGROUPS options and return a cons of YES and NO regexps."
12225 (yes-or-no nil) ;`!' or not.
12227 ;; Parse each newsgroup description such as "comp.all". Commas
12228 ;; and white spaces can be a newsgroup separator.
12230 (string-match "^[ \t\n,]*\\(!?\\)\\([^- \t\n,][^ \t\n,]*\\)" options)
12232 (substring options (match-beginning 1) (match-end 1)))
12236 (match-beginning 2) (match-end 2))))
12237 (setq options (substring options (match-end 2)))
12238 ;; Rewrite "all" to ".+" not ".*". ".+" requires at least one
12240 (while (string-match "\\(^\\|\\\\[.]\\)all\\(\\\\[.]\\|$\\)" newsgroup)
12242 (concat (substring newsgroup 0 (match-end 1))
12244 (substring newsgroup (match-beginning 2)))))
12245 ;; It is yes or no.
12246 (cond ((string-equal yes-or-no "!")
12247 (setq no (cons newsgroup no)))
12248 ((string-equal newsgroup ".+")) ;Ignore `all'.
12250 (setq yes (cons newsgroup yes))))
12252 ;; Make a cons of regexps from parsing result.
12253 ;; We have to append \(\.\|$\) to prevent matching substring of
12254 ;; newsgroup. For example, "jp.net" should not match with
12256 ;; Fixes for large regexp problems are from yonezu@nak.math.keio.ac.jp.
12259 (apply (function concat)
12261 (lambda (newsgroup)
12262 (concat newsgroup "\\|"))
12264 (car yes) "\\)\\(\\.\\|$\\)"))
12267 (apply (function concat)
12269 (lambda (newsgroup)
12270 (concat newsgroup "\\|"))
12272 (car no) "\\)\\(\\.\\|$\\)")))
12275 (defun gnus-save-newsrc-file ()
12276 "Save .newsrc file."
12277 ;; Note: We cannot save .newsrc file if all newsgroups are removed
12278 ;; from the variable gnus-newsrc-assoc.
12279 (and (or gnus-newsrc-assoc gnus-killed-list)
12280 gnus-current-startup-file
12282 (if (zerop (save-excursion
12283 (set-buffer gnus-dribble-buffer)
12285 (message "(No changes need to be saved)")
12286 (if gnus-save-newsrc-file
12287 (let ((make-backup-files t)
12288 (version-control nil)
12289 (require-final-newline t)) ;Don't ask even if requested.
12290 (message "Saving %s..." gnus-current-startup-file)
12291 ;; Make backup file of master newsrc.
12292 ;; You can stop or change version control of backup file.
12293 ;; Suggested by jason@violet.berkeley.edu.
12294 (run-hooks 'gnus-save-newsrc-hook)
12295 (gnus-gnus-to-newsrc-format)
12296 (message "Saving %s... done" gnus-current-startup-file)))
12297 ;; Quickly loadable .newsrc.
12298 (set-buffer (get-buffer-create " *Gnus-newsrc*"))
12299 (gnus-add-current-to-buffer-list)
12300 (buffer-disable-undo (current-buffer))
12302 (message "Saving %s.eld..." gnus-current-startup-file)
12303 (gnus-gnus-to-quick-newsrc-format)
12304 (let ((make-backup-files nil)
12305 (version-control nil)
12306 (require-final-newline t)) ;Don't ask even if requested.
12307 (write-region 1 (point-max)
12308 (concat gnus-current-startup-file ".eld")
12310 (kill-buffer (current-buffer))
12311 (message "Saving %s.eld... done" gnus-current-startup-file)
12312 (gnus-dribble-delete-file)))))
12314 (defun gnus-gnus-to-quick-newsrc-format ()
12315 "Insert Gnus variables such as gnus-newsrc-assoc in lisp format."
12316 (insert ";; (ding) Gnus startup file.\n")
12317 (insert ";; Never delete this file - touch .newsrc instead to force Gnus\n")
12318 (insert ";; to read .newsrc.\n")
12319 (let ((variables gnus-variable-list)
12320 (gnus-newsrc-assoc (cdr gnus-newsrc-assoc))
12322 ;; insert lisp expressions.
12324 (setq variable (car variables))
12325 (and (boundp variable)
12326 (symbol-value variable)
12327 (or gnus-save-killed-list (not (eq variable 'gnus-killed-list)))
12328 (insert "(setq " (symbol-name variable) " '"
12329 (prin1-to-string (symbol-value variable))
12331 (setq variables (cdr variables)))))
12333 (defun gnus-gnus-to-newsrc-format ()
12334 ;; Generate and save the .newsrc file.
12335 (let ((newsrc (cdr gnus-newsrc-assoc))
12338 (set-buffer (create-file-buffer gnus-startup-file))
12339 (buffer-disable-undo (current-buffer))
12342 (if gnus-newsrc-options (insert "options " gnus-newsrc-options "\n"))
12343 ;; Write subscribed and unsubscribed.
12345 (setq info (car newsrc))
12346 (if (not (nth 4 info)) ;Don't write foreign groups to .newsrc.
12348 (insert (car info) (if (>= (nth 1 info) 6) "!" ":"))
12349 (if (setq ranges (nth 2 info))
12352 (if (atom (car ranges))
12353 (if (= (car ranges) (cdr ranges))
12354 (insert (int-to-string (car ranges)))
12355 (insert (int-to-string (car ranges)) "-"
12356 (int-to-string (cdr ranges))))
12358 (setq range (car ranges)
12359 ranges (cdr ranges))
12360 (if (= (car range) (cdr range))
12361 (insert (int-to-string (car range)))
12362 (insert (int-to-string (car range)) "-"
12363 (int-to-string (cdr range))))
12364 (if ranges (insert ","))))))
12366 (setq newsrc (cdr newsrc)))
12367 (write-region 1 (point-max) gnus-current-startup-file nil 'nomesg)
12368 (kill-buffer (current-buffer)))))
12370 (defun gnus-read-descriptions-file ()
12371 (message "Reading descriptions file...")
12372 (if (not (gnus-request-list-newsgroups gnus-select-method))
12374 (message "Couldn't read newsgroups descriptions")
12377 (setq gnus-description-hashtb
12378 (gnus-make-hashtable (length gnus-active-hashtb)))
12381 (set-buffer nntp-server-buffer)
12382 (goto-char (point-min))
12383 (delete-non-matching-lines "^[a-zA-Z\\.0-9]+[ \t]")
12384 (goto-char (point-min))
12385 (if (or (search-forward "\n.\n" nil t)
12386 (goto-char (point-max)))
12388 (beginning-of-line)
12389 (narrow-to-region (point-min) (point))))
12390 (goto-char (point-min))
12391 (while (not (eobp))
12392 (setq group (let ((obarray gnus-description-hashtb))
12393 (read (current-buffer))))
12394 (skip-chars-forward " \t")
12395 (set group (buffer-substring
12396 (point) (save-excursion (end-of-line) (point))))
12397 (forward-line 1))))
12398 (message "Reading descriptions file...done")
12403 ;;; gnus.el ends here