1 ;;; gnus.el --- a newsreader for GNU Emacs
2 ;; Copyright (C) 1987,88,89,90,93,94,95,96 Free Software Foundation, Inc.
4 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
5 ;; Lars Magne 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.
28 (eval '(run-hooks 'gnus-load-hook))
34 (eval-when-compile (require 'cl))
36 ;; Site dependent variables. These variables should be defined in
39 (defvar gnus-default-nntp-server nil
40 "Specify a default NNTP server.
41 This variable should be defined in paths.el, and should never be set
43 If you want to change servers, you should use `gnus-select-method'.
44 See the documentation to that variable.")
46 (defvar gnus-backup-default-subscribed-newsgroups
47 '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus")
48 "Default default new newsgroups the first time Gnus is run.
49 Should be set in paths.el, and shouldn't be touched by the user.")
51 (defvar gnus-local-domain nil
52 "Local domain name without a host name.
53 The DOMAINNAME environment variable is used instead if it is defined.
54 If the `system-name' function returns the full Internet name, there is
55 no need to set this variable.")
57 (defvar gnus-local-organization nil
58 "String with a description of what organization (if any) the user belongs to.
59 The ORGANIZATION environment variable is used instead if it is defined.
60 If this variable contains a function, this function will be called
61 with the current newsgroup name as the argument. The function should
64 In any case, if the string (either in the variable, in the environment
65 variable, or returned by the function) is a file name, the contents of
66 this file will be used as the organization.")
68 (defvar gnus-use-generic-from nil
69 "If nil, the full host name will be the system name prepended to the domain name.
70 If this is a string, the full host name will be this string.
71 If this is non-nil, non-string, the domain name will be used as the
74 (defvar gnus-use-generic-path nil
75 "If nil, use the NNTP server name in the Path header.
76 If stringp, use this; if non-nil, use no host name (user name only).")
79 ;; Customization variables
81 ;; Don't touch this variable.
82 (defvar gnus-nntp-service "nntp"
83 "*NNTP service name (\"nntp\" or 119).
84 This is an obsolete variable, which is scarcely used. If you use an
85 nntp server for your newsgroup and want to change the port number
86 used to 899, you would say something along these lines:
88 (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))")
90 (defvar gnus-nntpserver-file "/etc/nntpserver"
91 "*A file with only the name of the nntp server in it.")
93 ;; This function is used to check both the environment variable
94 ;; NNTPSERVER and the /etc/nntpserver file to see whether one can find
95 ;; an nntp server name default.
96 (defun gnus-getenv-nntpserver ()
97 (or (getenv "NNTPSERVER")
98 (and (file-readable-p gnus-nntpserver-file)
100 (set-buffer (get-buffer-create " *gnus nntp*"))
101 (buffer-disable-undo (current-buffer))
102 (insert-file-contents gnus-nntpserver-file)
103 (let ((name (buffer-string)))
105 (if (string-match "^[ \t\n]*$" name)
108 (kill-buffer (current-buffer))))))))
110 (defvar gnus-select-method
112 (list 'nntp (or (condition-case ()
113 (gnus-getenv-nntpserver)
115 (if (and gnus-default-nntp-server
116 (not (string= gnus-default-nntp-server "")))
117 gnus-default-nntp-server)
119 (if (or (null gnus-nntp-service)
120 (equal gnus-nntp-service "nntp"))
122 (list gnus-nntp-service)))
123 "*Default method for selecting a newsgroup.
124 This variable should be a list, where the first element is how the
125 news is to be fetched, the second is the address.
127 For instance, if you want to get your news via NNTP from
128 \"flab.flab.edu\", you could say:
130 (setq gnus-select-method '(nntp \"flab.flab.edu\"))
132 If you want to use your local spool, say:
134 (setq gnus-select-method (list 'nnspool (system-name)))
136 If you use this variable, you must set `gnus-nntp-server' to nil.
138 There is a lot more to know about select methods and virtual servers -
139 see the manual for details.")
141 (defvar gnus-message-archive-method
142 '(nnfolder "archive" (nnfolder-directory "~/Mail/archive/")
143 (nnfolder-active-file "~/Mail/archive/active")
144 (nnfolder-get-new-mail nil)
145 (nnfolder-inhibit-expiry t))
146 "*Method used for archiving messages you've sent.
147 This should be a mail method.")
149 (defvar gnus-refer-article-method nil
150 "*Preferred method for fetching an article by Message-ID.
151 If you are reading news from the local spool (with nnspool), fetching
152 articles by Message-ID is painfully slow. By setting this method to an
153 nntp method, you might get acceptable results.
155 The value of this variable must be a valid select method as discussed
156 in the documentation of `gnus-select-method'")
158 (defvar gnus-secondary-select-methods nil
159 "*A list of secondary methods that will be used for reading news.
160 This is a list where each element is a complete select method (see
161 `gnus-select-method').
163 If, for instance, you want to read your mail with the nnml backend,
164 you could set this variable:
166 (setq gnus-secondary-select-methods '((nnml \"\")))")
168 (defvar gnus-secondary-servers nil
169 "*List of NNTP servers that the user can choose between interactively.
170 To make Gnus query you for a server, you have to give `gnus' a
171 non-numeric prefix - `C-u M-x gnus', in short.")
173 (defvar gnus-nntp-server nil
174 "*The name of the host running the NNTP server.
175 This variable is semi-obsolete. Use the `gnus-select-method'
178 (defvar gnus-startup-file "~/.newsrc"
179 "*Your `.newsrc' file.
180 `.newsrc-SERVER' will be used instead if that exists.")
182 (defvar gnus-init-file "~/.gnus"
183 "*Your Gnus elisp startup file.
184 If a file with the .el or .elc suffixes exist, it will be read
187 (defvar gnus-group-faq-directory
188 '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/"
189 ; "/ftp@ftp.uu.net:/usenet/news.answers/"
190 "/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/"
191 "/ftp@ftp.seas.gwu.edu:/pub/rtfm/"
192 "/ftp@rtfm.mit.edu:/pub/usenet/news.answers/"
193 "/ftp@ftp.uni-paderborn.de:/pub/FAQ/"
194 ; "/ftp@ftp.Germany.EU.net:/pub/newsarchive/news.answers/"
195 "/ftp@ftp.sunet.se:/pub/usenet/"
196 "/ftp@nctuccca.edu.tw:/USENET/FAQ/"
197 "/ftp@hwarang.postech.ac.kr:/pub/usenet/news.answers/"
198 "/ftp@ftp.hk.super.net:/mirror/faqs/")
199 "*Directory where the group FAQs are stored.
200 This will most commonly be on a remote machine, and the file will be
203 This variable can also be a list of directories. In that case, the
204 first element in the list will be used by default, and the others will
205 be used as backup sites.
207 Note that Gnus uses an aol machine as the default directory. If this
208 feels fundamentally unclean, just think of it as a way to finally get
209 something of value back from them.
211 If the default site is too slow, try one of these:
213 North America: mirrors.aol.com /pub/rtfm/usenet
214 ftp.seas.gwu.edu /pub/rtfm
215 rtfm.mit.edu /pub/usenet/news.answers
216 Europe: ftp.uni-paderborn.de /pub/FAQ
217 src.doc.ic.ac.uk /usenet/news-FAQS
218 ftp.sunet.se /pub/usenet
219 Asia: nctuccca.edu.tw /USENET/FAQ
220 hwarang.postech.ac.kr /pub/usenet/news.answers
221 ftp.hk.super.net /mirror/faqs")
223 (defvar gnus-group-archive-directory
224 "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
225 "*The address of the (ding) archives.")
227 (defvar gnus-group-recent-archive-directory
228 "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/"
229 "*The address of the most recent (ding) articles.")
231 (defvar gnus-default-subscribed-newsgroups nil
232 "*This variable lists what newsgroups should be subscribed the first time Gnus is used.
233 It should be a list of strings.
234 If it is `t', Gnus will not do anything special the first time it is
235 started; it'll just use the normal newsgroups subscription methods.")
237 (defvar gnus-use-cross-reference t
238 "*Non-nil means that cross referenced articles will be marked as read.
239 If nil, ignore cross references. If t, mark articles as read in
240 subscribed newsgroups. If neither t nor nil, mark as read in all
243 (defvar gnus-single-article-buffer t
244 "*If non-nil, display all articles in the same buffer.
245 If nil, each group will get its own article buffer.")
247 (defvar gnus-use-dribble-file t
248 "*Non-nil means that Gnus will use a dribble file to store user updates.
249 If Emacs should crash without saving the .newsrc files, complete
250 information can be restored from the dribble file.")
252 (defvar gnus-dribble-directory nil
253 "*The directory where dribble files will be saved.
254 If this variable is nil, the directory where the .newsrc files are
255 saved will be used.")
257 (defvar gnus-asynchronous nil
258 "*If non-nil, Gnus will supply backends with data needed for async article fetching.")
260 (defvar gnus-kill-summary-on-exit t
261 "*If non-nil, kill the summary buffer when you exit from it.
262 If nil, the summary will become a \"*Dead Summary*\" buffer, and
263 it will be killed sometime later.")
265 (defvar gnus-large-newsgroup 200
266 "*The number of articles which indicates a large newsgroup.
267 If the number of articles in a newsgroup is greater than this value,
268 confirmation is required for selecting the newsgroup.")
270 ;; Suggested by Andrew Eskilsson <pi92ae@lelle.pt.hk-r.se>.
271 (defvar gnus-no-groups-message "No news is horrible news"
272 "*Message displayed by Gnus when no groups are available.")
274 (defvar gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix)))
275 "*Non-nil means that the default name of a file to save articles in is the group name.
276 If it's nil, the directory form of the group name is used instead.
278 If this variable is a list, and the list contains the element
279 `not-score', long file names will not be used for score files; if it
280 contains the element `not-save', long file names will not be used for
281 saving; and if it contains the element `not-kill', long file names
282 will not be used for kill files.")
284 (defvar gnus-article-save-directory (or (getenv "SAVEDIR") "~/News/")
285 "*Name of the directory articles will be saved in (default \"~/News\").
286 Initialized from the SAVEDIR environment variable.")
288 (defvar gnus-kill-files-directory (or (getenv "SAVEDIR") "~/News/")
289 "*Name of the directory where kill files will be stored (default \"~/News\").
290 Initialized from the SAVEDIR environment variable.")
292 (defvar gnus-default-article-saver 'gnus-summary-save-in-rmail
293 "*A function to save articles in your favorite format.
294 The function must be interactively callable (in other words, it must
295 be an Emacs command).
297 Gnus provides the following functions:
299 * gnus-summary-save-in-rmail (Rmail format)
300 * gnus-summary-save-in-mail (Unix mail format)
301 * gnus-summary-save-in-folder (MH folder)
302 * gnus-summary-save-in-file (article format).
303 * gnus-summary-save-in-vm (use VM's folder format).")
305 (defvar gnus-prompt-before-saving 'always
306 "*This variable says how much prompting is to be done when saving articles.
307 If it is nil, no prompting will be done, and the articles will be
308 saved to the default files. If this variable is `always', each and
309 every article that is saved will be preceded by a prompt, even when
310 saving large batches of articles. If this variable is neither nil not
311 `always', there the user will be prompted once for a file name for
312 each invocation of the saving commands.")
314 (defvar gnus-rmail-save-name (function gnus-plain-save-name)
315 "*A function generating a file name to save articles in Rmail format.
316 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
318 (defvar gnus-mail-save-name (function gnus-plain-save-name)
319 "*A function generating a file name to save articles in Unix mail format.
320 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
322 (defvar gnus-folder-save-name (function gnus-folder-save-name)
323 "*A function generating a file name to save articles in MH folder.
324 The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER.")
326 (defvar gnus-file-save-name (function gnus-numeric-save-name)
327 "*A function generating a file name to save articles in article format.
328 The function is called with NEWSGROUP, HEADERS, and optional
331 (defvar gnus-split-methods
332 '((gnus-article-archive-name))
333 "*Variable used to suggest where articles are to be saved.
334 For instance, if you would like to save articles related to Gnus in
335 the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\",
336 you could set this variable to something like:
338 '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\")
339 (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\"))
341 This variable is an alist where the where the key is the match and the
342 value is a list of possible files to save in if the match is non-nil.
344 If the match is a string, it is used as a regexp match on the
345 article. If the match is a symbol, that symbol will be funcalled
346 from the buffer of the article to be saved with the newsgroup as the
347 parameter. If it is a list, it will be evaled in the same buffer.
349 If this form or function returns a string, this string will be used as
350 a possible file name; and if it returns a non-nil list, that list will
351 be used as possible file names.")
353 (defvar gnus-move-split-methods nil
354 "*Variable used to suggest where articles are to be moved to.
355 It uses the same syntax as the `gnus-split-methods' variable.")
357 (defvar gnus-save-score nil
358 "*If non-nil, save group scoring info.")
360 (defvar gnus-use-adaptive-scoring nil
361 "*If non-nil, use some adaptive scoring scheme.")
363 (defvar gnus-use-cache nil
364 "*If nil, Gnus will ignore the article cache.
365 If `passive', it will allow entering (and reading) articles
366 explicitly entered into the cache. If anything else, use the
367 cache to the full extent of the law.")
369 (defvar gnus-use-trees nil
370 "*If non-nil, display a thread tree buffer.")
372 (defvar gnus-keep-backlog nil
373 "*If non-nil, Gnus will keep read articles for later re-retrieval.
374 If it is a number N, then Gnus will only keep the last N articles
375 read. If it is neither nil nor a number, Gnus will keep all read
376 articles. This is not a good idea.")
378 (defvar gnus-use-nocem nil
379 "*If non-nil, Gnus will read NoCeM cancel messages.")
381 (defvar gnus-use-demon nil
382 "If non-nil, Gnus might use some demons.")
384 (defvar gnus-use-scoring t
385 "*If non-nil, enable scoring.")
387 (defvar gnus-use-picons nil
388 "*If non-nil, display picons.")
390 (defvar gnus-fetch-old-headers nil
391 "*Non-nil means that Gnus will try to build threads by grabbing old headers.
392 If an unread article in the group refers to an older, already read (or
393 just marked as read) article, the old article will not normally be
394 displayed in the Summary buffer. If this variable is non-nil, Gnus
395 will attempt to grab the headers to the old articles, and thereby
396 build complete threads. If it has the value `some', only enough
397 headers to connect otherwise loose threads will be displayed.
398 This variable can also be a number. In that case, no more than that
399 number of old headers will be fetched.
401 The server has to support NOV for any of this to work.")
404 ;(defvar gnus-visual t
405 ; "*If non-nil, will do various highlighting.
406 ;If nil, no mouse highlights (or any other highlights) will be
407 ;performed. This might speed up Gnus some when generating large group
408 ;and summary buffers.")
410 (defvar gnus-novice-user t
411 "*Non-nil means that you are a usenet novice.
412 If non-nil, verbose messages may be displayed and confirmations may be
415 (defvar gnus-expert-user nil
416 "*Non-nil means that you will never be asked for confirmation about anything.
417 And that means *anything*.")
419 (defvar gnus-verbose 7
420 "*Integer that says how verbose Gnus should be.
421 The higher the number, the more messages Gnus will flash to say what
422 it's doing. At zero, Gnus will be totally mute; at five, Gnus will
423 display most important messages; and at ten, Gnus will keep on
424 jabbering all the time.")
426 (defvar gnus-keep-same-level nil
427 "*Non-nil means that the next newsgroup after the current will be on the same level.
428 When you type, for instance, `n' after reading the last article in the
429 current newsgroup, you will go to the next newsgroup. If this variable
430 is nil, the next newsgroup will be the next from the group
432 If this variable is non-nil, Gnus will either put you in the
433 next newsgroup with the same level, or, if no such newsgroup is
434 available, the next newsgroup with the lowest possible level higher
435 than the current level.
436 If this variable is `best', Gnus will make the next newsgroup the one
437 with the best level.")
439 (defvar gnus-summary-make-false-root 'adopt
440 "*nil means that Gnus won't gather loose threads.
441 If the root of a thread has expired or been read in a previous
442 session, the information necessary to build a complete thread has been
443 lost. Instead of having many small sub-threads from this original thread
444 scattered all over the summary buffer, Gnus can gather them.
446 If non-nil, Gnus will try to gather all loose sub-threads from an
447 original thread into one large thread.
449 If this variable is non-nil, it should be one of `none', `adopt',
452 If this variable is `none', Gnus will not make a false root, but just
453 present the sub-threads after another.
454 If this variable is `dummy', Gnus will create a dummy root that will
455 have all the sub-threads as children.
456 If this variable is `adopt', Gnus will make one of the \"children\"
457 the parent and mark all the step-children as such.
458 If this variable is `empty', the \"children\" are printed with empty
459 subject fields. (Or rather, they will be printed with a string
460 given by the `gnus-summary-same-subject' variable.)")
462 (defvar gnus-summary-gather-exclude-subject "^ *$\\|^(none)$"
463 "*A regexp to match subjects to be excluded from loose thread gathering.
464 As loose thread gathering is done on subjects only, that means that
465 there can be many false gatherings performed. By rooting out certain
466 common subjects, gathering might become saner.")
468 (defvar gnus-summary-gather-subject-limit nil
469 "*Maximum length of subject comparisons when gathering loose threads.
470 Use nil to compare full subjects. Setting this variable to a low
471 number will help gather threads that have been corrupted by
472 newsreaders chopping off subject lines, but it might also mean that
473 unrelated articles that have subject that happen to begin with the
474 same few characters will be incorrectly gathered.
476 If this variable is `fuzzy', Gnus will use a fuzzy algorithm when
477 comparing subjects.")
479 (defvar gnus-simplify-ignored-prefixes nil
480 "*Regexp, matches for which are removed from subject lines when simplifying.")
482 (defvar gnus-build-sparse-threads nil
483 "*If non-nil, fill in the gaps in threads.
484 If `some', only fill in the gaps that are needed to tie loose threads
485 together. If `more', fill in all leaf nodes that Gnus can find. If
486 non-nil and non-`some', fill in all gaps that Gnus manages to guess.")
488 (defvar gnus-summary-thread-gathering-function 'gnus-gather-threads-by-subject
489 "Function used for gathering loose threads.
490 There are two pre-defined functions: `gnus-gather-threads-by-subject',
491 which only takes Subjects into consideration; and
492 `gnus-gather-threads-by-references', which compared the References
493 headers of the articles to find matches.")
495 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
496 (defvar gnus-summary-same-subject ""
497 "*String indicating that the current article has the same subject as the previous.
498 This variable will only be used if the value of
499 `gnus-summary-make-false-root' is `empty'.")
501 (defvar gnus-summary-goto-unread t
502 "*If non-nil, marking commands will go to the next unread article.
503 If `never', \\<gnus-summary-mode-map>\\[gnus-summary-next-page] will go to the next article,
504 whether it is read or not.")
506 (defvar gnus-group-goto-unread t
507 "*If non-nil, movement commands will go to the next unread and subscribed group.")
509 (defvar gnus-goto-next-group-when-activating t
510 "*If non-nil, the \\<gnus-group-mode-map>\\[gnus-group-get-new-news-this-group] command will advance point to the next group.")
512 (defvar gnus-check-new-newsgroups t
513 "*Non-nil means that Gnus will add new newsgroups at startup.
514 If this variable is `ask-server', Gnus will ask the server for new
515 groups since the last time it checked. This means that the killed list
516 is no longer necessary, so you could set `gnus-save-killed-list' to
519 A variant is to have this variable be a list of select methods. Gnus
520 will then use the `ask-server' method on all these select methods to
521 query for new groups from all those servers.
524 (setq gnus-check-new-newsgroups
525 '((nntp \"some.server\") (nntp \"other.server\")))
527 If this variable is nil, then you have to tell Gnus explicitly to
528 check for new newsgroups with \\<gnus-group-mode-map>\\[gnus-find-new-newsgroups].")
530 (defvar gnus-check-bogus-newsgroups nil
531 "*Non-nil means that Gnus will check and remove bogus newsgroup at startup.
532 If this variable is nil, then you have to tell Gnus explicitly to
533 check for bogus newsgroups with \\<gnus-group-mode-map>\\[gnus-group-check-bogus-groups].")
535 (defvar gnus-read-active-file t
536 "*Non-nil means that Gnus will read the entire active file at startup.
537 If this variable is nil, Gnus will only know about the groups in your
540 If this variable is `some', Gnus will try to only read the relevant
541 parts of the active file from the server. Not all servers support
542 this, and it might be quite slow with other servers, but this should
543 generally be faster than both the t and nil value.
545 If you set this variable to nil or `some', you probably still want to
546 be told about new newsgroups that arrive. To do that, set
547 `gnus-check-new-newsgroups' to `ask-server'. This may not work
548 properly with all servers.")
550 (defvar gnus-level-subscribed 5
551 "*Groups with levels less than or equal to this variable are subscribed.")
553 (defvar gnus-level-unsubscribed 7
554 "*Groups with levels less than or equal to this variable are unsubscribed.
555 Groups with levels less than `gnus-level-subscribed', which should be
556 less than this variable, are subscribed.")
558 (defvar gnus-level-zombie 8
559 "*Groups with this level are zombie groups.")
561 (defvar gnus-level-killed 9
562 "*Groups with this level are killed.")
564 (defvar gnus-level-default-subscribed 3
565 "*New subscribed groups will be subscribed at this level.")
567 (defvar gnus-level-default-unsubscribed 6
568 "*New unsubscribed groups will be unsubscribed at this level.")
570 (defvar gnus-activate-level (1+ gnus-level-subscribed)
571 "*Groups higher than this level won't be activated on startup.
572 Setting this variable to something log might save lots of time when
573 you have many groups that you aren't interested in.")
575 (defvar gnus-activate-foreign-newsgroups 4
576 "*If nil, Gnus will not check foreign newsgroups at startup.
577 If it is non-nil, it should be a number between one and nine. Foreign
578 newsgroups that have a level lower or equal to this number will be
579 activated on startup. For instance, if you want to active all
580 subscribed newsgroups, but not the rest, you'd set this variable to
581 `gnus-level-subscribed'.
583 If you subscribe to lots of newsgroups from different servers, startup
584 might take a while. By setting this variable to nil, you'll save time,
585 but you won't be told how many unread articles there are in the
588 (defvar gnus-save-newsrc-file t
589 "*Non-nil means that Gnus will save the `.newsrc' file.
590 Gnus always saves its own startup file, which is called
591 \".newsrc.eld\". The file called \".newsrc\" is in a format that can
592 be readily understood by other newsreaders. If you don't plan on
593 using other newsreaders, set this variable to nil to save some time on
596 (defvar gnus-save-killed-list t
597 "*If non-nil, save the list of killed groups to the startup file.
598 If you set this variable to nil, you'll save both time (when starting
599 and quitting) and space (both memory and disk), but it will also mean
600 that Gnus has no record of which groups are new and which are old, so
601 the automatic new newsgroups subscription methods become meaningless.
603 You should always set `gnus-check-new-newsgroups' to `ask-server' or
604 nil if you set this variable to nil.")
606 (defvar gnus-interactive-catchup t
607 "*If non-nil, require your confirmation when catching up a group.")
609 (defvar gnus-interactive-post t
610 "*If non-nil, group name will be asked for when posting.")
612 (defvar gnus-interactive-exit t
613 "*If non-nil, require your confirmation when exiting Gnus.")
615 (defvar gnus-kill-killed t
616 "*If non-nil, Gnus will apply kill files to already killed articles.
617 If it is nil, Gnus will never apply kill files to articles that have
618 already been through the scoring process, which might very well save lots
621 (defvar gnus-extract-address-components 'gnus-extract-address-components
622 "*Function for extracting address components from a From header.
623 Two pre-defined function exist: `gnus-extract-address-components',
624 which is the default, quite fast, and too simplistic solution, and
625 `mail-extract-address-components', which works much better, but is
628 (defvar gnus-summary-default-score 0
629 "*Default article score level.
630 If this variable is nil, scoring will be disabled.")
632 (defvar gnus-summary-zcore-fuzz 0
633 "*Fuzziness factor for the zcore in the summary buffer.
634 Articles with scores closer than this to `gnus-summary-default-score'
635 will not be marked.")
637 (defvar gnus-simplify-subject-fuzzy-regexp nil
638 "*Strings to be removed when doing fuzzy matches.
639 This can either be a regular expression or list of regular expressions
640 that will be removed from subject strings if fuzzy subject
641 simplification is selected.")
643 (defvar gnus-permanently-visible-groups nil
644 "*Regexp to match groups that should always be listed in the group buffer.
645 This means that they will still be listed when there are no unread
646 articles in the groups.")
648 (defvar gnus-list-groups-with-ticked-articles t
649 "*If non-nil, list groups that have only ticked articles.
650 If nil, only list groups that have unread articles.")
652 (defvar gnus-group-default-list-level gnus-level-subscribed
653 "*Default listing level.
654 Ignored if `gnus-group-use-permanent-levels' is non-nil.")
656 (defvar gnus-group-use-permanent-levels nil
657 "*If non-nil, once you set a level, Gnus will use this level.")
659 (defvar gnus-group-list-inactive-groups t
660 "*If non-nil, inactive groups will be listed.")
662 (defvar gnus-show-mime nil
663 "*If non-nil, do mime processing of articles.
664 The articles will simply be fed to the function given by
665 `gnus-show-mime-method'.")
667 (defvar gnus-strict-mime t
668 "*If nil, MIME-decode even if there is no Mime-Version header in the article.")
670 (defvar gnus-show-mime-method 'metamail-buffer
671 "*Function to process a MIME message.
672 The function is called from the article buffer.")
674 (defvar gnus-decode-encoded-word-method (lambda ())
675 "*Function to decode a MIME encoded-words.
676 The function is called from the article buffer.")
678 (defvar gnus-show-threads t
679 "*If non-nil, display threads in summary mode.")
681 (defvar gnus-thread-hide-subtree nil
682 "*If non-nil, hide all threads initially.
683 If threads are hidden, you have to run the command
684 `gnus-summary-show-thread' by hand or use `gnus-select-article-hook'
685 to expose hidden threads.")
687 (defvar gnus-thread-hide-killed t
688 "*If non-nil, hide killed threads automatically.")
690 (defvar gnus-thread-ignore-subject nil
691 "*If non-nil, ignore subjects and do all threading based on the Reference header.
692 If nil, which is the default, articles that have different subjects
693 from their parents will start separate threads.")
695 (defvar gnus-thread-operation-ignore-subject t
696 "*If non-nil, subjects will be ignored when doing thread commands.
697 This affects commands like `gnus-summary-kill-thread' and
698 `gnus-summary-lower-thread'.
700 If this variable is nil, articles in the same thread with different
701 subjects will not be included in the operation in question. If this
702 variable is `fuzzy', only articles that have subjects that are fuzzily
703 equal will be included.")
705 (defvar gnus-thread-indent-level 4
706 "*Number that says how much each sub-thread should be indented.")
708 (defvar gnus-ignored-newsgroups
709 (purecopy (mapconcat 'identity
710 '("^to\\." ; not "real" groups
711 "^[0-9. \t]+ " ; all digits in name
712 "[][\"#'()]" ; bogus characters
715 "*A regexp to match uninteresting newsgroups in the active file.
716 Any lines in the active file matching this regular expression are
717 removed from the newsgroup list before anything else is done to it,
718 thus making them effectively non-existent.")
720 (defvar gnus-ignored-headers
721 "^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:"
722 "*All headers that match this regexp will be hidden.
723 This variable can also be a list of regexps of headers to be ignored.
724 If `gnus-visible-headers' is non-nil, this variable will be ignored.")
726 (defvar gnus-visible-headers "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-"
727 "*All headers that do not match this regexp will be hidden.
728 This variable can also be a list of regexp of headers to remain visible.
729 If this variable is non-nil, `gnus-ignored-headers' will be ignored.")
731 (defvar gnus-sorted-header-list
732 '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^To:"
733 "^Cc:" "^Date:" "^Organization:")
734 "*This variable is a list of regular expressions.
735 If it is non-nil, headers that match the regular expressions will
736 be placed first in the article buffer in the sequence specified by
739 (defvar gnus-boring-article-headers
740 '(empty followup-to reply-to)
741 "*Headers that are only to be displayed if they have interesting data.
742 Possible values in this list are `empty', `newsgroups', `followup-to',
743 `reply-to', and `date'.")
745 (defvar gnus-show-all-headers nil
746 "*If non-nil, don't hide any headers.")
748 (defvar gnus-save-all-headers t
749 "*If non-nil, don't remove any headers before saving.")
751 (defvar gnus-saved-headers gnus-visible-headers
752 "*Headers to keep if `gnus-save-all-headers' is nil.
753 If `gnus-save-all-headers' is non-nil, this variable will be ignored.
754 If that variable is nil, however, all headers that match this regexp
755 will be kept while the rest will be deleted before saving.")
757 (defvar gnus-inhibit-startup-message nil
758 "*If non-nil, the startup message will not be displayed.")
760 (defvar gnus-signature-separator "^-- *$"
761 "Regexp matching signature separator.")
763 (defvar gnus-auto-extend-newsgroup t
764 "*If non-nil, extend newsgroup forward and backward when requested.")
766 (defvar gnus-auto-select-first t
767 "*If nil, don't select the first unread article when entering a group.
768 If this variable is `best', select the highest-scored unread article
769 in the group. If neither nil nor `best', select the first unread
772 If you want to prevent automatic selection of the first unread article
773 in some newsgroups, set the variable to nil in
774 `gnus-select-group-hook'.")
776 (defvar gnus-auto-select-next t
777 "*If non-nil, offer to go to the next group from the end of the previous.
778 If the value is t and the next newsgroup is empty, Gnus will exit
779 summary mode and go back to group mode. If the value is neither nil
780 nor t, Gnus will select the following unread newsgroup. In
781 particular, if the value is the symbol `quietly', the next unread
782 newsgroup will be selected without any confirmation, and if it is
783 `almost-quietly', the next group will be selected without any
784 confirmation if you are located on the last article in the group.
785 Finally, if this variable is `slightly-quietly', the `Z n' command
786 will go to the next group without confirmation.")
788 (defvar gnus-auto-select-same nil
789 "*If non-nil, select the next article with the same subject.")
791 (defvar gnus-summary-check-current nil
792 "*If non-nil, consider the current article when moving.
793 The \"unread\" movement commands will stay on the same line if the
794 current article is unread.")
796 (defvar gnus-auto-center-summary t
797 "*If non-nil, always center the current summary buffer.")
799 (defvar gnus-break-pages t
800 "*If non-nil, do page breaking on articles.
801 The page delimiter is specified by the `gnus-page-delimiter'
804 (defvar gnus-page-delimiter "^\^L"
805 "*Regexp describing what to use as article page delimiters.
806 The default value is \"^\^L\", which is a form linefeed at the
807 beginning of a line.")
809 (defvar gnus-use-full-window t
810 "*If non-nil, use the entire Emacs screen.")
812 (defvar gnus-window-configuration nil
813 "Obsolete variable. See `gnus-buffer-configuration'.")
815 (defvar gnus-window-min-width 2
816 "*Minimum width of Gnus buffers.")
818 (defvar gnus-window-min-height 1
819 "*Minimum height of Gnus buffers.")
821 (defvar gnus-buffer-configuration
825 (if gnus-carpal '(group-carpal 4))))
829 (if gnus-carpal '(summary-carpal 4))))
836 (if gnus-carpal '(summary-carpal 4))
838 (vertical ((height . 5) (width . 15)
840 (left . -1) (top . 1))
850 (if gnus-carpal '(summary-carpal 4))
851 (if gnus-use-trees '(tree 0.25))
856 (if gnus-carpal '(server-carpal 2))))
860 (if gnus-carpal '(browse-carpal 2))))
873 (article 1.0 point)))
884 (edit-group 1.0 point)))
888 (edit-server 1.0 point)))
892 (edit-score 1.0 point)))
919 (if gnus-carpal '(summary-carpal 4))
920 ("*Shell Command Output*" 1.0)))
928 "Window configuration for all possible Gnus buffers.
929 This variable is a list of lists. Each of these lists has a NAME and
930 a RULE. The NAMEs are commonsense names like `group', which names a
931 rule used when displaying the group buffer; `summary', which names a
932 rule for what happens when you enter a group and do not display an
933 article buffer; and so on. See the value of this variable for a
934 complete list of NAMEs.
936 Each RULE is a list of vectors. The first element in this vector is
937 the name of the buffer to be displayed; the second element is the
938 percentage of the screen this buffer is to occupy (a number in the
939 0.0-0.99 range); the optional third element is `point', which should
940 be present to denote which buffer point is to go to after making this
941 buffer configuration.")
943 (defvar gnus-window-to-buffer
944 '((group . gnus-group-buffer)
945 (summary . gnus-summary-buffer)
946 (article . gnus-article-buffer)
947 (server . gnus-server-buffer)
948 (browse . "*Gnus Browse Server*")
949 (edit-group . gnus-group-edit-buffer)
950 (edit-server . gnus-server-edit-buffer)
951 (group-carpal . gnus-carpal-group-buffer)
952 (summary-carpal . gnus-carpal-summary-buffer)
953 (server-carpal . gnus-carpal-server-buffer)
954 (browse-carpal . gnus-carpal-browse-buffer)
955 (edit-score . gnus-score-edit-buffer)
956 (mail . gnus-mail-buffer)
957 (post . gnus-post-news-buffer)
958 (faq . gnus-faq-buffer)
959 (picons . "*Picons*")
960 (tree . gnus-tree-buffer)
961 (info . gnus-info-buffer)
962 (draft . gnus-draft-buffer))
963 "Mapping from short symbols to buffer names or buffer variables.")
965 (defvar gnus-carpal nil
966 "*If non-nil, display clickable icons.")
968 (defvar gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies
969 "*Function called with a group name when new group is detected.
970 A few pre-made functions are supplied: `gnus-subscribe-randomly'
971 inserts new groups at the beginning of the list of groups;
972 `gnus-subscribe-alphabetically' inserts new groups in strict
973 alphabetic order; `gnus-subscribe-hierarchically' inserts new groups
974 in hierarchical newsgroup order; `gnus-subscribe-interactively' asks
975 for your decision; `gnus-subscribe-killed' kills all new groups.")
977 ;; Suggested by a bug report by Hallvard B Furuseth.
978 ;; <h.b.furuseth@usit.uio.no>.
979 (defvar gnus-subscribe-options-newsgroup-method
980 (function gnus-subscribe-alphabetically)
981 "*This function is called to subscribe newsgroups mentioned on \"options -n\" lines.
982 If, for instance, you want to subscribe to all newsgroups in the
983 \"no\" and \"alt\" hierarchies, you'd put the following in your
986 options -n no.all alt.all
988 Gnus will the subscribe all new newsgroups in these hierarchies with
989 the subscription method in this variable.")
991 (defvar gnus-subscribe-hierarchical-interactive nil
992 "*If non-nil, Gnus will offer to subscribe hierarchically.
993 When a new hierarchy appears, Gnus will ask the user:
995 'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys):
997 If the user pressed `d', Gnus will descend the hierarchy, `y' will
998 subscribe to all newsgroups in the hierarchy and `s' will skip this
999 hierarchy in its entirety.")
1001 (defvar gnus-group-sort-function 'gnus-group-sort-by-alphabet
1002 "*Function used for sorting the group buffer.
1003 This function will be called with group info entries as the arguments
1004 for the groups to be sorted. Pre-made functions include
1005 `gnus-group-sort-by-alphabet', `gnus-group-sort-by-unread',
1006 `gnus-group-sort-by-level', `gnus-group-sort-by-score', and
1007 `gnus-group-sort-by-rank'.
1009 This variable can also be a list of sorting functions. In that case,
1010 the most significant sort function should be the last function in the
1013 ;; Mark variables suggested by Thomas Michanek
1014 ;; <Thomas.Michanek@telelogic.se>.
1015 (defvar gnus-unread-mark ?
1016 "*Mark used for unread articles.")
1017 (defvar gnus-ticked-mark ?!
1018 "*Mark used for ticked articles.")
1019 (defvar gnus-dormant-mark ??
1020 "*Mark used for dormant articles.")
1021 (defvar gnus-del-mark ?r
1022 "*Mark used for del'd articles.")
1023 (defvar gnus-read-mark ?R
1024 "*Mark used for read articles.")
1025 (defvar gnus-expirable-mark ?E
1026 "*Mark used for expirable articles.")
1027 (defvar gnus-killed-mark ?K
1028 "*Mark used for killed articles.")
1029 (defvar gnus-souped-mark ?F
1030 "*Mark used for killed articles.")
1031 (defvar gnus-kill-file-mark ?X
1032 "*Mark used for articles killed by kill files.")
1033 (defvar gnus-low-score-mark ?Y
1034 "*Mark used for articles with a low score.")
1035 (defvar gnus-catchup-mark ?C
1036 "*Mark used for articles that are caught up.")
1037 (defvar gnus-replied-mark ?A
1038 "*Mark used for articles that have been replied to.")
1039 (defvar gnus-cached-mark ?*
1040 "*Mark used for articles that are in the cache.")
1041 (defvar gnus-saved-mark ?S
1042 "*Mark used for articles that have been saved to.")
1043 (defvar gnus-process-mark ?#
1045 (defvar gnus-ancient-mark ?O
1046 "*Mark used for ancient articles.")
1047 (defvar gnus-sparse-mark ?Q
1048 "*Mark used for sparsely reffed articles.")
1049 (defvar gnus-canceled-mark ?G
1050 "*Mark used for canceled articles.")
1051 (defvar gnus-score-over-mark ?+
1052 "*Score mark used for articles with high scores.")
1053 (defvar gnus-score-below-mark ?-
1054 "*Score mark used for articles with low scores.")
1055 (defvar gnus-empty-thread-mark ?
1056 "*There is no thread under the article.")
1057 (defvar gnus-not-empty-thread-mark ?=
1058 "*There is a thread under the article.")
1060 (defvar gnus-view-pseudo-asynchronously nil
1061 "*If non-nil, Gnus will view pseudo-articles asynchronously.")
1063 (defvar gnus-view-pseudos nil
1064 "*If `automatic', pseudo-articles will be viewed automatically.
1065 If `not-confirm', pseudos will be viewed automatically, and the user
1066 will not be asked to confirm the command.")
1068 (defvar gnus-view-pseudos-separately t
1069 "*If non-nil, one pseudo-article will be created for each file to be viewed.
1070 If nil, all files that use the same viewing command will be given as a
1071 list of parameters to that command.")
1073 (defvar gnus-insert-pseudo-articles t
1074 "*If non-nil, insert pseudo-articles when decoding articles.")
1076 (defvar gnus-group-line-format "%M%S%p%P%5y: %(%g%)\n"
1077 "*Format of group lines.
1078 It works along the same lines as a normal formatting string,
1079 with some simple extensions.
1081 %M Only marked articles (character, \"*\" or \" \")
1082 %S Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \")
1083 %L Level of subscribedness (integer)
1084 %N Number of unread articles (integer)
1085 %I Number of dormant articles (integer)
1086 %i Number of ticked and dormant (integer)
1087 %T Number of ticked articles (integer)
1088 %R Number of read articles (integer)
1089 %t Total number of articles (integer)
1090 %y Number of unread, unticked articles (integer)
1091 %G Group name (string)
1092 %g Qualified group name (string)
1093 %D Group description (string)
1094 %s Select method (string)
1095 %o Moderated group (char, \"m\")
1096 %p Process mark (char)
1097 %O Moderated group (string, \"(m)\" or \"\")
1098 %P Topic indentation (string)
1099 %n Select from where (string)
1100 %z A string that look like `<%s:%n>' if a foreign select method is used
1101 %u User defined specifier. The next character in the format string should
1102 be a letter. Gnus will call the function gnus-user-format-function-X,
1103 where X is the letter following %u. The function will be passed the
1104 current header as argument. The function should return a string, which
1105 will be inserted into the buffer just like information from any other
1108 Text between %( and %) will be highlighted with `gnus-mouse-face' when
1109 the mouse point move inside the area. There can only be one such area.
1111 Note that this format specification is not always respected. For
1112 reasons of efficiency, when listing killed groups, this specification
1113 is ignored altogether. If the spec is changed considerably, your
1114 output may end up looking strange when listing both alive and killed
1117 If you use %o or %O, reading the active file will be slower and quite
1118 a bit of extra memory will be used. %D will also worsen performance.
1119 Also note that if you change the format specification to include any
1120 of these specs, you must probably re-start Gnus to see them go into
1123 (defvar gnus-summary-line-format "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n"
1124 "*The format specification of the lines in the summary buffer.
1126 It works along the same lines as a normal formatting string,
1127 with some simple extensions.
1129 %N Article number, left padded with spaces (string)
1131 %s Subject if it is at the root of a thread, and \"\" otherwise (string)
1132 %n Name of the poster (string)
1133 %a Extracted name of the poster (string)
1134 %A Extracted address of the poster (string)
1135 %F Contents of the From: header (string)
1136 %x Contents of the Xref: header (string)
1137 %D Date of the article (string)
1138 %d Date of the article (string) in DD-MMM format
1139 %M Message-id of the article (string)
1140 %r References of the article (string)
1141 %c Number of characters in the article (integer)
1142 %L Number of lines in the article (integer)
1143 %I Indentation based on thread level (a string of spaces)
1144 %T A string with two possible values: 80 spaces if the article
1145 is on thread level two or larger and 0 spaces on level one
1146 %R \"A\" if this article has been replied to, \" \" otherwise (character)
1147 %U Status of this article (character, \"R\", \"K\", \"-\" or \" \")
1148 %[ Opening bracket (character, \"[\" or \"<\")
1149 %] Closing bracket (character, \"]\" or \">\")
1150 %> Spaces of length thread-level (string)
1151 %< Spaces of length (- 20 thread-level) (string)
1152 %i Article score (number)
1153 %z Article zcore (character)
1154 %t Number of articles under the current thread (number).
1155 %e Whether the thread is empty or not (character).
1156 %u User defined specifier. The next character in the format string should
1157 be a letter. Gnus will call the function gnus-user-format-function-X,
1158 where X is the letter following %u. The function will be passed the
1159 current header as argument. The function should return a string, which
1160 will be inserted into the summary just like information from any other
1163 Text between %( and %) will be highlighted with `gnus-mouse-face'
1164 when the mouse point is placed inside the area. There can only be one
1167 The %U (status), %R (replied) and %z (zcore) specs have to be handled
1168 with care. For reasons of efficiency, Gnus will compute what column
1169 these characters will end up in, and \"hard-code\" that. This means that
1170 it is illegal to have these specs after a variable-length spec. Well,
1171 you might not be arrested, but your summary buffer will look strange,
1172 which is bad enough.
1174 The smart choice is to have these specs as for to the left as
1177 This restriction may disappear in later versions of Gnus.")
1179 (defvar gnus-summary-dummy-line-format
1181 "*The format specification for the dummy roots in the summary buffer.
1182 It works along the same lines as a normal formatting string,
1183 with some simple extensions.
1187 (defvar gnus-summary-mode-line-format "Gnus: %%b [%A] %Z"
1188 "*The format specification for the summary mode line.
1189 It works along the same lines as a normal formatting string,
1190 with some simple extensions:
1193 %p Unprefixed group name
1194 %A Current article number
1196 %U Number of unread articles in the group
1197 %e Number of unselected articles in the group
1198 %Z A string with unread/unselected article counts
1199 %g Shortish group name
1200 %S Subject of the current article
1201 %u User-defined spec
1202 %s Current score file name
1203 %d Number of dormant articles
1204 %r Number of articles that have been marked as read in this session
1205 %E Number of articles expunged by the score files")
1207 (defvar gnus-article-mode-line-format "Gnus: %%b %S"
1208 "*The format specification for the article mode line.
1209 See `gnus-summary-mode-line-format' for a closer description.")
1211 (defvar gnus-group-mode-line-format "Gnus: %%b {%M:%S}"
1212 "*The format specification for the group mode line.
1213 It works along the same lines as a normal formatting string,
1214 with some simple extensions:
1216 %S The native news server.
1217 %M The native select method.")
1219 (defvar gnus-valid-select-methods
1220 '(("nntp" post address prompt-address)
1222 ("nnvirtual" post-mail virtual prompt-address)
1223 ("nnmbox" mail respool)
1224 ("nnml" mail respool)
1225 ("nnmh" mail respool)
1226 ("nndir" post-mail prompt-address address)
1227 ("nneething" none prompt-address)
1228 ("nndoc" none prompt-address)
1229 ("nnbabyl" mail respool)
1230 ("nnkiboze" post virtual)
1231 ("nnsoup" post-mail)
1232 ("nnfolder" mail respool))
1233 "An alist of valid select methods.
1234 The first element of each list lists should be a string with the name
1235 of the select method. The other elements may be be the category of
1236 this method (ie. `post', `mail', `none' or whatever) or other
1237 properties that this method has (like being respoolable).
1238 If you implement a new select method, all you should have to change is
1239 this variable. I think.")
1241 (defvar gnus-updated-mode-lines '(group article summary tree)
1242 "*List of buffers that should update their mode lines.
1243 The list may contain the symbols `group', `article' and `summary'. If
1244 the corresponding symbol is present, Gnus will keep that mode line
1245 updated with information that may be pertinent.
1246 If this variable is nil, screen refresh may be quicker.")
1248 ;; Added by Keinonen Kari <kk85613@cs.tut.fi>.
1249 (defvar gnus-mode-non-string-length nil
1250 "*Max length of mode-line non-string contents.
1251 If this is nil, Gnus will take space as is needed, leaving the rest
1252 of the modeline intact.")
1255 ;(defvar gnus-mouse-face 'highlight
1256 ; "*Face used for mouse highlighting in Gnus.
1257 ;No mouse highlights will be done if `gnus-visual' is nil.")
1259 (defvar gnus-summary-mark-below nil
1260 "*Mark all articles with a score below this variable as read.
1261 This variable is local to each summary buffer and usually set by the
1264 (defvar gnus-article-sort-functions '(gnus-article-sort-by-number)
1265 "*List of functions used for sorting articles in the summary buffer.
1266 This variable is only used when not using a threaded display.")
1268 (defvar gnus-thread-sort-functions '(gnus-thread-sort-by-number)
1269 "*List of functions used for sorting threads in the summary buffer.
1270 By default, threads are sorted by article number.
1272 Each function takes two threads and return non-nil if the first thread
1273 should be sorted before the other. If you use more than one function,
1274 the primary sort function should be the last. You should probably
1275 always include `gnus-thread-sort-by-number' in the list of sorting
1276 functions -- preferably first.
1278 Ready-mady functions include `gnus-thread-sort-by-number',
1279 `gnus-thread-sort-by-author', `gnus-thread-sort-by-subject',
1280 `gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and
1281 `gnus-thread-sort-by-total-score' (see `gnus-thread-score-function').")
1283 (defvar gnus-thread-score-function '+
1284 "*Function used for calculating the total score of a thread.
1286 The function is called with the scores of the article and each
1287 subthread and should then return the score of the thread.
1289 Some functions you can use are `+', `max', or `min'.")
1291 (defvar gnus-summary-expunge-below nil
1292 "All articles that have a score less than this variable will be expunged.")
1294 (defvar gnus-thread-expunge-below nil
1295 "All threads that have a total score less than this variable will be expunged.
1296 See `gnus-thread-score-function' for en explanation of what a
1297 \"thread score\" is.")
1299 (defvar gnus-auto-subscribed-groups
1300 "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl"
1301 "*All new groups that match this regexp will be subscribed automatically.
1302 Note that this variable only deals with new groups. It has no effect
1303 whatsoever on old groups.")
1305 (defvar gnus-options-subscribe nil
1306 "*All new groups matching this regexp will be subscribed unconditionally.
1307 Note that this variable deals only with new newsgroups. This variable
1308 does not affect old newsgroups.")
1310 (defvar gnus-options-not-subscribe nil
1311 "*All new groups matching this regexp will be ignored.
1312 Note that this variable deals only with new newsgroups. This variable
1313 does not affect old (already subscribed) newsgroups.")
1315 (defvar gnus-auto-expirable-newsgroups nil
1316 "*Groups in which to automatically mark read articles as expirable.
1317 If non-nil, this should be a regexp that should match all groups in
1318 which to perform auto-expiry. This only makes sense for mail groups.")
1320 (defvar gnus-total-expirable-newsgroups nil
1321 "*Groups in which to perform expiry of all read articles.
1322 Use with extreme caution. All groups that match this regexp will be
1323 expiring - which means that all read articles will be deleted after
1324 (say) one week. (This only goes for mail groups and the like, of
1327 (defvar gnus-group-uncollapsed-levels 1
1328 "Number of group name elements to leave alone when making a short group name.")
1330 (defvar gnus-hidden-properties '(invisible t intangible t)
1331 "Property list to use for hiding text.")
1333 (defvar gnus-modtime-botch nil
1334 "*Non-nil means .newsrc should be deleted prior to save. Its use is
1335 due to the bogus appearance that .newsrc was modified on disc.")
1339 (defvar gnus-group-mode-hook nil
1340 "*A hook for Gnus group mode.")
1342 (defvar gnus-summary-mode-hook nil
1343 "*A hook for Gnus summary mode.
1344 This hook is run before any variables are set in the summary buffer.")
1346 (defvar gnus-article-mode-hook nil
1347 "*A hook for Gnus article mode.")
1349 (defvar gnus-summary-prepare-exit-hook nil
1350 "*A hook called when preparing to exit from the summary buffer.
1351 It calls `gnus-summary-expire-articles' by default.")
1352 (add-hook 'gnus-summary-prepare-exit-hook 'gnus-summary-expire-articles)
1354 (defvar gnus-summary-exit-hook nil
1355 "*A hook called on exit from the summary buffer.")
1357 (defvar gnus-group-catchup-group-hook nil
1358 "*A hook run when catching up a group from the group buffer.")
1360 (defvar gnus-open-server-hook nil
1361 "*A hook called just before opening connection to the news server.")
1363 (defvar gnus-load-hook nil
1364 "*A hook run while Gnus is loaded.")
1366 (defvar gnus-startup-hook nil
1367 "*A hook called at startup.
1368 This hook is called after Gnus is connected to the NNTP server.")
1370 (defvar gnus-get-new-news-hook nil
1371 "*A hook run just before Gnus checks for new news.")
1373 (defvar gnus-group-prepare-function 'gnus-group-prepare-flat
1374 "*A function that is called to generate the group buffer.
1375 The function is called with three arguments: The first is a number;
1376 all group with a level less or equal to that number should be listed,
1377 if the second is non-nil, empty groups should also be displayed. If
1378 the third is non-nil, it is a number. No groups with a level lower
1379 than this number should be displayed.
1381 The only current function implemented is `gnus-group-prepare-flat'.")
1383 (defvar gnus-group-prepare-hook nil
1384 "*A hook called after the group buffer has been generated.
1385 If you want to modify the group buffer, you can use this hook.")
1387 (defvar gnus-summary-prepare-hook nil
1388 "*A hook called after the summary buffer has been generated.
1389 If you want to modify the summary buffer, you can use this hook.")
1391 (defvar gnus-summary-generate-hook nil
1392 "*A hook run just before generating the summary buffer.
1393 This hook is commonly used to customize threading variables and the
1396 (defvar gnus-article-prepare-hook nil
1397 "*A hook called after an article has been prepared in the article buffer.
1398 If you want to run a special decoding program like nkf, use this hook.")
1400 ;(defvar gnus-article-display-hook nil
1401 ; "*A hook called after the article is displayed in the article buffer.
1402 ;The hook is designed to change the contents of the article
1403 ;buffer. Typical functions that this hook may contain are
1404 ;`gnus-article-hide-headers' (hide selected headers),
1405 ;`gnus-article-maybe-highlight' (perform fancy article highlighting),
1406 ;`gnus-article-hide-signature' (hide signature) and
1407 ;`gnus-article-treat-overstrike' (turn \"^H_\" into bold characters).")
1408 ;(add-hook 'gnus-article-display-hook 'gnus-article-hide-headers-if-wanted)
1409 ;(add-hook 'gnus-article-display-hook 'gnus-article-treat-overstrike)
1410 ;(add-hook 'gnus-article-display-hook 'gnus-article-maybe-highlight)
1412 (defvar gnus-article-x-face-command
1413 "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -"
1414 "String or function to be executed to display an X-Face header.
1415 If it is a string, the command will be executed in a sub-shell
1416 asynchronously. The compressed face will be piped to this command.")
1418 (defvar gnus-article-x-face-too-ugly nil
1419 "Regexp matching posters whose face shouldn't be shown automatically.")
1421 (defvar gnus-select-group-hook nil
1422 "*A hook called when a newsgroup is selected.
1424 If you'd like to simplify subjects like the
1425 `gnus-summary-next-same-subject' command does, you can use the
1428 (setq gnus-select-group-hook
1431 (mapcar (lambda (header)
1432 (mail-header-set-subject
1434 (gnus-simplify-subject
1435 (mail-header-subject header) 're-only)))
1436 gnus-newsgroup-headers))))")
1438 (defvar gnus-select-article-hook nil
1439 "*A hook called when an article is selected.")
1441 (defvar gnus-apply-kill-hook '(gnus-apply-kill-file)
1442 "*A hook called to apply kill files to a group.
1443 This hook is intended to apply a kill file to the selected newsgroup.
1444 The function `gnus-apply-kill-file' is called by default.
1446 Since a general kill file is too heavy to use only for a few
1447 newsgroups, I recommend you to use a lighter hook function. For
1448 example, if you'd like to apply a kill file to articles which contains
1449 a string `rmgroup' in subject in newsgroup `control', you can use the
1452 (setq gnus-apply-kill-hook
1455 (cond ((string-match \"control\" gnus-newsgroup-name)
1456 (gnus-kill \"Subject\" \"rmgroup\")
1457 (gnus-expunge \"X\"))))))")
1459 (defvar gnus-visual-mark-article-hook
1460 (list 'gnus-highlight-selected-summary)
1461 "*Hook run after selecting an article in the summary buffer.
1462 It is meant to be used for highlighting the article in some way. It
1463 is not run if `gnus-visual' is nil.")
1465 (defvar gnus-parse-headers-hook nil
1466 "*A hook called before parsing the headers.")
1468 (defvar gnus-exit-group-hook nil
1469 "*A hook called when exiting (not quitting) summary mode.")
1471 (defvar gnus-suspend-gnus-hook nil
1472 "*A hook called when suspending (not exiting) Gnus.")
1474 (defvar gnus-exit-gnus-hook nil
1475 "*A hook called when exiting Gnus.")
1477 (defvar gnus-save-newsrc-hook nil
1478 "*A hook called before saving any of the newsrc files.")
1480 (defvar gnus-save-quick-newsrc-hook nil
1481 "*A hook called just before saving the quick newsrc file.
1482 Can be used to turn version control on or off.")
1484 (defvar gnus-save-standard-newsrc-hook nil
1485 "*A hook called just before saving the standard newsrc file.
1486 Can be used to turn version control on or off.")
1488 (defvar gnus-summary-update-hook
1489 (list 'gnus-summary-highlight-line)
1490 "*A hook called when a summary line is changed.
1491 The hook will not be called if `gnus-visual' is nil.
1493 The default function `gnus-summary-highlight-line' will
1494 highlight the line according to the `gnus-summary-highlight'
1497 (defvar gnus-group-update-hook '(gnus-group-highlight-line)
1498 "*A hook called when a group line is changed.
1499 The hook will not be called if `gnus-visual' is nil.
1501 The default function `gnus-group-highlight-line' will
1502 highlight the line according to the `gnus-group-highlight'
1505 (defvar gnus-mark-article-hook (list 'gnus-summary-mark-unread-as-read)
1506 "*A hook called when an article is selected for the first time.
1507 The hook is intended to mark an article as read (or unread)
1508 automatically when it is selected.")
1510 (defvar gnus-group-change-level-function nil
1511 "Function run when a group level is changed.
1512 It is called with three parameters -- GROUP, LEVEL and OLDLEVEL.")
1514 ;; Remove any hilit infestation.
1515 (add-hook 'gnus-startup-hook
1517 (remove-hook 'gnus-summary-prepare-hook
1518 'hilit-rehighlight-buffer-quietly)
1519 (remove-hook 'gnus-summary-prepare-hook 'hilit-install-line-hooks)
1520 (setq gnus-mark-article-hook '(gnus-summary-mark-unread-as-read))
1521 (remove-hook 'gnus-article-prepare-hook
1522 'hilit-rehighlight-buffer-quietly)))
1526 ;; Internal variables
1528 (defvar gnus-topic-indentation "") ;; Obsolete variable.
1530 (defvar gnus-goto-missing-group-function nil)
1532 (defvar gnus-override-subscribe-method nil)
1534 (defvar gnus-group-goto-next-group-function nil
1535 "Function to override finding the next group after listing groups.")
1537 (defconst gnus-article-mark-lists
1538 '((marked . tick) (replied . reply)
1539 (expirable . expire) (killed . killed)
1540 (bookmarks . bookmark) (dormant . dormant)
1541 (scored . score) (saved . save)
1544 ;; Avoid highlighting in kill files.
1545 (defvar gnus-summary-inhibit-highlight nil)
1546 (defvar gnus-newsgroup-selected-overlay nil)
1548 (defvar gnus-inhibit-hiding nil)
1549 (defvar gnus-group-indentation "")
1550 (defvar gnus-inhibit-limiting nil)
1552 (defvar gnus-article-mode-map nil)
1553 (defvar gnus-dribble-buffer nil)
1554 (defvar gnus-headers-retrieved-by nil)
1555 (defvar gnus-article-reply nil)
1556 (defvar gnus-override-method nil)
1557 (defvar gnus-article-check-size nil)
1559 (defvar gnus-nocem-hashtb nil)
1561 (defvar gnus-current-score-file nil)
1562 (defvar gnus-newsgroup-adaptive-score-file nil)
1563 (defvar gnus-scores-exclude-files nil)
1565 (defvar gnus-opened-servers nil)
1567 (defvar gnus-current-move-group nil)
1569 (defvar gnus-newsgroup-dependencies nil)
1570 (defvar gnus-newsgroup-async nil)
1571 (defconst gnus-group-edit-buffer "*Gnus edit newsgroup*")
1573 (defvar gnus-newsgroup-adaptive nil)
1575 (defvar gnus-summary-display-table nil)
1576 (defvar gnus-summary-display-article-function nil)
1578 (defvar gnus-summary-highlight-line-function nil
1579 "Function called after highlighting a summary line.")
1581 (defvar gnus-group-line-format-alist
1582 `((?M gnus-tmp-marked-mark ?c)
1583 (?S gnus-tmp-subscribed ?c)
1584 (?L gnus-tmp-level ?d)
1585 (?N (cond ((eq number t) "*" )
1589 (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
1590 (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
1592 (?R gnus-tmp-number-of-read ?s)
1593 (?t gnus-tmp-number-total ?d)
1594 (?y gnus-tmp-number-of-unread ?s)
1595 (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
1596 (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
1597 (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
1598 (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d)
1599 (?g gnus-tmp-group ?s)
1600 (?G gnus-tmp-qualified-group ?s)
1601 (?c (gnus-short-group-name gnus-tmp-group) ?s)
1602 (?D gnus-tmp-newsgroup-description ?s)
1603 (?o gnus-tmp-moderated ?c)
1604 (?O gnus-tmp-moderated-string ?s)
1605 (?p gnus-tmp-process-marked ?c)
1606 (?s gnus-tmp-news-server ?s)
1607 (?n gnus-tmp-news-method ?s)
1608 (?P gnus-group-indentation ?s)
1609 (?z gnus-tmp-news-method-string ?s)
1610 (?u gnus-tmp-user-defined ?s)))
1612 (defvar gnus-summary-line-format-alist
1613 `((?N ,(macroexpand '(mail-header-number gnus-tmp-header)) ?d)
1614 (?S ,(macroexpand '(mail-header-subject gnus-tmp-header)) ?s)
1615 (?s gnus-tmp-subject-or-nil ?s)
1616 (?n gnus-tmp-name ?s)
1617 (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from)))
1619 (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from))
1621 (?F gnus-tmp-from ?s)
1622 (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s)
1623 (?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s)
1624 (?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s)
1625 (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s)
1626 (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s)
1627 (?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
1628 (?L gnus-tmp-lines ?d)
1629 (?I gnus-tmp-indentation ?s)
1630 (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
1631 (?R gnus-tmp-replied ?c)
1632 (?\[ gnus-tmp-opening-bracket ?c)
1633 (?\] gnus-tmp-closing-bracket ?c)
1634 (?\> (make-string gnus-tmp-level ? ) ?s)
1635 (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s)
1636 (?i gnus-tmp-score ?d)
1637 (?z gnus-tmp-score-char ?c)
1638 (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d)
1639 (?U gnus-tmp-unread ?c)
1640 (?t (gnus-summary-number-of-articles-in-thread
1641 (and (boundp 'thread) (car thread)) gnus-tmp-level)
1643 (?e (gnus-summary-number-of-articles-in-thread
1644 (and (boundp 'thread) (car thread)) gnus-tmp-level t)
1646 (?u gnus-tmp-user-defined ?s))
1647 "An alist of format specifications that can appear in summary lines,
1648 and what variables they correspond with, along with the type of the
1649 variable (string, integer, character, etc).")
1651 (defvar gnus-summary-dummy-line-format-alist
1652 (` ((?S gnus-tmp-subject ?s)
1653 (?N gnus-tmp-number ?d)
1654 (?u gnus-tmp-user-defined ?s))))
1656 (defvar gnus-summary-mode-line-format-alist
1657 (` ((?G gnus-tmp-group-name ?s)
1658 (?g (gnus-short-group-name gnus-tmp-group-name) ?s)
1659 (?p (gnus-group-real-name gnus-tmp-group-name) ?s)
1660 (?A gnus-tmp-article-number ?d)
1661 (?Z gnus-tmp-unread-and-unselected ?s)
1662 (?V gnus-version ?s)
1663 (?U gnus-tmp-unread ?d)
1664 (?S gnus-tmp-subject ?s)
1665 (?e gnus-tmp-unselected ?d)
1666 (?u gnus-tmp-user-defined ?s)
1667 (?d (length gnus-newsgroup-dormant) ?d)
1668 (?t (length gnus-newsgroup-marked) ?d)
1669 (?r (length gnus-newsgroup-reads) ?d)
1670 (?E gnus-newsgroup-expunged-tally ?d)
1671 (?s (gnus-current-score-file-nondirectory) ?s))))
1673 (defvar gnus-article-mode-line-format-alist
1674 gnus-summary-mode-line-format-alist)
1676 (defvar gnus-group-mode-line-format-alist
1677 (` ((?S gnus-tmp-news-server ?s)
1678 (?M gnus-tmp-news-method ?s)
1679 (?u gnus-tmp-user-defined ?s))))
1681 (defvar gnus-have-read-active-file nil)
1683 (defconst gnus-maintainer
1684 "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
1685 "The mail address of the Gnus maintainers.")
1687 (defconst gnus-version "September Gnus v0.37"
1688 "Version number for this version of Gnus.")
1690 (defvar gnus-info-nodes
1691 '((gnus-group-mode "(gnus)The Group Buffer")
1692 (gnus-summary-mode "(gnus)The Summary Buffer")
1693 (gnus-article-mode "(gnus)The Article Buffer"))
1694 "Assoc list of major modes and related Info nodes.")
1696 (defvar gnus-group-buffer "*Group*")
1697 (defvar gnus-summary-buffer "*Summary*")
1698 (defvar gnus-article-buffer "*Article*")
1699 (defvar gnus-server-buffer "*Server*")
1701 (defvar gnus-work-buffer " *gnus work*")
1703 (defvar gnus-original-article-buffer " *Original Article*")
1704 (defvar gnus-original-article nil)
1706 (defvar gnus-buffer-list nil
1707 "Gnus buffers that should be killed on exit.")
1709 (defvar gnus-server-alist nil
1710 "List of available servers.")
1712 (defvar gnus-slave nil
1713 "Whether this Gnus is a slave or not.")
1715 (defvar gnus-variable-list
1716 '(gnus-newsrc-options gnus-newsrc-options-n
1717 gnus-newsrc-last-checked-date
1718 gnus-newsrc-alist gnus-server-alist
1719 gnus-killed-list gnus-zombie-list
1720 gnus-topic-topology gnus-topic-alist
1722 "Gnus variables saved in the quick startup file.")
1724 (defvar gnus-newsrc-options nil
1725 "Options line in the .newsrc file.")
1727 (defvar gnus-newsrc-options-n nil
1728 "List of regexps representing groups to be subscribed/ignored unconditionally.")
1730 (defvar gnus-newsrc-last-checked-date nil
1731 "Date Gnus last asked server for new newsgroups.")
1733 (defvar gnus-topic-topology nil
1734 "The complete topic hierarchy.")
1736 (defvar gnus-topic-alist nil
1737 "The complete topic-group alist.")
1739 (defvar gnus-newsrc-alist nil
1740 "Assoc list of read articles.
1741 gnus-newsrc-hashtb should be kept so that both hold the same information.")
1743 (defvar gnus-newsrc-hashtb nil
1744 "Hashtable of gnus-newsrc-alist.")
1746 (defvar gnus-killed-list nil
1747 "List of killed newsgroups.")
1749 (defvar gnus-killed-hashtb nil
1750 "Hash table equivalent of gnus-killed-list.")
1752 (defvar gnus-zombie-list nil
1753 "List of almost dead newsgroups.")
1755 (defvar gnus-description-hashtb nil
1756 "Descriptions of newsgroups.")
1758 (defvar gnus-list-of-killed-groups nil
1759 "List of newsgroups that have recently been killed by the user.")
1761 (defvar gnus-active-hashtb nil
1762 "Hashtable of active articles.")
1764 (defvar gnus-moderated-list nil
1765 "List of moderated newsgroups.")
1767 (defvar gnus-group-marked nil)
1769 (defvar gnus-current-startup-file nil
1770 "Startup file for the current host.")
1772 (defvar gnus-last-search-regexp nil
1773 "Default regexp for article search command.")
1775 (defvar gnus-last-shell-command nil
1776 "Default shell command on article.")
1778 (defvar gnus-current-select-method nil
1779 "The current method for selecting a newsgroup.")
1781 (defvar gnus-group-list-mode nil)
1783 (defvar gnus-article-internal-prepare-hook nil)
1785 (defvar gnus-newsgroup-name nil)
1786 (defvar gnus-newsgroup-begin nil)
1787 (defvar gnus-newsgroup-end nil)
1788 (defvar gnus-newsgroup-last-rmail nil)
1789 (defvar gnus-newsgroup-last-mail nil)
1790 (defvar gnus-newsgroup-last-folder nil)
1791 (defvar gnus-newsgroup-last-file nil)
1792 (defvar gnus-newsgroup-auto-expire nil)
1793 (defvar gnus-newsgroup-active nil)
1795 (defvar gnus-newsgroup-data nil)
1796 (defvar gnus-newsgroup-data-reverse nil)
1797 (defvar gnus-newsgroup-limit nil)
1798 (defvar gnus-newsgroup-limits nil)
1800 (defvar gnus-newsgroup-unreads nil
1801 "List of unread articles in the current newsgroup.")
1803 (defvar gnus-newsgroup-unselected nil
1804 "List of unselected unread articles in the current newsgroup.")
1806 (defvar gnus-newsgroup-reads nil
1807 "Alist of read articles and article marks in the current newsgroup.")
1809 (defvar gnus-newsgroup-expunged-tally nil)
1811 (defvar gnus-newsgroup-marked nil
1812 "List of ticked articles in the current newsgroup (a subset of unread art).")
1814 (defvar gnus-newsgroup-killed nil
1815 "List of ranges of articles that have been through the scoring process.")
1817 (defvar gnus-newsgroup-cached nil
1818 "List of articles that come from the article cache.")
1820 (defvar gnus-newsgroup-saved nil
1821 "List of articles that have been saved.")
1823 (defvar gnus-newsgroup-kill-headers nil)
1825 (defvar gnus-newsgroup-replied nil
1826 "List of articles that have been replied to in the current newsgroup.")
1828 (defvar gnus-newsgroup-expirable nil
1829 "List of articles in the current newsgroup that can be expired.")
1831 (defvar gnus-newsgroup-processable nil
1832 "List of articles in the current newsgroup that can be processed.")
1834 (defvar gnus-newsgroup-bookmarks nil
1835 "List of articles in the current newsgroup that have bookmarks.")
1837 (defvar gnus-newsgroup-dormant nil
1838 "List of dormant articles in the current newsgroup.")
1840 (defvar gnus-newsgroup-scored nil
1841 "List of scored articles in the current newsgroup.")
1843 (defvar gnus-newsgroup-headers nil
1844 "List of article headers in the current newsgroup.")
1846 (defvar gnus-newsgroup-threads nil)
1848 (defvar gnus-newsgroup-prepared nil
1849 "Whether the current group has been prepared properly.")
1851 (defvar gnus-newsgroup-ancient nil
1852 "List of `gnus-fetch-old-headers' articles in the current newsgroup.")
1854 (defvar gnus-newsgroup-sparse nil)
1856 (defvar gnus-current-article nil)
1857 (defvar gnus-article-current nil)
1858 (defvar gnus-current-headers nil)
1859 (defvar gnus-have-all-headers nil)
1860 (defvar gnus-last-article nil)
1861 (defvar gnus-newsgroup-history nil)
1862 (defvar gnus-current-kill-article nil)
1864 ;; Save window configuration.
1865 (defvar gnus-prev-winconf nil)
1867 (defvar gnus-summary-mark-positions nil)
1868 (defvar gnus-group-mark-positions nil)
1870 (defvar gnus-reffed-article-number nil)
1872 ;;; Let the byte-compiler know that we know about this variable.
1873 (defvar rmail-default-rmail-file)
1875 (defvar gnus-cache-removable-articles nil)
1877 (defvar gnus-dead-summary nil)
1879 (defconst gnus-summary-local-variables
1880 '(gnus-newsgroup-name
1881 gnus-newsgroup-begin gnus-newsgroup-end
1882 gnus-newsgroup-last-rmail gnus-newsgroup-last-mail
1883 gnus-newsgroup-last-folder gnus-newsgroup-last-file
1884 gnus-newsgroup-auto-expire gnus-newsgroup-unreads
1885 gnus-newsgroup-unselected gnus-newsgroup-marked
1886 gnus-newsgroup-reads gnus-newsgroup-saved
1887 gnus-newsgroup-replied gnus-newsgroup-expirable
1888 gnus-newsgroup-processable gnus-newsgroup-killed
1889 gnus-newsgroup-bookmarks gnus-newsgroup-dormant
1890 gnus-newsgroup-headers gnus-newsgroup-threads
1891 gnus-newsgroup-prepared gnus-summary-highlight-line-function
1892 gnus-current-article gnus-current-headers gnus-have-all-headers
1893 gnus-last-article gnus-article-internal-prepare-hook
1894 gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay
1895 gnus-newsgroup-scored gnus-newsgroup-kill-headers
1896 gnus-newsgroup-async
1897 gnus-score-alist gnus-current-score-file gnus-summary-expunge-below
1898 gnus-summary-mark-below gnus-newsgroup-active gnus-scores-exclude-files
1899 gnus-newsgroup-history gnus-newsgroup-ancient
1900 gnus-newsgroup-sparse
1901 (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring)
1902 gnus-newsgroup-adaptive-score-file
1903 (gnus-newsgroup-expunged-tally . 0)
1904 gnus-cache-removeable-articles gnus-newsgroup-cached
1905 gnus-newsgroup-data gnus-newsgroup-data-reverse
1906 gnus-newsgroup-limit gnus-newsgroup-limits)
1907 "Variables that are buffer-local to the summary buffers.")
1909 (defconst gnus-bug-message
1910 "Sending a bug report to the Gnus Towers.
1911 ========================================
1913 The buffer below is a mail buffer. When you press `C-c C-c', it will
1914 be sent to the Gnus Bug Exterminators.
1916 At the bottom of the buffer you'll see lots of variable settings.
1917 Please do not delete those. They will tell the Bug People what your
1918 environment is, so that it will be easier to locate the bugs.
1920 If you have found a bug that makes Emacs go \"beep\", set
1921 debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET')
1922 and include the backtrace in your bug report.
1924 Please describe the bug in annoying, painstaking detail.
1926 Thank you for your help in stamping out bugs.
1929 ;;; End of variables.
1931 ;; Define some autoload functions Gnus might use.
1934 ;; This little mapcar goes through the list below and marks the
1935 ;; symbols in question as autoloaded functions.
1938 (let ((interactive (nth 1 (memq ':interactive package))))
1942 (when (consp function)
1943 (setq keymap (car (memq 'keymap function)))
1944 (setq function (car function)))
1945 (autoload function (car package) nil interactive keymap)))
1946 (if (eq (nth 1 package) ':interactive)
1949 '(("metamail" metamail-buffer)
1950 ("info" Info-goto-node)
1951 ("hexl" hexl-hex-string-to-integer)
1952 ("pp" pp pp-to-string pp-eval-expression)
1953 ("mail-extr" mail-extract-address-components)
1954 ("nnmail" nnmail-split-fancy nnmail-article-group)
1955 ("nnvirtual" nnvirtual-catchup-group)
1956 ("timezone" timezone-make-date-arpa-standard timezone-fix-time
1957 timezone-make-sortable-date timezone-make-time-string)
1958 ("sendmail" mail-position-on-field mail-setup)
1959 ("rmailout" rmail-output)
1960 ("rnewspost" news-mail-other-window news-reply-yank-original
1961 news-caesar-buffer-body)
1962 ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages
1964 ("gnus-soup" :interactive t
1965 gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article
1966 gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet)
1967 ("nnsoup" nnsoup-pack-replies)
1968 ("gnus-mh" gnus-mh-mail-setup gnus-summary-save-article-folder
1969 gnus-Folder-save-name gnus-folder-save-name)
1970 ("gnus-mh" :interactive t gnus-summary-save-in-folder)
1971 ("gnus-vis" gnus-group-make-menu-bar gnus-summary-make-menu-bar
1972 gnus-server-make-menu-bar gnus-article-make-menu-bar
1973 gnus-browse-make-menu-bar gnus-highlight-selected-summary
1974 gnus-summary-highlight-line gnus-carpal-setup-buffer
1975 gnus-group-highlight-line
1976 gnus-article-add-button gnus-insert-next-page-button
1977 gnus-insert-prev-page-button gnus-visual-turn-off-edit-menu)
1978 ("gnus-vis" :interactive t
1979 gnus-article-push-button gnus-article-press-button
1980 gnus-article-highlight gnus-article-highlight-some
1981 gnus-article-highlight-headers gnus-article-highlight-signature
1982 gnus-article-add-buttons gnus-article-add-buttons-to-head
1983 gnus-article-next-button gnus-article-prev-button)
1984 ("gnus-demon" gnus-demon-add-nocem gnus-demon-add-scanmail
1985 gnus-demon-add-disconnection gnus-demon-add-handler
1986 gnus-demon-remove-handler)
1987 ("gnus-demon" :interactive t
1988 gnus-demon-init gnus-demon-cancel)
1989 ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree
1990 gnus-tree-open gnus-tree-close)
1991 ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close)
1992 ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info)
1993 ("gnus-srvr" gnus-browse-foreign-server)
1994 ("gnus-cite" :interactive t
1995 gnus-article-highlight-citation gnus-article-hide-citation-maybe
1996 gnus-article-hide-citation gnus-article-fill-cited-article)
1997 ("gnus-kill" gnus-kill gnus-apply-kill-file-internal
1998 gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author
1999 gnus-execute gnus-expunge)
2000 ("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers
2001 gnus-cache-possibly-remove-articles gnus-cache-request-article
2002 gnus-cache-retrieve-headers gnus-cache-possibly-alter-active
2003 gnus-cache-enter-remove-article gnus-cached-article-p
2004 gnus-cache-open gnus-cache-close)
2005 ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article
2006 gnus-cache-remove-article)
2007 ("gnus-score" :interactive t
2008 gnus-summary-increase-score gnus-summary-lower-score
2009 gnus-score-flush-cache gnus-score-close
2010 gnus-score-raise-same-subject-and-select
2011 gnus-score-raise-same-subject gnus-score-default
2012 gnus-score-raise-thread gnus-score-lower-same-subject-and-select
2013 gnus-score-lower-same-subject gnus-score-lower-thread
2014 gnus-possibly-score-headers)
2016 (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers
2017 gnus-current-score-file-nondirectory gnus-score-adaptive
2018 gnus-score-find-trace gnus-score-file-name)
2019 ("gnus-edit" :interactive t gnus-score-customize)
2020 ("gnus-topic" :interactive t gnus-topic-mode)
2021 ("gnus-topic" gnus-topic-remove-group)
2022 ("gnus-salt" :interactive t gnus-pick-mode)
2023 ("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap))
2024 ("gnus-uu" :interactive t
2025 gnus-uu-digest-mail-forward gnus-uu-digest-post-forward
2026 gnus-uu-mark-series gnus-uu-mark-region gnus-uu-mark-buffer
2027 gnus-uu-mark-by-regexp gnus-uu-mark-all
2028 gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu
2029 gnus-uu-decode-uu-and-save gnus-uu-decode-unshar
2030 gnus-uu-decode-unshar-and-save gnus-uu-decode-save
2031 gnus-uu-decode-binhex gnus-uu-decode-uu-view
2032 gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view
2033 gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view
2034 gnus-uu-decode-binhex-view)
2035 ("gnus-msg" (gnus-summary-send-map keymap)
2036 gnus-mail-yank-original gnus-mail-send-and-exit
2037 gnus-sendmail-setup-mail gnus-article-mail
2038 gnus-inews-message-id gnus-new-mail gnus-mail-reply)
2039 ("gnus-msg" :interactive t
2040 gnus-group-post-news gnus-group-mail gnus-summary-post-news
2041 gnus-summary-followup gnus-summary-followup-with-original
2042 gnus-summary-followup-and-reply
2043 gnus-summary-followup-and-reply-with-original
2044 gnus-summary-cancel-article gnus-summary-supersede-article
2045 gnus-post-news gnus-inews-news gnus-cancel-news
2046 gnus-summary-reply gnus-summary-reply-with-original
2047 gnus-summary-mail-forward gnus-summary-mail-other-window
2049 ("gnus-picon" :interactive t gnus-article-display-picons
2050 gnus-group-display-picons gnus-picons-article-display-x-face)
2051 ("gnus-vm" gnus-vm-mail-setup)
2052 ("gnus-vm" :interactive t gnus-summary-save-in-vm
2053 gnus-summary-save-article-vm gnus-yank-article))))
2057 ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
2058 ;; If you want the cursor to go somewhere else, set these two
2059 ;; functions in some startup hook to whatever you want.
2060 (defalias 'gnus-summary-position-point 'gnus-goto-colon)
2061 (defalias 'gnus-group-position-point 'gnus-goto-colon)
2063 ;;; Various macros and substs.
2065 (defun gnus-header-from (header)
2066 (mail-header-from header))
2068 (defmacro gnus-eval-in-buffer-window (buffer &rest forms)
2069 "Pop to BUFFER, evaluate FORMS, and then return to the original window."
2070 `(let ((GnusStartBufferWindow (selected-window)))
2073 (pop-to-buffer ,buffer)
2075 (select-window GnusStartBufferWindow))))
2077 (defmacro gnus-gethash (string hashtable)
2078 "Get hash value of STRING in HASHTABLE."
2079 `(symbol-value (intern-soft ,string ,hashtable)))
2081 (defmacro gnus-sethash (string value hashtable)
2082 "Set hash value. Arguments are STRING, VALUE, and HASHTABLE."
2083 `(set (intern ,string ,hashtable) ,value))
2085 (defmacro gnus-intern-safe (string hashtable)
2086 "Set hash value. Arguments are STRING, VALUE, and HASHTABLE."
2087 `(let ((symbol (intern ,string ,hashtable)))
2092 (defmacro gnus-group-unread (group)
2093 "Get the currently computed number of unread articles in GROUP."
2094 `(car (gnus-gethash ,group gnus-newsrc-hashtb)))
2096 (defmacro gnus-group-entry (group)
2097 "Get the newsrc entry for GROUP."
2098 `(gnus-gethash ,group gnus-newsrc-hashtb))
2100 (defmacro gnus-active (group)
2101 "Get active info on GROUP."
2102 `(gnus-gethash ,group gnus-active-hashtb))
2104 (defmacro gnus-set-active (group active)
2105 "Set GROUP's active info."
2106 `(gnus-sethash ,group ,active gnus-active-hashtb))
2108 ;; modified by MORIOKA Tomohiko <morioka@jaist.ac.jp>
2109 ;; function `substring' might cut on a middle of multi-octet
2111 (defun gnus-truncate-string (str width)
2112 (substring str 0 width))
2114 ;; Added by Geoffrey T. Dairiki <dairiki@u.washington.edu>. A safe way
2115 ;; to limit the length of a string. This function is necessary since
2116 ;; `(substr "abc" 0 30)' pukes with "Args out of range".
2117 (defsubst gnus-limit-string (str width)
2118 (if (> (length str) width)
2119 (substring str 0 width)
2122 (defsubst gnus-simplify-subject-re (subject)
2123 "Remove \"Re:\" from subject lines."
2124 (if (string-match "^[Rr][Ee]: *" subject)
2125 (substring subject (match-end 0))
2128 (defsubst gnus-goto-char (point)
2129 (and point (goto-char point)))
2131 (defmacro gnus-buffer-exists-p (buffer)
2133 (funcall (if (stringp ,buffer) 'get-buffer 'buffer-name)
2136 (defmacro gnus-kill-buffer (buffer)
2137 `(let ((buf ,buffer))
2138 (if (gnus-buffer-exists-p buf)
2139 (kill-buffer buf))))
2141 (defsubst gnus-point-at-bol ()
2142 "Return point at the beginning of the line."
2149 (defsubst gnus-point-at-eol ()
2150 "Return point at the end of the line."
2157 ;; Delete the current line (and the next N lines.);
2158 (defmacro gnus-delete-line (&optional n)
2159 `(delete-region (progn (beginning-of-line) (point))
2160 (progn (forward-line ,(or n 1)) (point))))
2162 ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
2163 (defvar gnus-init-inhibit nil)
2164 (defun gnus-read-init-file (&optional inhibit-next)
2165 (if gnus-init-inhibit
2166 (setq gnus-init-inhibit nil)
2167 (setq gnus-init-inhibit inhibit-next)
2169 (or (and (file-exists-p gnus-init-file)
2170 ;; Don't try to load a directory.
2171 (not (file-directory-p gnus-init-file)))
2172 (file-exists-p (concat gnus-init-file ".el"))
2173 (file-exists-p (concat gnus-init-file ".elc")))
2175 (load gnus-init-file nil t)
2177 (error "Error in %s: %s" gnus-init-file var))))))
2179 ;; Info access macros.
2181 (defmacro gnus-info-group (info)
2183 (defmacro gnus-info-rank (info)
2185 (defmacro gnus-info-read (info)
2187 (defmacro gnus-info-marks (info)
2189 (defmacro gnus-info-method (info)
2191 (defmacro gnus-info-params (info)
2194 (defmacro gnus-info-level (info)
2195 `(let ((rank (gnus-info-rank ,info)))
2199 (defmacro gnus-info-score (info)
2200 `(let ((rank (gnus-info-rank ,info)))
2201 (or (and (consp rank) (cdr rank)) 0)))
2203 (defmacro gnus-info-set-group (info group)
2204 `(setcar ,info ,group))
2205 (defmacro gnus-info-set-rank (info rank)
2206 `(setcar (nthcdr 1 ,info) ,rank))
2207 (defmacro gnus-info-set-read (info read)
2208 `(setcar (nthcdr 2 ,info) ,read))
2209 (defmacro gnus-info-set-marks (info marks)
2210 `(setcar (nthcdr 3 ,info) ,marks))
2211 (defmacro gnus-info-set-method (info method)
2212 `(setcar (nthcdr 4 ,info) ,method))
2213 (defmacro gnus-info-set-params (info params)
2214 `(setcar (nthcdr 5 ,info) ,params))
2216 (defmacro gnus-info-set-level (info level)
2217 `(let ((rank (cdr ,info)))
2218 (if (consp (car rank))
2219 (setcar (car rank) ,level)
2220 (setcar rank ,level))))
2221 (defmacro gnus-info-set-score (info score)
2222 `(let ((rank (cdr ,info)))
2223 (if (consp (car rank))
2224 (setcdr (car rank) ,score)
2225 (setcar rank (cons (car rank) ,score)))))
2227 (defmacro gnus-get-info (group)
2228 `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb)))
2230 (defun gnus-byte-code (func)
2231 "Return a form that can be `eval'ed based on FUNC."
2232 (let ((fval (symbol-function func)))
2233 (if (byte-code-function-p fval)
2234 (let ((flist (append fval nil)))
2235 (setcar flist 'byte-code)
2237 (cons 'progn (cdr (cdr fval))))))
2239 ;;; Load the compatability functions.
2246 ;; Format specs. The chunks below are the machine-generated forms
2247 ;; that are to be evaled as the result of the default format strings.
2248 ;; We write them in here to get them byte-compiled. That way the
2249 ;; default actions will be quite fast, while still retaining the full
2250 ;; flexibility of the user-defined format specs.
2252 ;; First we have lots of dummy defvars to let the compiler know these
2253 ;; are really dynamic variables.
2255 (defvar gnus-tmp-unread)
2256 (defvar gnus-tmp-replied)
2257 (defvar gnus-tmp-score-char)
2258 (defvar gnus-tmp-indentation)
2259 (defvar gnus-tmp-opening-bracket)
2260 (defvar gnus-tmp-lines)
2261 (defvar gnus-tmp-name)
2262 (defvar gnus-tmp-closing-bracket)
2263 (defvar gnus-tmp-subject-or-nil)
2264 (defvar gnus-tmp-subject)
2265 (defvar gnus-tmp-marked)
2266 (defvar gnus-tmp-marked-mark)
2267 (defvar gnus-tmp-subscribed)
2268 (defvar gnus-tmp-process-marked)
2269 (defvar gnus-tmp-number-of-unread)
2270 (defvar gnus-tmp-group-name)
2271 (defvar gnus-tmp-group)
2272 (defvar gnus-tmp-article-number)
2273 (defvar gnus-tmp-unread-and-unselected)
2274 (defvar gnus-tmp-news-method)
2275 (defvar gnus-tmp-news-server)
2276 (defvar gnus-tmp-article-number)
2277 (defvar gnus-mouse-face)
2278 (defvar gnus-mouse-face-prop)
2280 (defun gnus-summary-line-format-spec ()
2281 (insert gnus-tmp-unread gnus-tmp-replied
2282 gnus-tmp-score-char gnus-tmp-indentation)
2287 gnus-tmp-opening-bracket
2288 (format "%4d: %-20s"
2290 (if (> (length gnus-tmp-name) 20)
2291 (substring gnus-tmp-name 0 20)
2293 gnus-tmp-closing-bracket)
2295 gnus-mouse-face-prop gnus-mouse-face)
2296 (insert " " gnus-tmp-subject-or-nil "\n"))
2298 (defvar gnus-summary-line-format-spec
2299 (gnus-byte-code 'gnus-summary-line-format-spec))
2301 (defun gnus-summary-dummy-line-format-spec ()
2308 gnus-mouse-face-prop gnus-mouse-face)
2309 (insert " " gnus-tmp-subject "\n"))
2311 (defvar gnus-summary-dummy-line-format-spec
2312 (gnus-byte-code 'gnus-summary-dummy-line-format-spec))
2314 (defun gnus-group-line-format-spec ()
2315 (insert gnus-tmp-marked-mark gnus-tmp-subscribed
2316 gnus-tmp-process-marked
2317 gnus-group-indentation
2318 (format "%5s: " gnus-tmp-number-of-unread))
2322 (insert gnus-tmp-group "\n")
2324 gnus-mouse-face-prop gnus-mouse-face))
2325 (defvar gnus-group-line-format-spec
2326 (gnus-byte-code 'gnus-group-line-format-spec))
2328 (defvar gnus-format-specs
2329 `((version . ,emacs-version)
2330 (group ,gnus-group-line-format ,gnus-group-line-format-spec)
2331 (summary-dummy ,gnus-summary-dummy-line-format
2332 ,gnus-summary-dummy-line-format-spec)
2333 (summary ,gnus-summary-line-format ,gnus-summary-line-format-spec)))
2335 (defvar gnus-article-mode-line-format-spec nil)
2336 (defvar gnus-summary-mode-line-format-spec nil)
2337 (defvar gnus-group-mode-line-format-spec nil)
2339 ;;; Phew. All that gruft is over, fortunately.
2343 ;;; Gnus Utility Functions
2346 (defun gnus-extract-address-components (from)
2348 ;; First find the address - the thing with the @ in it. This may
2349 ;; not be accurate in mail addresses, but does the trick most of
2350 ;; the time in news messages.
2351 (if (string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from)
2352 (setq address (substring from (match-beginning 0) (match-end 0))))
2353 ;; Then we check whether the "name <address>" format is used.
2355 ;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp>
2356 ;; Linear white space is not required.
2357 (string-match (concat "[ \t]*<" (regexp-quote address) ">") from)
2358 (and (setq name (substring from 0 (match-beginning 0)))
2359 ;; Strip any quotes from the name.
2360 (string-match "\".*\"" name)
2361 (setq name (substring name 1 (1- (match-end 0))))))
2362 ;; If not, then "address (name)" is used.
2364 (and (string-match "(.+)" from)
2365 (setq name (substring from (1+ (match-beginning 0))
2366 (1- (match-end 0)))))
2367 (and (string-match "()" from)
2368 (setq name address))
2369 ;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp>.
2370 ;; XOVER might not support folded From headers.
2371 (and (string-match "(.*" from)
2372 (setq name (substring from (1+ (match-beginning 0))
2374 ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
2375 (list (or name from) (or address from))))
2377 (defun gnus-fetch-field (field)
2378 "Return the value of the header FIELD of current article."
2381 (let ((case-fold-search t))
2382 (nnheader-narrow-to-headers)
2383 (mail-fetch-field field)))))
2385 (defun gnus-goto-colon ()
2387 (search-forward ":" (gnus-point-at-eol) t))
2390 (defun gnus-update-format (var)
2391 "Update the format specification near point."
2396 ;; Find the end of the current word.
2397 (re-search-forward "[ \t\n]" nil t)
2399 (when (re-search-backward "\\(gnus-[-a-z]+-line-format\\)" nil t)
2400 (match-string 1)))))
2401 (let* ((type (intern (progn (string-match "gnus-\\([-a-z]+\\)-line" var)
2402 (match-string 1 var))))
2403 (entry (assq type gnus-format-specs))
2406 (setq gnus-format-specs (delq entry gnus-format-specs)))
2408 (intern (format "%s-spec" var))
2409 (gnus-parse-format (setq value (symbol-value (intern var)))
2410 (symbol-value (intern (format "%s-alist" var)))
2411 (not (string-match "mode" var))))
2412 (setq spec (symbol-value (intern (format "%s-spec" var))))
2413 (push (list type value spec) gnus-format-specs)
2415 (pop-to-buffer "*Gnus Format*")
2417 (lisp-interaction-mode)
2418 (insert (pp-to-string spec))))
2421 (defun gnus-update-format-specifications (&optional force)
2422 "Update all (necessary) format specifications."
2423 ;; Make the indentation array.
2424 (gnus-make-thread-indent-array)
2426 ;; See whether all the stored info needs to be flushed.
2428 (not (equal emacs-version
2429 (cdr (assq 'version gnus-format-specs)))))
2430 (setq gnus-format-specs nil))
2432 ;; Go through all the formats and see whether they need updating.
2433 (let ((types '(summary summary-dummy group
2434 summary-mode group-mode article-mode))
2435 new-format entry type val)
2436 (while (setq type (pop types))
2437 (setq new-format (symbol-value
2438 (intern (format "gnus-%s-line-format" type))))
2439 (setq entry (cdr (assq type gnus-format-specs)))
2441 (equal (car entry) new-format))
2442 ;; Use the old format.
2443 (set (intern (format "gnus-%s-line-format-spec" type))
2445 ;; This is a new format.
2447 (if (not (stringp new-format))
2448 ;; This is a function call or something.
2450 ;; This is a "real" format.
2454 (intern (format "gnus-%s-line-format-alist"
2455 (if (eq type 'article-mode)
2456 'summary-mode type))))
2457 (not (string-match "mode$" (symbol-name type))))))
2458 ;; Enter the new format spec into the list.
2461 (setcar (cdr entry) val)
2462 (setcar entry new-format))
2463 (push (list type new-format val) gnus-format-specs))
2464 (set (intern (format "gnus-%s-line-format-spec" type)) val))))
2466 (gnus-update-group-mark-positions)
2467 (gnus-update-summary-mark-positions)
2469 ;; See whether we need to read the description file.
2470 (if (and (string-match "%[-,0-9]*D" gnus-group-line-format)
2471 (not gnus-description-hashtb)
2472 gnus-read-active-file)
2473 (gnus-read-all-descriptions-files)))
2475 (defun gnus-update-summary-mark-positions ()
2476 "Compute where the summary marks are to go."
2478 (let ((gnus-replied-mark 129)
2479 (gnus-score-below-mark 130)
2480 (gnus-score-over-mark 130)
2484 (gnus-set-work-buffer)
2485 (gnus-summary-insert-line
2486 [0 "" "" "" "" "" 0 0 ""] 0 nil 128 t nil "" nil 1)
2487 (goto-char (point-min))
2488 (setq pos (list (cons 'unread (and (search-forward "\200" nil t)
2490 (goto-char (point-min))
2491 (setq pos (cons (cons 'replied (and (search-forward "\201" nil t)
2492 (- (point) 2))) pos))
2493 (goto-char (point-min))
2494 (setq pos (cons (cons 'score (and (search-forward "\202" nil t)
2495 (- (point) 2))) pos))
2496 (setq gnus-summary-mark-positions pos))))
2498 (defun gnus-update-group-mark-positions ()
2500 (let ((gnus-process-mark 128)
2501 (gnus-group-marked '("dummy.group")))
2502 (gnus-set-active "dummy.group" '(0 . 0))
2503 (gnus-set-work-buffer)
2504 (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
2505 (goto-char (point-min))
2506 (setq gnus-group-mark-positions
2507 (list (cons 'process (and (search-forward "\200" nil t)
2508 (- (point) 2))))))))
2510 (defvar gnus-mouse-face-0 'highlight)
2511 (defvar gnus-mouse-face-1 'highlight)
2512 (defvar gnus-mouse-face-2 'highlight)
2513 (defvar gnus-mouse-face-3 'highlight)
2514 (defvar gnus-mouse-face-4 'highlight)
2516 (defun gnus-mouse-face-function (form type)
2518 (point) (progn ,@form (point))
2519 gnus-mouse-face-prop
2522 `(quote ,(symbol-value (intern (format "gnus-mouse-face-%d" type)))))))
2524 (defvar gnus-face-0 'bold)
2525 (defvar gnus-face-1 'italic)
2526 (defvar gnus-face-2 'bold-italic)
2527 (defvar gnus-face-3 'bold)
2528 (defvar gnus-face-4 'bold)
2530 (defun gnus-face-face-function (form type)
2532 (point) (progn ,@form (point))
2533 'face ',(symbol-value (intern (format "gnus-face-%d" type)))))
2535 (defun gnus-max-width-function (el max-width)
2536 (or (numberp max-width) (signal 'wrong-type-argument '(numberp max-width)))
2538 `(if (> (length ,el) ,max-width)
2539 (substring ,el 0 ,max-width)
2541 `(let ((val (eval ,el)))
2543 (setq val (int-to-string val)))
2544 (if (> (length val) ,max-width)
2545 (substring val 0 ,max-width)
2548 (defun gnus-parse-format (format spec-alist &optional insert)
2549 ;; This function parses the FORMAT string with the help of the
2550 ;; SPEC-ALIST and returns a list that can be eval'ed to return the
2551 ;; string. If the FORMAT string contains the specifiers %( and %)
2552 ;; the text between them will have the mouse-face text property.
2554 "\\`\\(.*\\)%[0-9]?[{(]\\(.*\\)%[0-9]?[})]\\(.*\n?\\)\\'"
2556 (gnus-parse-complex-format format spec-alist)
2557 ;; This is a simple format.
2558 (gnus-parse-simple-format format spec-alist insert)))
2560 (defun gnus-parse-complex-format (format spec-alist)
2562 (gnus-set-work-buffer)
2564 (goto-char (point-min))
2565 (while (re-search-forward "\"" nil t)
2566 (replace-match "\\\"" nil t))
2567 (goto-char (point-min))
2569 (while (re-search-forward "%\\([0-9]+\\)?\\([{}()]\\)" nil t)
2570 (let ((number (if (match-beginning 1)
2571 (match-string 1) "0"))
2572 (delim (aref (match-string 2) 0)))
2573 (if (or (= delim ?\() (= delim ?\{))
2574 (replace-match (concat "\"(" (if (= delim ?\() "mouse" "face")
2576 (replace-match "\")\""))))
2577 (goto-char (point-max))
2579 (goto-char (point-min))
2580 (let ((form (read (current-buffer))))
2581 (cons 'progn (gnus-complex-form-to-spec form spec-alist)))))
2583 (defun gnus-complex-form-to-spec (form spec-alist)
2588 (gnus-parse-simple-format sform spec-alist t)
2589 (funcall (intern (format "gnus-%s-face-function"
2591 (gnus-complex-form-to-spec
2592 (cdr (cdr sform)) spec-alist)
2596 (defun gnus-parse-simple-format (format spec-alist &optional insert)
2597 ;; This function parses the FORMAT string with the help of the
2598 ;; SPEC-ALIST and returns a list that can be eval'ed to return a
2601 spec flist fstring newspec elem beg result dontinsert)
2603 (gnus-set-work-buffer)
2605 (goto-char (point-min))
2606 (while (re-search-forward "%[-0-9]*\\(,[0-9]+\\)?\\([^0-9]\\)\\(.\\)?"
2608 (if (= (setq spec (string-to-char (match-string 2))) ?%)
2610 beg (1+ (match-beginning 0)))
2611 ;; First check if there are any specs that look anything like
2612 ;; "%12,12A", ie. with a "max width specification". These have
2613 ;; to be treated specially.
2614 (if (setq beg (match-beginning 1))
2618 (1+ (match-beginning 1)) (match-end 1))))
2620 (setq beg (match-beginning 2)))
2621 ;; Find the specification from `spec-alist'.
2622 (unless (setq elem (cdr (assq spec spec-alist)))
2623 (setq elem '("*" ?s)))
2624 ;; Treat user defined format specifiers specially.
2625 (when (eq (car elem) 'gnus-tmp-user-defined)
2628 (list (intern (concat "gnus-user-format-function-"
2630 'gnus-tmp-header) ?s))
2631 (delete-region (match-beginning 3) (match-end 3)))
2632 (if (not (zerop max-width))
2633 (let ((el (car elem)))
2634 (cond ((= (car (cdr elem)) ?c)
2635 (setq el (list 'char-to-string el)))
2636 ((= (car (cdr elem)) ?d)
2637 (setq el (list 'int-to-string el))))
2638 (setq flist (cons (gnus-max-width-function el max-width)
2642 (setq flist (cons (car elem) flist))
2643 (setq newspec (car (cdr elem))))))
2644 ;; Remove the old specification (and possibly a ",12" string).
2645 (delete-region beg (match-end 2))
2646 ;; Insert the new specification.
2649 (setq fstring (buffer-substring 1 (point-max))))
2650 ;; Do some postprocessing to increase efficiency.
2655 ((string= fstring "")
2657 ;; Not a format string.
2658 ((not (string-match "%" fstring))
2660 ;; A format string with just a single string spec.
2661 ((string= fstring "%s")
2663 ;; A single character.
2664 ((string= fstring "%c")
2667 ((string= fstring "%d")
2670 (list `(princ ,(car flist)))
2671 (list `(int-to-string ,(car flist)))))
2672 ;; Just lots of chars and strings.
2673 ((string-match "\\`\\(%[cs]\\)+\\'" fstring)
2675 ;; A single string spec at the beginning of the spec.
2676 ((string-match "\\`%[sc][^%]+\\'" fstring)
2677 (list (car flist) (substring fstring 2)))
2678 ;; A single string spec in the middle of the spec.
2679 ((string-match "\\`\\([^%]+\\)%[sc]\\([^%]+\\)\\'" fstring)
2680 (list (match-string 1 fstring) (car flist) (match-string 2 fstring)))
2681 ;; A single string spec in the end of the spec.
2682 ((string-match "\\`\\([^%]+\\)%[sc]\\'" fstring)
2683 (list (match-string 1 fstring) (car flist)))
2684 ;; A more complex spec.
2686 (list (cons 'format (cons fstring (nreverse flist)))))))
2692 (cons 'insert result)))
2693 (cond ((stringp result)
2696 (cons 'concat result))
2699 (defun gnus-eval-format (format &optional alist props)
2700 "Eval the format variable FORMAT, using ALIST.
2701 If PROPS, insert the result."
2702 (let ((form (gnus-parse-format format alist props)))
2704 (add-text-properties (point) (progn (eval form) (point)) props)
2707 (defun gnus-remove-text-with-property (prop)
2708 "Delete all text in the current buffer with text property PROP."
2710 (goto-char (point-min))
2712 (while (get-text-property (point) prop)
2714 (goto-char (next-single-property-change (point) prop nil (point-max))))))
2716 (defun gnus-set-work-buffer ()
2717 (if (get-buffer gnus-work-buffer)
2719 (set-buffer gnus-work-buffer)
2721 (set-buffer (get-buffer-create gnus-work-buffer))
2722 (kill-all-local-variables)
2723 (buffer-disable-undo (current-buffer))
2724 (gnus-add-current-to-buffer-list)))
2726 ;; Article file names when saving.
2728 (defun gnus-Numeric-save-name (newsgroup headers &optional last-file)
2729 "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2730 If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group/num.
2731 Otherwise, it is like ~/News/news/group/num."
2734 (concat (if (gnus-use-long-file-name 'not-save)
2735 (gnus-capitalize-newsgroup newsgroup)
2736 (gnus-newsgroup-directory-form newsgroup))
2737 "/" (int-to-string (mail-header-number headers)))
2738 (or gnus-article-save-directory "~/News"))))
2740 (string-equal (file-name-directory default)
2741 (file-name-directory last-file))
2742 (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
2744 (or last-file default))))
2746 (defun gnus-numeric-save-name (newsgroup headers &optional last-file)
2747 "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2748 If variable `gnus-use-long-file-name' is non-nil, it is
2749 ~/News/news.group/num. Otherwise, it is like ~/News/news/group/num."
2752 (concat (if (gnus-use-long-file-name 'not-save)
2754 (gnus-newsgroup-directory-form newsgroup))
2755 "/" (int-to-string (mail-header-number headers)))
2756 (or gnus-article-save-directory "~/News"))))
2758 (string-equal (file-name-directory default)
2759 (file-name-directory last-file))
2760 (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
2762 (or last-file default))))
2764 (defun gnus-Plain-save-name (newsgroup headers &optional last-file)
2765 "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2766 If variable `gnus-use-long-file-name' is non-nil, it is
2767 ~/News/News.group. Otherwise, it is like ~/News/news/group/news."
2770 (if (gnus-use-long-file-name 'not-save)
2771 (gnus-capitalize-newsgroup newsgroup)
2772 (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
2773 (or gnus-article-save-directory "~/News"))))
2775 (defun gnus-plain-save-name (newsgroup headers &optional last-file)
2776 "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2777 If variable `gnus-use-long-file-name' is non-nil, it is
2778 ~/News/news.group. Otherwise, it is like ~/News/news/group/news."
2781 (if (gnus-use-long-file-name 'not-save)
2783 (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
2784 (or gnus-article-save-directory "~/News"))))
2786 ;; For subscribing new newsgroup
2788 (defun gnus-subscribe-hierarchical-interactive (groups)
2789 (let ((groups (sort groups 'string<))
2790 prefixes prefix start ans group starts)
2792 (setq prefixes (list "^"))
2793 (while (and groups prefixes)
2794 (while (not (string-match (car prefixes) (car groups)))
2795 (setq prefixes (cdr prefixes)))
2796 (setq prefix (car prefixes))
2797 (setq start (1- (length prefix)))
2798 (if (and (string-match "[^\\.]\\." (car groups) start)
2801 (concat "^" (substring (car groups) 0 (match-end 0))))
2802 (string-match prefix (car (cdr groups))))
2804 (setq prefixes (cons prefix prefixes))
2805 (message "Descend hierarchy %s? ([y]nsq): "
2806 (substring prefix 1 (1- (length prefix))))
2807 (setq ans (read-char))
2810 (string-match prefix
2811 (setq group (car groups))))
2812 (setq gnus-killed-list
2813 (cons group gnus-killed-list))
2814 (gnus-sethash group group gnus-killed-hashtb)
2815 (setq groups (cdr groups)))
2816 (setq starts (cdr starts)))
2819 (string-match prefix
2820 (setq group (car groups))))
2821 (gnus-sethash group group gnus-killed-hashtb)
2822 (gnus-subscribe-alphabetically (car groups))
2823 (setq groups (cdr groups)))
2824 (setq starts (cdr starts)))
2827 (setq group (car groups))
2828 (setq gnus-killed-list (cons group gnus-killed-list))
2829 (gnus-sethash group group gnus-killed-hashtb)
2830 (setq groups (cdr groups))))
2832 (message "Subscribe %s? ([n]yq)" (car groups))
2833 (setq ans (read-char))
2834 (setq group (car groups))
2836 (gnus-subscribe-alphabetically (car groups))
2837 (gnus-sethash group group gnus-killed-hashtb))
2840 (setq group (car groups))
2841 (setq gnus-killed-list (cons group gnus-killed-list))
2842 (gnus-sethash group group gnus-killed-hashtb)
2843 (setq groups (cdr groups))))
2845 (setq gnus-killed-list (cons group gnus-killed-list))
2846 (gnus-sethash group group gnus-killed-hashtb)))
2847 (setq groups (cdr groups)))))))
2849 (defun gnus-subscribe-randomly (newsgroup)
2850 "Subscribe new NEWSGROUP by making it the first newsgroup."
2851 (gnus-subscribe-newsgroup newsgroup))
2853 (defun gnus-subscribe-alphabetically (newgroup)
2854 "Subscribe new NEWSGROUP and insert it in alphabetical order."
2855 (let ((groups (cdr gnus-newsrc-alist))
2857 (while (and (not before) groups)
2858 (if (string< newgroup (car (car groups)))
2859 (setq before (car (car groups)))
2860 (setq groups (cdr groups))))
2861 (gnus-subscribe-newsgroup newgroup before)))
2863 (defun gnus-subscribe-hierarchically (newgroup)
2864 "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order."
2865 ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
2867 (set-buffer (find-file-noselect gnus-current-startup-file))
2868 (let ((groupkey newgroup)
2870 (while (and (not before) groupkey)
2871 (goto-char (point-min))
2873 (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
2874 (while (and (re-search-forward groupkey-re nil t)
2876 (setq before (match-string 1))
2877 (string< before newgroup)))))
2878 ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
2880 (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
2881 (substring groupkey (match-beginning 1) (match-end 1)))))
2882 (gnus-subscribe-newsgroup newgroup before))))
2884 (defun gnus-subscribe-interactively (group)
2885 "Subscribe the new GROUP interactively.
2886 It is inserted in hierarchical newsgroup order if subscribed. If not,
2888 (if (gnus-y-or-n-p (format "Subscribe new newsgroup: %s " group))
2889 (gnus-subscribe-hierarchically group)
2890 (push group gnus-killed-list)))
2892 (defun gnus-subscribe-zombies (group)
2893 "Make the new GROUP into a zombie group."
2894 (push group gnus-zombie-list))
2896 (defun gnus-subscribe-killed (group)
2897 "Make the new GROUP a killed group."
2898 (push group gnus-killed-list))
2900 (defun gnus-subscribe-newsgroup (newsgroup &optional next)
2901 "Subscribe new NEWSGROUP.
2902 If NEXT is non-nil, it is inserted before NEXT. Otherwise it is made
2903 the first newsgroup."
2904 ;; We subscribe the group by changing its level to `subscribed'.
2905 (gnus-group-change-level
2906 newsgroup gnus-level-default-subscribed
2907 gnus-level-killed (gnus-gethash (or next "dummy.group") gnus-newsrc-hashtb))
2908 (gnus-message 5 "Subscribe newsgroup: %s" newsgroup))
2912 (defun gnus-newsgroup-directory-form (newsgroup)
2913 "Make hierarchical directory name from NEWSGROUP name."
2914 (let ((newsgroup (gnus-newsgroup-savable-name newsgroup))
2915 (len (length newsgroup))
2917 ;; If this is a foreign group, we don't want to translate the
2919 (if (setq idx (string-match ":" newsgroup))
2920 (aset newsgroup idx ?/)
2922 ;; Replace all occurrences of `.' with `/'.
2924 (if (= (aref newsgroup idx) ?.)
2925 (aset newsgroup idx ?/))
2926 (setq idx (1+ idx)))
2929 (defun gnus-newsgroup-savable-name (group)
2930 ;; Replace any slashes in a group name (eg. an ange-ftp nndoc group)
2932 (nnheader-replace-chars-in-string group ?/ ?.))
2934 (defun gnus-make-directory (dir)
2935 "Make DIRECTORY recursively."
2936 ;; Why don't we use `(make-directory dir 'parents)'? That's just one
2937 ;; of the many mysteries of the universe.
2938 (let* ((dir (expand-file-name dir default-directory))
2940 (if (string-match "/$" dir)
2941 (setq dir (substring dir 0 (match-beginning 0))))
2942 ;; First go down the path until we find a directory that exists.
2943 (while (not (file-exists-p dir))
2944 (setq dirs (cons dir dirs))
2945 (string-match "/[^/]+$" dir)
2946 (setq dir (substring dir 0 (match-beginning 0))))
2947 ;; Then create all the subdirs.
2948 (while (and dirs (not err))
2950 (make-directory (car dirs))
2951 (error (setq err t)))
2952 (setq dirs (cdr dirs)))
2953 ;; We return whether we were successful or not.
2956 (defun gnus-capitalize-newsgroup (newsgroup)
2957 "Capitalize NEWSGROUP name."
2958 (and (not (zerop (length newsgroup)))
2959 (concat (char-to-string (upcase (aref newsgroup 0)))
2960 (substring newsgroup 1))))
2962 ;; Various... things.
2964 (defun gnus-simplify-subject (subject &optional re-only)
2965 "Remove `Re:' and words in parentheses.
2966 If RE-ONLY is non-nil, strip leading `Re:'s only."
2967 (let ((case-fold-search t)) ;Ignore case.
2968 ;; Remove `Re:', `Re^N:', `Re(n)', and `Re[n]:'.
2969 (when (string-match "\\`\\(re\\([[(^][0-9]+[])]?\\)?:[ \t]*\\)+" subject)
2970 (setq subject (substring subject (match-end 0))))
2971 ;; Remove uninteresting prefixes.
2972 (if (and (not re-only)
2973 gnus-simplify-ignored-prefixes
2974 (string-match gnus-simplify-ignored-prefixes subject))
2975 (setq subject (substring subject (match-end 0))))
2976 ;; Remove words in parentheses from end.
2978 (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject)
2979 (setq subject (substring subject 0 (match-beginning 0)))))
2980 ;; Return subject string.
2983 ;; Remove any leading "re:"s, any trailing paren phrases, and simplify
2985 ;; Written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
2986 (defun gnus-simplify-buffer-fuzzy ()
2987 (goto-char (point-min))
2988 (re-search-forward "^[ \t]*\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;][ \t]*" nil t)
2989 (goto-char (match-beginning 0))
2991 (looking-at "^[ \t]*\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;][ \t]*")
2992 (looking-at "^[[].*:[ \t].*[]]$"))
2993 (goto-char (point-min))
2994 (while (re-search-forward "^[ \t]*\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;][ \t]*"
2996 (replace-match "" t t))
2997 (goto-char (point-min))
2998 (while (re-search-forward "^[[].*:[ \t].*[]]$" nil t)
2999 (goto-char (match-end 0))
3002 (progn (goto-char (match-beginning 0)))
3003 (re-search-forward ":"))))
3004 (goto-char (point-min))
3005 (while (re-search-forward "[ \t\n]*[[{(][^()]*[]})][ \t]*$" nil t)
3006 (replace-match "" t t))
3007 (goto-char (point-min))
3008 (while (re-search-forward "[ \t]+" nil t)
3009 (replace-match " " t t))
3010 (goto-char (point-min))
3011 (while (re-search-forward "[ \t]+$" nil t)
3012 (replace-match "" t t))
3013 (goto-char (point-min))
3014 (while (re-search-forward "^[ \t]+" nil t)
3015 (replace-match "" t t))
3016 (goto-char (point-min))
3017 (if gnus-simplify-subject-fuzzy-regexp
3018 (if (listp gnus-simplify-subject-fuzzy-regexp)
3019 (let ((list gnus-simplify-subject-fuzzy-regexp))
3021 (goto-char (point-min))
3022 (while (re-search-forward (car list) nil t)
3023 (replace-match "" t t))
3024 (setq list (cdr list))))
3025 (while (re-search-forward gnus-simplify-subject-fuzzy-regexp nil t)
3026 (replace-match "" t t)))))
3028 (defun gnus-simplify-subject-fuzzy (subject)
3029 "Siplify a subject string fuzzily."
3031 (gnus-set-work-buffer)
3032 (let ((case-fold-search t))
3034 (inline (gnus-simplify-buffer-fuzzy))
3037 ;; Add the current buffer to the list of buffers to be killed on exit.
3038 (defun gnus-add-current-to-buffer-list ()
3039 (or (memq (current-buffer) gnus-buffer-list)
3040 (setq gnus-buffer-list (cons (current-buffer) gnus-buffer-list))))
3042 (defun gnus-string> (s1 s2)
3043 (not (or (string< s1 s2)
3046 ;;; General various misc type functions.
3048 (defun gnus-clear-system ()
3049 "Clear all variables and buffers."
3050 ;; Clear Gnus variables.
3051 (let ((variables gnus-variable-list))
3053 (set (car variables) nil)
3054 (setq variables (cdr variables))))
3055 ;; Clear other internal variables.
3056 (setq gnus-list-of-killed-groups nil
3057 gnus-have-read-active-file nil
3058 gnus-newsrc-alist nil
3059 gnus-newsrc-hashtb nil
3060 gnus-killed-list nil
3061 gnus-zombie-list nil
3062 gnus-killed-hashtb nil
3063 gnus-active-hashtb nil
3064 gnus-moderated-list nil
3065 gnus-description-hashtb nil
3066 gnus-newsgroup-headers nil
3067 gnus-newsgroup-name nil
3068 gnus-server-alist nil
3069 gnus-opened-servers nil
3070 gnus-current-select-method nil)
3071 ;; Reset any score variables.
3072 (and gnus-use-scoring (gnus-score-close))
3073 ;; Kill the startup file.
3074 (and gnus-current-startup-file
3075 (get-file-buffer gnus-current-startup-file)
3076 (kill-buffer (get-file-buffer gnus-current-startup-file)))
3077 ;; Save any cache buffers.
3078 (and gnus-use-cache (gnus-cache-save-buffers))
3079 ;; Clear the dribble buffer.
3080 (gnus-dribble-clear)
3081 ;; Close down NoCeM.
3082 (and gnus-use-nocem (gnus-nocem-close))
3083 ;; Shut down the demons.
3084 (and gnus-use-demon (gnus-demon-cancel))
3085 ;; Kill global KILL file buffer.
3086 (if (get-file-buffer (gnus-newsgroup-kill-file nil))
3087 (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))
3088 (gnus-kill-buffer nntp-server-buffer)
3090 (and gnus-keep-backlog (gnus-backlog-shutdown))
3091 ;; Kill Gnus buffers.
3092 (while gnus-buffer-list
3093 (gnus-kill-buffer (car gnus-buffer-list))
3094 (setq gnus-buffer-list (cdr gnus-buffer-list))))
3096 (defun gnus-windows-old-to-new (setting)
3097 ;; First we take care of the really, really old Gnus 3 actions.
3098 (if (symbolp setting)
3100 (cond ((memq setting '(SelectArticle))
3102 ((memq setting '(SelectSubject ExpandSubject))
3104 ((memq setting '(SelectNewsgroup ExitNewsgroup))
3107 (if (or (listp setting)
3108 (not (and gnus-window-configuration
3109 (memq setting '(group summary article)))))
3111 (let* ((setting (if (eq setting 'group)
3112 (if (assq 'newsgroup gnus-window-configuration)
3114 'newsgroups) setting))
3115 (elem (car (cdr (assq setting gnus-window-configuration))))
3116 (total (apply '+ elem))
3117 (types '(group summary article))
3118 (pbuf (if (eq setting 'newsgroups) 'group 'summary))
3123 (or (not (numberp (nth i elem)))
3124 (zerop (nth i elem))
3126 (setq perc (/ (float (nth 0 elem)) total))
3127 (setq out (cons (if (eq pbuf (nth i types))
3128 (vector (nth i types) perc 'point)
3129 (vector (nth i types) perc))
3132 (list (nreverse out)))))
3134 (defun gnus-add-configuration (conf)
3135 "Add the window configuration CONF to `gnus-buffer-configuration'."
3136 (setq gnus-buffer-configuration
3137 (cons conf (delq (assq (car conf) gnus-buffer-configuration)
3138 gnus-buffer-configuration))))
3140 (defvar gnus-frame-list nil)
3142 (defun gnus-configure-frame (split &optional window)
3143 "Split WINDOW according to SPLIT."
3145 (setq window (get-buffer-window (current-buffer))))
3146 (select-window window)
3147 ;; This might be an old-stylee buffer config.
3148 (when (vectorp split)
3149 (setq split (append split nil)))
3150 (when (or (consp (car split))
3151 (vectorp (car split)))
3153 (push 'vertical split))
3154 ;; The SPLIT might be something that is to be evaled to
3155 ;; return a new SPLIT.
3156 (while (and (not (assq (car split) gnus-window-to-buffer))
3157 (gnus-functionp (car split)))
3158 (setq split (eval split)))
3159 (let* ((type (car split))
3161 (len (if (eq type 'horizontal) (window-width) (window-height)))
3163 (window-min-width (or gnus-window-min-width window-min-width))
3164 (window-min-height (or gnus-window-min-height window-min-height))
3165 s result new-win rest comp-subs size sub)
3167 ;; Nothing to do here.
3169 ;; Don't switch buffers.
3171 (and (memq 'point split) window))
3172 ;; This is a buffer to be selected.
3173 ((not (memq type '(frame horizontal vertical)))
3174 (let ((buffer (cond ((stringp type) type)
3175 (t (cdr (assq type gnus-window-to-buffer)))))
3178 (error "Illegal buffer type: %s" type))
3179 (unless (setq buf (get-buffer (if (symbolp buffer)
3180 (symbol-value buffer) buffer)))
3181 (setq buf (get-buffer-create (if (symbolp buffer)
3182 (symbol-value buffer) buffer))))
3183 (switch-to-buffer buf)
3184 ;; We return the window if it has the `point' spec.
3185 (and (memq 'point split) window)))
3186 ;; This is a frame split.
3188 (unless gnus-frame-list
3189 (setq gnus-frame-list (list (window-frame
3190 (get-buffer-window (current-buffer))))))
3192 params frame fresult)
3193 (while (< i (length subs))
3194 ;; Frame parameter is gotten from the sub-split.
3195 (setq params (cadr (elt subs i)))
3196 ;; It should be a list.
3197 (unless (listp params)
3199 ;; Create a new frame?
3200 (unless (setq frame (elt gnus-frame-list i))
3201 (nconc gnus-frame-list (list (setq frame (make-frame params)))))
3202 ;; Is the old frame still alive?
3203 (unless (frame-live-p frame)
3204 (setcar (nthcdr i gnus-frame-list)
3205 (setq frame (make-frame params))))
3206 ;; Select the frame in question and do more splits there.
3207 (select-frame frame)
3208 (setq fresult (or (gnus-configure-frame (elt subs i)) fresult))
3210 ;; Select the frame that has the selected buffer.
3212 (select-frame (window-frame fresult)))))
3213 ;; This is a normal split.
3215 (when (> (length subs) 0)
3216 ;; First we have to compute the sizes of all new windows.
3218 (setq sub (append (pop subs) nil))
3219 (while (and (not (assq (car sub) gnus-window-to-buffer))
3220 (gnus-functionp (car sub)))
3221 (setq sub (eval sub)))
3223 (push sub comp-subs)
3224 (setq size (cadar comp-subs))
3225 (cond ((equal size 1.0)
3226 (setq rest (car comp-subs))
3229 (setq s (floor (* size len))))
3233 (error "Illegal size: %s" size)))
3234 ;; Try to make sure that we are inside the safe limits.
3236 ((eq type 'horizontal)
3237 (setq s (max s window-min-width)))
3238 ((eq type 'vertical)
3239 (setq s (max s window-min-height))))
3240 (setcar (cdar comp-subs) s)
3242 ;; Take care of the "1.0" spec.
3244 (setcar (cdr rest) (- len total))
3245 (error "No 1.0 specs in %s" split))
3246 ;; The we do the actual splitting in a nice recursive
3248 (setq comp-subs (nreverse comp-subs))
3250 (if (null (cdr comp-subs))
3251 (setq new-win window)
3253 (split-window window (cadar comp-subs)
3254 (eq type 'horizontal))))
3255 (setq result (or (gnus-configure-frame
3256 (car comp-subs) window) result))
3257 (select-window new-win)
3258 (setq window new-win)
3259 (setq comp-subs (cdr comp-subs))))
3260 ;; Return the proper window, if any.
3262 (select-window result))))))
3264 (defvar gnus-frame-split-p nil)
3266 (defun gnus-configure-windows (setting &optional force)
3267 (setq setting (gnus-windows-old-to-new setting))
3268 (let ((split (if (symbolp setting)
3269 (car (cdr (assq setting gnus-buffer-configuration)))
3271 (in-buf (current-buffer))
3272 rule val w height hor ohor heights sub jump-buffer
3273 rel total to-buf all-visible)
3275 (setq gnus-frame-split-p nil)
3278 (error "No such setting: %s" setting))
3280 (if (and (not force)
3281 (setq all-visible (gnus-all-windows-visible-p split)))
3282 ;; All the windows mentioned are already visible, so we just
3283 ;; put point in the assigned buffer, and do not touch the
3285 (select-window all-visible)
3287 ;; Either remove all windows or just remove all Gnus windows.
3288 (let ((frame (selected-frame)))
3290 (if gnus-use-full-window
3291 ;; We want to remove all other windows.
3292 (if (not gnus-frame-split-p)
3293 ;; This is not a `frame' split, so we ignore the
3295 (delete-other-windows)
3296 ;; This is a `frame' split, so we delete all windows
3300 (unless (eq (cdr (assq 'minibuffer
3301 (frame-parameters frame)))
3303 (select-frame frame)
3304 (delete-other-windows)))
3306 ;; Just remove some windows.
3307 (gnus-remove-some-windows)
3308 (switch-to-buffer nntp-server-buffer))
3309 (select-frame frame)))
3311 (switch-to-buffer nntp-server-buffer)
3312 (gnus-configure-frame split (get-buffer-window (current-buffer))))))
3314 (defun gnus-all-windows-visible-p (split)
3315 (when (vectorp split)
3316 (setq split (append split nil)))
3317 (when (or (consp (car split))
3318 (vectorp (car split)))
3320 (push 'vertical split))
3321 ;; The SPLIT might be something that is to be evaled to
3322 ;; return a new SPLIT.
3323 (while (and (not (assq (car split) gnus-window-to-buffer))
3324 (gnus-functionp (car split)))
3325 (setq split (eval split)))
3326 (let* ((type (elt split 0)))
3330 ((not (or (eq type 'horizontal) (eq type 'vertical) (eq type 'frame)))
3331 (let ((buffer (cond ((stringp type) type)
3332 (t (cdr (assq type gnus-window-to-buffer)))))
3335 (error "Illegal buffer type: %s" type))
3336 (when (setq buf (get-buffer (if (symbolp buffer) (symbol-value buffer)
3338 (setq win (get-buffer-window buf t)))
3340 (if (memq 'point split)
3344 (when (eq type 'frame)
3345 (setq gnus-frame-split-p t))
3346 (let ((n (mapcar 'gnus-all-windows-visible-p
3350 (cond ((windowp (car n))
3357 (defun gnus-window-top-edge (&optional window)
3358 (nth 1 (window-edges window)))
3360 (defun gnus-remove-some-windows ()
3361 (let ((buffers gnus-window-to-buffer)
3362 buf bufs lowest-buf lowest)
3364 ;; Remove windows on all known Gnus buffers.
3366 (setq buf (cdr (car buffers)))
3368 (setq buf (and (boundp buf) (symbol-value buf))))
3370 (get-buffer-window buf)
3372 (setq bufs (cons buf bufs))
3374 (if (or (not lowest)
3375 (< (gnus-window-top-edge) lowest))
3377 (setq lowest (gnus-window-top-edge))
3378 (setq lowest-buf buf)))))
3379 (setq buffers (cdr buffers)))
3380 ;; Remove windows on *all* summary buffers.
3384 (let ((buf (window-buffer win)))
3385 (if (string-match "^\\*Summary" (buffer-name buf))
3387 (setq bufs (cons buf bufs))
3389 (if (or (not lowest)
3390 (< (gnus-window-top-edge) lowest))
3392 (setq lowest-buf buf)
3393 (setq lowest (gnus-window-top-edge))))))))))
3396 (pop-to-buffer lowest-buf)
3397 (switch-to-buffer nntp-server-buffer)))
3399 (and (not (eq (car bufs) lowest-buf))
3400 (delete-windows-on (car bufs)))
3401 (setq bufs (cdr bufs))))))
3403 (defun gnus-version ()
3404 "Version numbers of this version of Gnus."
3406 (let ((methods gnus-valid-select-methods)
3409 ;; Go through all the legal select methods and add their version
3410 ;; numbers to the total version string. Only the backends that are
3411 ;; currently in use will have their message numbers taken into
3414 (setq meth (intern (concat (car (car methods)) "-version")))
3416 (stringp (symbol-value meth))
3417 (setq mess (concat mess "; " (symbol-value meth))))
3418 (setq methods (cdr methods)))
3419 (gnus-message 2 mess)))
3421 (defun gnus-info-find-node ()
3422 "Find Info documentation of Gnus."
3424 ;; Enlarge info window if needed.
3425 (let ((mode major-mode)
3427 (Info-goto-node (car (cdr (assq mode gnus-info-nodes))))
3428 (setq gnus-info-buffer (current-buffer))
3429 (gnus-configure-windows 'info)))
3431 (defun gnus-days-between (date1 date2)
3432 ;; Return the number of days between date1 and date2.
3433 (- (gnus-day-number date1) (gnus-day-number date2)))
3435 (defun gnus-day-number (date)
3436 (let ((dat (mapcar (lambda (s) (and s (string-to-int s)) )
3437 (timezone-parse-date date))))
3438 (timezone-absolute-from-gregorian
3439 (nth 1 dat) (nth 2 dat) (car dat))))
3441 (defun gnus-encode-date (date)
3442 "Convert DATE to internal time."
3443 (let* ((parse (timezone-parse-date date))
3444 (date (mapcar (lambda (d) (and d (string-to-int d))) parse))
3445 (time (mapcar 'string-to-int (timezone-parse-time (aref parse 3)))))
3446 (encode-time (caddr time) (cadr time) (car time)
3447 (caddr date) (cadr date) (car date) (nth 4 date))))
3449 (defun gnus-time-minus (t1 t2)
3450 "Subtract two internal times."
3451 (let ((borrow (< (cadr t1) (cadr t2))))
3452 (list (- (car t1) (car t2) (if borrow 1 0))
3453 (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
3455 (defun gnus-file-newer-than (file date)
3456 (let ((fdate (nth 5 (file-attributes file))))
3457 (or (> (car fdate) (car date))
3458 (and (= (car fdate) (car date))
3459 (> (nth 1 fdate) (nth 1 date))))))
3461 (defmacro gnus-define-keys (keymap &rest plist)
3462 "Define all keys in PLIST in KEYMAP."
3463 `(gnus-define-keys-1 (quote ,keymap) (quote ,plist)))
3465 (defun gnus-define-keys-1 (keymap plist)
3467 (error "Can't set keys in a null keymap"))
3468 (cond ((symbolp keymap)
3469 (setq keymap (symbol-value keymap)))
3471 (set (car keymap) nil)
3472 (define-prefix-command (car keymap))
3473 (define-key (symbol-value (caddr keymap)) (cadr keymap) (car keymap))
3474 (setq keymap (symbol-value (car keymap)))))
3477 (when (symbolp (setq key (pop plist)))
3478 (setq key (symbol-value key)))
3479 (define-key keymap key (pop plist)))))
3481 (defun gnus-group-read-only-p (&optional group)
3482 "Check whether GROUP supports editing or not.
3483 If GROUP is nil, `gnus-newsgroup-name' will be checked instead. Note
3484 that that variable is buffer-local to the summary buffers."
3485 (let ((group (or group gnus-newsgroup-name)))
3486 (not (gnus-check-backend-function 'request-replace-article group))))
3488 (defun gnus-group-total-expirable-p (group)
3489 "Check whether GROUP is total-expirable or not."
3490 (let ((params (gnus-info-params (gnus-get-info group))))
3491 (or (memq 'total-expire params)
3492 (cdr (assq 'total-expire params)) ; (total-expire . t)
3493 (and gnus-total-expirable-newsgroups ; Check var.
3494 (string-match gnus-total-expirable-newsgroups group)))))
3496 (defun gnus-group-auto-expirable-p (group)
3497 "Check whether GROUP is total-expirable or not."
3498 (let ((params (gnus-info-params (gnus-get-info group))))
3499 (or (memq 'auto-expire params)
3500 (cdr (assq 'auto-expire params)) ; (auto-expire . t)
3501 (and gnus-auto-expirable-newsgroups ; Check var.
3502 (string-match gnus-auto-expirable-newsgroups group)))))
3504 (defun gnus-virtual-group-p (group)
3505 "Say whether GROUP is virtual or not."
3506 (memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group)))
3507 gnus-valid-select-methods)))
3509 (defsubst gnus-simplify-subject-fully (subject)
3510 "Simplify a subject string according to the user's wishes."
3512 ((null gnus-summary-gather-subject-limit)
3513 (gnus-simplify-subject-re subject))
3514 ((eq gnus-summary-gather-subject-limit 'fuzzy)
3515 (gnus-simplify-subject-fuzzy subject))
3516 ((numberp gnus-summary-gather-subject-limit)
3517 (gnus-limit-string (gnus-simplify-subject-re subject)
3518 gnus-summary-gather-subject-limit))
3522 (defsubst gnus-subject-equal (s1 s2 &optional simple-first)
3523 "Check whether two subjects are equal. If optional argument
3524 simple-first is t, first argument is already simplified."
3526 ((null simple-first)
3527 (equal (gnus-simplify-subject-fully s1)
3528 (gnus-simplify-subject-fully s2)))
3531 (gnus-simplify-subject-fully s2)))))
3533 ;; Returns a list of writable groups.
3534 (defun gnus-writable-groups ()
3535 (let ((alist gnus-newsrc-alist)
3538 (or (gnus-group-read-only-p (car (car alist)))
3539 (setq groups (cons (car (car alist)) groups)))
3540 (setq alist (cdr alist)))
3543 ;; Two silly functions to ensure that all `y-or-n-p' questions clear
3545 (defun gnus-y-or-n-p (prompt)
3550 (defun gnus-yes-or-no-p (prompt)
3552 (yes-or-no-p prompt)
3555 ;; Check whether to use long file names.
3556 (defun gnus-use-long-file-name (symbol)
3557 ;; The variable has to be set...
3558 (and gnus-use-long-file-name
3559 ;; If it isn't a list, then we return t.
3560 (or (not (listp gnus-use-long-file-name))
3561 ;; If it is a list, and the list contains `symbol', we
3563 (not (memq symbol gnus-use-long-file-name)))))
3565 ;; I suspect there's a better way, but I haven't taken the time to do
3566 ;; it yet. -erik selberg@cs.washington.edu
3567 (defun gnus-dd-mmm (messy-date)
3568 "Return a string like DD-MMM from a big messy string"
3569 (let ((datevec (timezone-parse-date messy-date)))
3571 (or (aref datevec 2) "??")
3574 (nth (1- (string-to-number (aref datevec 1)))
3575 timezone-months-assoc))
3578 ;; Make a hash table (default and minimum size is 255).
3579 ;; Optional argument HASHSIZE specifies the table size.
3580 (defun gnus-make-hashtable (&optional hashsize)
3581 (make-vector (if hashsize (max (gnus-create-hash-size hashsize) 255) 255) 0))
3583 ;; Make a number that is suitable for hashing; bigger than MIN and one
3585 (defun gnus-create-hash-size (min)
3591 ;; Show message if message has a lower level than `gnus-verbose'.
3592 ;; Guideline for numbers:
3593 ;; 1 - error messages, 3 - non-serious error messages, 5 - messages
3594 ;; for things that take a long time, 7 - not very important messages
3595 ;; on stuff, 9 - messages inside loops.
3596 (defun gnus-message (level &rest args)
3597 (if (<= level gnus-verbose)
3598 (apply 'message args)
3599 ;; We have to do this format thingy here even if the result isn't
3600 ;; shown - the return value has to be the same as the return value
3602 (apply 'format args)))
3604 (defun gnus-functionp (form)
3605 "Return non-nil if FORM is funcallable."
3606 (or (and (symbolp form) (fboundp form))
3607 (and (listp form) (eq (car form) 'lambda))))
3609 ;; Generate a unique new group name.
3610 (defun gnus-generate-new-group-name (leaf)
3613 (while (gnus-gethash name gnus-newsrc-hashtb)
3614 (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">")))
3617 ;; Find out whether the gnus-visual TYPE is wanted.
3618 (defun gnus-visual-p (&optional type class)
3619 (and gnus-visual ; Has to be non-nil, at least.
3620 (if (not type) ; We don't care about type.
3622 (if (listp gnus-visual) ; It's a list, so we check it.
3623 (or (memq type gnus-visual)
3624 (memq class gnus-visual))
3627 (defun gnus-parent-id (references)
3628 "Return the last Message-ID in REFERENCES."
3629 (when (and references
3630 (string-match "\\(<[^<>]+>\\)[ \t\n]*\\'" references))
3631 (substring references (match-beginning 1) (match-end 1))))
3633 (defun gnus-split-references (references)
3634 "Return a list of Message-IDs in REFERENCES."
3637 (while (string-match "<[^>]+>" references beg)
3638 (push (substring references (match-beginning 0) (setq beg (match-end 0)))
3642 (defun gnus-ephemeral-group-p (group)
3643 "Say whether GROUP is ephemeral or not."
3644 (assoc 'quit-config (gnus-find-method-for-group group)))
3646 (defun gnus-group-quit-config (group)
3647 "Return the quit-config of GROUP."
3648 (nth 1 (assoc 'quit-config (gnus-find-method-for-group group))))
3650 (defun gnus-simplify-mode-line ()
3651 "Make mode lines a bit simpler."
3652 (setq mode-line-modified "-- ")
3653 (when (listp mode-line-format)
3654 (make-local-variable 'mode-line-format)
3655 (setq mode-line-format (copy-sequence mode-line-format))
3656 (when (equal (nth 3 mode-line-format) " ")
3657 (setcar (nthcdr 3 mode-line-format) " "))))
3659 ;;; List and range functions
3661 (defun gnus-last-element (list)
3662 "Return last element of LIST."
3664 (setq list (cdr list)))
3667 (defun gnus-copy-sequence (list)
3668 "Do a complete, total copy of a list."
3669 (if (and (consp list) (not (consp (cdr list))))
3670 (cons (car list) (cdr list))
3671 (mapcar (lambda (elem) (if (consp elem)
3672 (if (consp (cdr elem))
3673 (gnus-copy-sequence elem)
3674 (cons (car elem) (cdr elem)))
3678 (defun gnus-set-difference (list1 list2)
3679 "Return a list of elements of LIST1 that do not appear in LIST2."
3680 (let ((list1 (copy-sequence list1)))
3682 (setq list1 (delq (car list2) list1))
3683 (setq list2 (cdr list2)))
3686 (defun gnus-sorted-complement (list1 list2)
3687 "Return a list of elements of LIST1 that do not appear in LIST2.
3688 Both lists have to be sorted over <."
3690 (if (or (null list1) (null list2))
3692 (while (and list1 list2)
3693 (cond ((= (car list1) (car list2))
3694 (setq list1 (cdr list1)
3696 ((< (car list1) (car list2))
3697 (setq out (cons (car list1) out))
3698 (setq list1 (cdr list1)))
3700 (setq out (cons (car list2) out))
3701 (setq list2 (cdr list2)))))
3702 (nconc (nreverse out) (or list1 list2)))))
3704 (defun gnus-intersection (list1 list2)
3707 (if (memq (car list2) list1)
3708 (setq result (cons (car list2) result)))
3709 (setq list2 (cdr list2)))
3712 (defun gnus-sorted-intersection (list1 list2)
3713 ;; LIST1 and LIST2 have to be sorted over <.
3715 (while (and list1 list2)
3716 (cond ((= (car list1) (car list2))
3717 (setq out (cons (car list1) out)
3720 ((< (car list1) (car list2))
3721 (setq list1 (cdr list1)))
3723 (setq list2 (cdr list2)))))
3726 (defun gnus-set-sorted-intersection (list1 list2)
3727 ;; LIST1 and LIST2 have to be sorted over <.
3728 ;; This function modifies LIST1.
3729 (let* ((top (cons nil list1))
3731 (while (and list1 list2)
3732 (cond ((= (car list1) (car list2))
3736 ((< (car list1) (car list2))
3737 (setcdr prev (cdr list1))
3738 (setq list1 (cdr list1)))
3740 (setq list2 (cdr list2)))))
3744 (defun gnus-compress-sequence (numbers &optional always-list)
3745 "Convert list of numbers to a list of ranges or a single range.
3746 If ALWAYS-LIST is non-nil, this function will always release a list of
3748 (let* ((first (car numbers))
3749 (last (car numbers))
3753 (if (not (listp (cdr numbers)))
3756 (cond ((= last (car numbers)) nil) ;Omit duplicated number
3757 ((= (1+ last) (car numbers)) ;Still in sequence
3758 (setq last (car numbers)))
3759 (t ;End of one sequence
3761 (cons (if (= first last) first
3762 (cons first last)) result))
3763 (setq first (car numbers))
3764 (setq last (car numbers))))
3765 (setq numbers (cdr numbers)))
3766 (if (and (not always-list) (null result))
3767 (if (= first last) (list first) (cons first last))
3768 (nreverse (cons (if (= first last) first (cons first last))
3771 (defalias 'gnus-uncompress-sequence 'gnus-uncompress-range)
3772 (defun gnus-uncompress-range (ranges)
3773 "Expand a list of ranges into a list of numbers.
3774 RANGES is either a single range on the form `(num . num)' or a list of
3776 (let (first last result)
3780 ((not (listp (cdr ranges)))
3781 (setq first (car ranges))
3782 (setq last (cdr ranges))
3783 (while (<= first last)
3784 (setq result (cons first result))
3785 (setq first (1+ first)))
3789 (if (atom (car ranges))
3790 (if (numberp (car ranges))
3791 (setq result (cons (car ranges) result)))
3792 (setq first (car (car ranges)))
3793 (setq last (cdr (car ranges)))
3794 (while (<= first last)
3795 (setq result (cons first result))
3796 (setq first (1+ first))))
3797 (setq ranges (cdr ranges)))
3798 (nreverse result)))))
3800 (defun gnus-add-to-range (ranges list)
3801 "Return a list of ranges that has all articles from both RANGES and LIST.
3802 Note: LIST has to be sorted over `<'."
3804 (gnus-compress-sequence list t)
3805 (setq list (copy-sequence list))
3806 (or (listp (cdr ranges))
3807 (setq ranges (list ranges)))
3809 ilist lowest highest temp)
3810 (while (and ranges list)
3812 (setq lowest (or (and (atom (car ranges)) (car ranges))
3813 (car (car ranges))))
3814 (while (and list (cdr list) (< (car (cdr list)) lowest))
3815 (setq list (cdr list)))
3816 (if (< (car ilist) lowest)
3819 (setq list (cdr list))
3821 (setq out (nconc (gnus-compress-sequence ilist t) out))))
3822 (setq highest (or (and (atom (car ranges)) (car ranges))
3823 (cdr (car ranges))))
3824 (while (and list (<= (car list) highest))
3825 (setq list (cdr list)))
3826 (setq ranges (cdr ranges)))
3828 (setq out (nconc (gnus-compress-sequence list t) out)))
3829 (setq out (sort out (lambda (r1 r2)
3830 (< (or (and (atom r1) r1) (car r1))
3831 (or (and (atom r2) r2) (car r2))))))
3834 (if (atom (car ranges))
3836 (if (atom (car (cdr ranges)))
3837 (if (= (1+ (car ranges)) (car (cdr ranges)))
3839 (setcar ranges (cons (car ranges)
3840 (car (cdr ranges))))
3841 (setcdr ranges (cdr (cdr ranges)))))
3842 (if (= (1+ (car ranges)) (car (car (cdr ranges))))
3844 (setcar (car (cdr ranges)) (car ranges))
3845 (setcar ranges (car (cdr ranges)))
3846 (setcdr ranges (cdr (cdr ranges)))))))
3848 (if (atom (car (cdr ranges)))
3849 (if (= (1+ (cdr (car ranges))) (car (cdr ranges)))
3851 (setcdr (car ranges) (car (cdr ranges)))
3852 (setcdr ranges (cdr (cdr ranges)))))
3853 (if (= (1+ (cdr (car ranges))) (car (car (cdr ranges))))
3855 (setcdr (car ranges) (cdr (car (cdr ranges))))
3856 (setcdr ranges (cdr (cdr ranges))))))))
3857 (setq ranges (cdr ranges)))
3860 (defun gnus-remove-from-range (ranges list)
3861 "Return a list of ranges that has all articles from LIST removed from RANGES.
3862 Note: LIST has to be sorted over `<'."
3863 ;; !!! This function shouldn't look like this, but I've got a headache.
3864 (gnus-compress-sequence
3865 (gnus-sorted-complement
3866 (gnus-uncompress-range ranges) list)))
3868 (defun gnus-member-of-range (number ranges)
3869 (if (not (listp (cdr ranges)))
3870 (and (>= number (car ranges))
3871 (<= number (cdr ranges)))
3874 (if (numberp (car ranges))
3875 (>= number (car ranges))
3876 (>= number (car (car ranges))))
3878 (if (if (numberp (car ranges))
3879 (= number (car ranges))
3880 (and (>= number (car (car ranges)))
3881 (<= number (cdr (car ranges)))))
3882 (setq not-stop nil))
3883 (setq ranges (cdr ranges)))
3886 (defun gnus-range-length (range)
3887 "Return the length RANGE would have if uncompressed."
3888 (length (gnus-uncompress-range range)))
3890 (defun gnus-sublist-p (list sublist)
3891 "Test whether all elements in SUBLIST are members of LIST."
3894 (unless (memq (pop sublist) list)
3904 (defvar gnus-group-mode-map nil)
3905 (put 'gnus-group-mode 'mode-class 'special)
3907 (unless gnus-group-mode-map
3908 (setq gnus-group-mode-map (make-keymap))
3909 (suppress-keymap gnus-group-mode-map)
3913 " " gnus-group-read-group
3914 "=" gnus-group-select-group
3915 "\M- " gnus-group-unhidden-select-group
3916 "\r" gnus-group-select-group
3917 "\M-\r" gnus-group-quick-select-group
3918 "j" gnus-group-jump-to-group
3919 "n" gnus-group-next-unread-group
3920 "p" gnus-group-prev-unread-group
3921 "\177" gnus-group-prev-unread-group
3922 "N" gnus-group-next-group
3923 "P" gnus-group-prev-group
3924 "\M-n" gnus-group-next-unread-group-same-level
3925 "\M-p" gnus-group-prev-unread-group-same-level
3926 "," gnus-group-best-unread-group
3927 "." gnus-group-first-unread-group
3928 "u" gnus-group-unsubscribe-current-group
3929 "U" gnus-group-unsubscribe-group
3930 "c" gnus-group-catchup-current
3931 "C" gnus-group-catchup-current-all
3932 "l" gnus-group-list-groups
3933 "L" gnus-group-list-all-groups
3935 "g" gnus-group-get-new-news
3936 "\M-g" gnus-group-get-new-news-this-group
3937 "R" gnus-group-restart
3938 "r" gnus-group-read-init-file
3939 "B" gnus-group-browse-foreign-server
3940 "b" gnus-group-check-bogus-groups
3941 "F" gnus-find-new-newsgroups
3942 "\C-c\C-d" gnus-group-describe-group
3943 "\M-d" gnus-group-describe-all-groups
3944 "\C-c\C-a" gnus-group-apropos
3945 "\C-c\M-\C-a" gnus-group-description-apropos
3946 "a" gnus-group-post-news
3947 "\ek" gnus-group-edit-local-kill
3948 "\eK" gnus-group-edit-global-kill
3949 "\C-k" gnus-group-kill-group
3950 "\C-y" gnus-group-yank-group
3951 "\C-w" gnus-group-kill-region
3952 "\C-x\C-t" gnus-group-transpose-groups
3953 "\C-c\C-l" gnus-group-list-killed
3954 "\C-c\C-x" gnus-group-expire-articles
3955 "\C-c\M-\C-x" gnus-group-expire-all-groups
3957 "s" gnus-group-save-newsrc
3958 "z" gnus-group-suspend
3959 "Z" gnus-group-clear-dribble
3962 "?" gnus-group-describe-briefly
3963 "\C-c\C-i" gnus-info-find-node
3964 "\M-e" gnus-group-edit-group-method
3965 "^" gnus-group-enter-server-mode
3966 gnus-mouse-2 gnus-mouse-pick-group
3967 "<" beginning-of-buffer
3970 "\C-c\C-s" gnus-group-sort-groups
3972 "\C-c\M-g" gnus-activate-all-groups
3973 "\M-&" gnus-group-universal-argument
3974 "#" gnus-group-mark-group
3975 "\M-#" gnus-group-unmark-group)
3978 (gnus-group-mark-map "M" gnus-group-mode-map)
3979 "m" gnus-group-mark-group
3980 "u" gnus-group-unmark-group
3981 "w" gnus-group-mark-region
3982 "m" gnus-group-mark-buffer
3983 "r" gnus-group-mark-regexp
3984 "U" gnus-group-unmark-all-groups)
3987 (gnus-group-group-map "G" gnus-group-mode-map)
3988 "d" gnus-group-make-directory-group
3989 "h" gnus-group-make-help-group
3990 "a" gnus-group-make-archive-group
3991 "k" gnus-group-make-kiboze-group
3992 "m" gnus-group-make-group
3993 "E" gnus-group-edit-group
3994 "e" gnus-group-edit-group-method
3995 "p" gnus-group-edit-group-parameters
3996 "v" gnus-group-add-to-virtual
3997 "V" gnus-group-make-empty-virtual
3998 "D" gnus-group-enter-directory
3999 "f" gnus-group-make-doc-group
4000 "r" gnus-group-rename-group
4001 "\177" gnus-group-delete-group)
4004 (gnus-group-soup-map "s" gnus-group-group-map)
4005 "b" gnus-group-brew-soup
4006 "w" gnus-soup-save-areas
4007 "s" gnus-soup-send-replies
4008 "p" gnus-soup-pack-packet
4009 "r" nnsoup-pack-replies)
4012 (gnus-group-sort-map "S" gnus-group-group-map)
4013 "s" gnus-group-sort-groups
4014 "a" gnus-group-sort-groups-by-alphabet
4015 "u" gnus-group-sort-groups-by-unread
4016 "l" gnus-group-sort-groups-by-level
4017 "v" gnus-group-sort-groups-by-score
4018 "r" gnus-group-sort-groups-by-rank
4019 "m" gnus-group-sort-groups-by-method)
4022 (gnus-group-list-map "A" gnus-group-mode-map)
4023 "k" gnus-group-list-killed
4024 "z" gnus-group-list-zombies
4025 "s" gnus-group-list-groups
4026 "u" gnus-group-list-all-groups
4027 "A" gnus-group-list-active
4028 "a" gnus-group-apropos
4029 "d" gnus-group-description-apropos
4030 "m" gnus-group-list-matching
4031 "M" gnus-group-list-all-matching
4032 "l" gnus-group-list-level)
4035 (gnus-group-score-map "W" gnus-group-mode-map)
4036 "f" gnus-score-flush-cache)
4039 (gnus-group-help-map "H" gnus-group-mode-map)
4040 "f" gnus-group-fetch-faq)
4043 (gnus-group-sub-map "S" gnus-group-mode-map)
4044 "l" gnus-group-set-current-level
4045 "t" gnus-group-unsubscribe-current-group
4046 "s" gnus-group-unsubscribe-group
4047 "k" gnus-group-kill-group
4048 "y" gnus-group-yank-group
4049 "w" gnus-group-kill-region
4050 "\C-k" gnus-group-kill-level
4051 "z" gnus-group-kill-all-zombies))
4053 (defun gnus-group-mode ()
4054 "Major mode for reading news.
4056 All normal editing commands are switched off.
4057 \\<gnus-group-mode-map>
4058 The group buffer lists (some of) the groups available. For instance,
4059 `\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]'
4060 lists all zombie groups.
4062 Groups that are displayed can be entered with `\\[gnus-group-read-group]'. To subscribe
4063 to a group not displayed, type `\\[gnus-group-unsubscribe-group]'.
4065 For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]').
4067 The following commands are available:
4069 \\{gnus-group-mode-map}"
4071 (when (and menu-bar-mode
4072 (gnus-visual-p 'group-menu 'menu))
4073 (gnus-group-make-menu-bar))
4074 (kill-all-local-variables)
4075 (gnus-simplify-mode-line)
4076 (setq major-mode 'gnus-group-mode)
4077 (setq mode-name "Group")
4078 (gnus-group-set-mode-line)
4079 (setq mode-line-process nil)
4080 (use-local-map gnus-group-mode-map)
4081 (buffer-disable-undo (current-buffer))
4082 (setq truncate-lines t)
4083 (setq buffer-read-only t)
4084 (run-hooks 'gnus-group-mode-hook))
4086 (defun gnus-mouse-pick-group (e)
4087 "Enter the group under the mouse pointer."
4090 (gnus-group-read-group nil))
4092 ;; Look at LEVEL and find out what the level is really supposed to be.
4093 ;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens
4094 ;; will depend on whether `gnus-group-use-permanent-levels' is used.
4095 (defun gnus-group-default-level (&optional level number-or-nil)
4097 (gnus-group-use-permanent-levels
4098 (setq gnus-group-default-list-level
4099 (or level gnus-group-default-list-level))
4100 (or gnus-group-default-list-level gnus-level-subscribed))
4104 (or level gnus-group-default-list-level gnus-level-subscribed))))
4107 (defun gnus-slave-no-server (&optional arg)
4108 "Read network news as a slave, without connecting to local server"
4110 (gnus-no-server arg t))
4113 (defun gnus-no-server (&optional arg slave)
4115 If ARG is a positive number, Gnus will use that as the
4116 startup level. If ARG is nil, Gnus will be started at level 2.
4117 If ARG is non-nil and not a positive number, Gnus will
4118 prompt the user for the name of an NNTP server to use.
4119 As opposed to `gnus', this command will not connect to the local server."
4121 (make-local-variable 'gnus-group-use-permanent-levels)
4122 (setq gnus-group-use-permanent-levels t)
4123 (gnus (or arg (1- gnus-level-default-subscribed)) t slave))
4126 (defun gnus-slave (&optional arg)
4127 "Read news as a slave."
4129 (gnus arg nil 'slave))
4132 (defun gnus-other-frame (&optional arg)
4133 "Pop up a frame to read news."
4135 (if (get-buffer gnus-group-buffer)
4136 (let ((pop-up-frames t))
4138 (select-frame (make-frame))
4142 (defun gnus (&optional arg dont-connect slave)
4144 If ARG is non-nil and a positive number, Gnus will use that as the
4145 startup level. If ARG is non-nil and not a positive number, Gnus will
4146 prompt the user for the name of an NNTP server to use."
4149 (if (get-buffer gnus-group-buffer)
4151 (switch-to-buffer gnus-group-buffer)
4152 (gnus-group-get-new-news))
4155 (nnheader-init-server-buffer)
4156 (gnus-read-init-file)
4157 (setq gnus-slave slave)
4159 (gnus-group-setup-buffer)
4160 (let ((buffer-read-only nil))
4162 (if (not gnus-inhibit-startup-message)
4164 (gnus-group-startup-message)
4167 (let ((level (and (numberp arg) (> arg 0) arg))
4173 (gnus-start-news-server (and arg (not level))))))
4174 (if (and (not dont-connect)
4177 (run-hooks 'gnus-startup-hook)
4178 ;; NNTP server is successfully open.
4180 ;; Find the current startup file name.
4181 (setq gnus-current-startup-file
4182 (gnus-make-newsrc-file gnus-startup-file))
4184 ;; Read the dribble file.
4185 (and (or gnus-slave gnus-use-dribble-file) (gnus-dribble-read-file))
4187 (gnus-summary-make-display-table)
4188 ;; Do the actual startup.
4189 (gnus-setup-news nil level)
4190 ;; Generate the group buffer.
4191 (gnus-group-list-groups level)
4192 (gnus-group-first-unread-group)
4193 (gnus-configure-windows 'group)
4194 (gnus-group-set-mode-line))))))
4196 (defun gnus-unload ()
4197 "Unload all Gnus features."
4199 (or (boundp 'load-history)
4200 (error "Sorry, `gnus-unload' is not implemented in this Emacs version."))
4201 (let ((history load-history)
4204 (and (string-match "^\\(gnus\\|nn\\)" (caar history))
4205 (setq feature (cdr (assq 'provide (car history))))
4206 (unload-feature feature 'force))
4207 (setq history (cdr history)))))
4209 (defun gnus-compile ()
4210 "Byte-compile the user-defined format specs."
4212 (let ((entries gnus-format-specs)
4213 entry gnus-tmp-func)
4215 (gnus-message 7 "Compiling format specs...")
4218 (setq entry (pop entries))
4219 (if (eq (car entry) 'version)
4220 (setq gnus-format-specs (delq entry gnus-format-specs))
4221 (when (and (listp (caddr entry))
4222 (not (eq 'byte-code (caaddr entry))))
4223 (fset 'gnus-tmp-func
4224 `(lambda () ,(caddr entry)))
4225 (byte-compile 'gnus-tmp-func)
4226 (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func)))))
4228 (push (cons 'version emacs-version) gnus-format-specs)
4230 (gnus-message 7 "Compiling user specs...done"))))
4232 (defun gnus-indent-rigidly (start end arg)
4233 "Indent rigidly using only spaces and no tabs."
4236 (narrow-to-region start end)
4237 (indent-rigidly start end arg)
4238 (goto-char (point-min))
4239 (while (search-forward "\t" nil t)
4240 (replace-match " " t t)))))
4242 (defun gnus-group-startup-message (&optional x y)
4243 "Insert startup message in current buffer."
4244 ;; Insert the message.
4249 _ ___ __ ___ __ _ ___
4268 ;; And then hack it.
4269 (gnus-indent-rigidly (point-min) (point-max)
4270 (/ (max (- (window-width) (or x 46)) 0) 2))
4271 (goto-char (point-min))
4273 (let* ((pheight (count-lines (point-min) (point-max)))
4274 (wheight (window-height))
4275 (rest (- wheight pheight)))
4276 (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
4278 (goto-char (point-min))
4279 (and (search-forward "Praxis" nil t)
4280 (put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
4281 (goto-char (point-min))
4282 (let* ((mode-string (gnus-group-set-mode-line)))
4283 (setq mode-line-buffer-identification
4284 (list (concat gnus-version (substring (car mode-string) 4))))
4285 (set-buffer-modified-p t)))
4287 (defun gnus-group-setup-buffer ()
4288 (or (get-buffer gnus-group-buffer)
4290 (switch-to-buffer gnus-group-buffer)
4291 (gnus-add-current-to-buffer-list)
4293 (and gnus-carpal (gnus-carpal-setup-buffer 'group)))))
4295 (defun gnus-group-list-groups (&optional level unread lowest)
4296 "List newsgroups with level LEVEL or lower that have unread articles.
4297 Default is all subscribed groups.
4298 If argument UNREAD is non-nil, groups with no unread articles are also
4300 (interactive (list (if current-prefix-arg
4301 (prefix-numeric-value current-prefix-arg)
4303 (gnus-group-default-level nil t)
4304 gnus-group-default-list-level
4305 gnus-level-subscribed))))
4307 (setq level (car gnus-group-list-mode)
4308 unread (cdr gnus-group-list-mode)))
4309 (setq level (gnus-group-default-level level))
4310 (gnus-group-setup-buffer) ;May call from out of group buffer
4311 (gnus-update-format-specifications)
4312 (let ((case-fold-search nil)
4313 (props (text-properties-at (gnus-point-at-bol)))
4314 (group (gnus-group-group-name)))
4315 (funcall gnus-group-prepare-function level unread lowest)
4316 (if (zerop (buffer-size))
4317 (gnus-message 5 gnus-no-groups-message)
4318 (goto-char (point-max))
4319 (when (or (not gnus-group-goto-next-group-function)
4320 (not (funcall gnus-group-goto-next-group-function
4323 ;; Go to the first group with unread articles.
4324 (gnus-group-search-forward t)
4325 ;; Find the right group to put point on. If the current group
4326 ;; has disappeared in the new listing, try to find the next
4327 ;; one. If no next one can be found, just leave point at the
4328 ;; first newsgroup in the buffer.
4329 (if (not (gnus-goto-char
4331 (point-min) (point-max)
4332 'gnus-group (gnus-intern-safe group gnus-active-hashtb))))
4333 (let ((newsrc (cdddr (gnus-gethash group gnus-newsrc-hashtb))))
4335 (not (gnus-goto-char
4337 (point-min) (point-max) 'gnus-group
4339 (car (car newsrc)) gnus-active-hashtb)))))
4340 (setq newsrc (cdr newsrc)))
4341 (or newsrc (progn (goto-char (point-max))
4342 (forward-line -1)))))))
4343 ;; Adjust cursor point.
4344 (gnus-group-position-point))))
4346 (defun gnus-group-list-level (level &optional all)
4347 "List groups on LEVEL.
4348 If ALL (the prefix), also list groups that have no unread articles."
4349 (interactive "nList groups on level: \nP")
4350 (gnus-group-list-groups level all level))
4352 (defun gnus-group-prepare-flat (level &optional all lowest regexp)
4353 "List all newsgroups with unread articles of level LEVEL or lower.
4354 If ALL is non-nil, list groups that have no unread articles.
4355 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.
4356 If REGEXP, only list groups matching REGEXP."
4357 (set-buffer gnus-group-buffer)
4358 (let ((buffer-read-only nil)
4359 (newsrc (cdr gnus-newsrc-alist))
4360 (lowest (or lowest 1))
4361 info clevel unread group params)
4363 (if (< lowest gnus-level-zombie)
4364 ;; List living groups.
4366 (setq info (car newsrc)
4367 group (gnus-info-group info)
4368 params (gnus-info-params info)
4370 unread (car (gnus-gethash group gnus-newsrc-hashtb)))
4371 (and unread ; This group might be bogus
4373 (string-match regexp group))
4374 (<= (setq clevel (gnus-info-level info)) level)
4376 (or all ; We list all groups?
4377 (and gnus-group-list-inactive-groups
4378 (eq unread t)) ; We list unactivated groups
4379 (> unread 0) ; We list groups with unread articles
4380 (and gnus-list-groups-with-ticked-articles
4381 (cdr (assq 'tick (gnus-info-marks info))))
4382 ; And groups with tickeds
4383 ;; Check for permanent visibility.
4384 (and gnus-permanently-visible-groups
4385 (string-match gnus-permanently-visible-groups
4387 (memq 'visible params)
4388 (cdr (assq 'visible params)))
4389 (gnus-group-insert-group-line
4390 group (gnus-info-level info)
4391 (gnus-info-marks info) unread (gnus-info-method info)))))
4393 ;; List dead groups.
4394 (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)
4395 (gnus-group-prepare-flat-list-dead
4396 (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
4397 gnus-level-zombie ?Z
4399 (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)
4400 (gnus-group-prepare-flat-list-dead
4401 (setq gnus-killed-list (sort gnus-killed-list 'string<))
4402 gnus-level-killed ?K regexp))
4404 (gnus-group-set-mode-line)
4405 (setq gnus-group-list-mode (cons level all))
4406 (run-hooks 'gnus-group-prepare-hook)))
4408 (defun gnus-group-prepare-flat-list-dead (groups level mark regexp)
4409 ;; List zombies and killed lists somewhat faster, which was
4410 ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>. It does
4411 ;; this by ignoring the group format specification altogether.
4414 ;; This loop is used when listing groups that match some
4417 (setq group (pop groups))
4418 (when (string-match regexp group)
4419 (add-text-properties
4420 (point) (prog1 (1+ (point))
4421 (insert " " mark " *: " group "\n"))
4422 (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
4424 'gnus-level level))))
4425 ;; This loop is used when listing all groups.
4427 (add-text-properties
4428 (point) (prog1 (1+ (point))
4429 (insert " " mark " *: "
4430 (setq group (pop groups)) "\n"))
4431 (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
4433 'gnus-level level))))))
4435 (defmacro gnus-group-real-name (group)
4436 "Find the real name of a foreign newsgroup."
4437 `(let ((gname ,group))
4438 (if (string-match ":[^:]+$" gname)
4439 (substring gname (1+ (match-beginning 0)))
4442 (defsubst gnus-server-add-address (method)
4443 (let ((method-name (symbol-name (car method))))
4444 (if (and (memq 'address (assoc method-name gnus-valid-select-methods))
4445 (not (assq (intern (concat method-name "-address")) method)))
4446 (append method (list (list (intern (concat method-name "-address"))
4450 (defsubst gnus-server-get-method (group method)
4451 ;; Input either a server name, and extended server name, or a
4452 ;; select method, and return a select method.
4453 (cond ((stringp method)
4454 (gnus-server-to-method method))
4455 ((and (stringp (car method)) group)
4456 (gnus-server-extend-method group method))
4458 (gnus-server-add-address method))))
4460 (defun gnus-server-to-method (server)
4461 "Map virtual server names to select methods."
4462 (or (and (equal server "native") gnus-select-method)
4463 (cdr (assoc server gnus-server-alist))))
4465 (defmacro gnus-server-equal (ss1 ss2)
4466 "Say whether two servers are equal."
4470 (and (= (length s1) (length s2))
4472 (while (and s1 (member (car s1) s2))
4476 (defun gnus-group-prefixed-name (group method)
4477 "Return the whole name from GROUP and METHOD."
4478 (and (stringp method) (setq method (gnus-server-to-method method)))
4479 (concat (format "%s" (car method))
4481 (assoc (format "%s" (car method)) (gnus-methods-using 'address))
4482 (not (string= (nth 1 method) "")))
4483 (concat "+" (nth 1 method)))
4486 (defun gnus-group-real-prefix (group)
4487 "Return the prefix of the current group name."
4488 (if (string-match "^[^:]+:" group)
4489 (substring group 0 (match-end 0))
4492 (defun gnus-group-method-name (group)
4493 "Return the method used for selecting GROUP."
4494 (let ((prefix (gnus-group-real-prefix group)))
4495 (if (equal prefix "")
4497 (if (string-match "^[^\\+]+\\+" prefix)
4498 (list (intern (substring prefix 0 (1- (match-end 0))))
4499 (substring prefix (match-end 0) (1- (length prefix))))
4500 (list (intern (substring prefix 0 (1- (length prefix)))) "")))))
4502 (defsubst gnus-secondary-method-p (method)
4503 "Return whether METHOD is a secondary select method."
4504 (let ((methods gnus-secondary-select-methods)
4505 (gmethod (gnus-server-get-method nil method)))
4507 (not (equal (gnus-server-get-method nil (car methods))
4509 (setq methods (cdr methods)))
4512 (defun gnus-group-foreign-p (group)
4513 "Say whether a group is foreign or not."
4514 (and (not (gnus-group-native-p group))
4515 (not (gnus-group-secondary-p group))))
4517 (defun gnus-group-native-p (group)
4518 "Say whether the group is native or not."
4519 (not (string-match ":" group)))
4521 (defun gnus-group-secondary-p (group)
4522 "Say whether the group is secondary or not."
4523 (gnus-secondary-method-p (gnus-find-method-for-group group)))
4525 (defun gnus-group-get-parameter (group &optional symbol)
4526 "Returns the group parameters for GROUP.
4527 If SYMBOL, return the value of that symbol in the group parameters."
4528 (let ((params (gnus-info-params (gnus-get-info group))))
4530 (gnus-group-parameter-value params symbol)
4533 (defun gnus-group-parameter-value (params symbol)
4534 "Return the value of SYMBOL in group PARAMS."
4535 (or (car (memq symbol params)) ; It's either a simple symbol
4536 (cdr (assq symbol params)))) ; or a cons.
4538 (defun gnus-group-add-parameter (group param)
4539 "Add parameter PARAM to GROUP."
4540 (let ((info (gnus-get-info group)))
4542 () ; This is a dead group. We just ignore it.
4543 ;; Cons the new param to the old one and update.
4544 (gnus-group-set-info (cons param (gnus-info-params info))
4547 (defun gnus-group-add-score (group &optional score)
4548 "Add SCORE to the GROUP score.
4549 If SCORE is nil, add 1 to the score of GROUP."
4550 (let ((info (gnus-get-info group)))
4551 (gnus-info-set-score info (+ (gnus-info-score info) (or score 1)))))
4553 (defun gnus-summary-bubble-group ()
4554 "Increase the score of the current group.
4555 This is a handy function to add to `gnus-summary-exit-hook' to
4556 increase the score of each group you read."
4557 (gnus-group-add-score gnus-newsgroup-name))
4559 (defun gnus-group-set-info (info &optional method-only-group part)
4560 (let* ((entry (gnus-gethash
4561 (or method-only-group (gnus-info-group info))
4562 gnus-newsrc-hashtb))
4564 (info (if method-only-group (nth 2 entry) info)))
4565 (when method-only-group
4567 (error "Trying to change non-existent group %s" method-only-group))
4568 ;; We have received parts of the actual group info - either the
4569 ;; select method or the group parameters. We first check
4570 ;; whether we have to extend the info, and if so, do that.
4571 (let ((len (length info))
4572 (total (if (eq part 'method) 5 6)))
4574 (setcdr (nthcdr (1- len) info)
4575 (make-list (- total len) nil)))
4576 ;; Then we enter the new info.
4577 (setcar (nthcdr (1- total) info) part-info)))
4579 ;; This is a new group, so we just create it.
4581 (set-buffer gnus-group-buffer)
4582 (if (gnus-info-method info)
4583 ;; It's a foreign group...
4584 (gnus-group-make-group
4585 (gnus-group-real-name (gnus-info-group info))
4586 (prin1-to-string (car (gnus-info-method info)))
4587 (nth 1 (gnus-info-method info)))
4588 ;; It's a native group.
4589 (gnus-group-make-group (gnus-info-group info)))
4590 (gnus-message 6 "Note: New group created")
4592 (gnus-gethash (gnus-group-prefixed-name
4593 (gnus-group-real-name (gnus-info-group info))
4594 (or (gnus-info-method info) gnus-select-method))
4595 gnus-newsrc-hashtb))))
4596 ;; Whether it was a new group or not, we now have the entry, so we
4597 ;; can do the update.
4600 (setcar (nthcdr 2 entry) info)
4601 (when (and (not (eq (car entry) t))
4602 (gnus-active (gnus-info-group info)))
4603 (let ((marked (gnus-info-marks info)))
4604 (setcar entry (length (gnus-list-of-unread-articles
4606 (error "No such group: %s" (gnus-info-group info)))))
4608 (defun gnus-group-set-method-info (group select-method)
4609 (gnus-group-set-info select-method group 'method))
4611 (defun gnus-group-set-params-info (group params)
4612 (gnus-group-set-info params group 'params))
4614 (defun gnus-group-update-group-line ()
4615 "Update the current line in the group buffer."
4616 (let* ((buffer-read-only nil)
4617 (group (gnus-group-group-name))
4618 (gnus-group-indentation (gnus-group-group-indentation))
4619 (entry (and group (gnus-gethash group gnus-newsrc-hashtb))))
4621 (not (gnus-ephemeral-group-p group))
4623 (concat "(gnus-group-set-info '"
4624 (prin1-to-string (nth 2 entry)) ")")))
4626 (gnus-group-insert-group-line-info group)
4628 (gnus-group-position-point)))
4630 (defun gnus-group-insert-group-line-info (group)
4631 "Insert GROUP on the current line."
4632 (let ((entry (gnus-gethash group gnus-newsrc-hashtb))
4636 ;; (Un)subscribed group.
4637 (setq info (nth 2 entry))
4638 (gnus-group-insert-group-line
4639 group (gnus-info-level info) (gnus-info-marks info)
4640 (or (car entry) t) (gnus-info-method info)))
4641 ;; This group is dead.
4642 (gnus-group-insert-group-line
4644 (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed)
4646 (if (setq active (gnus-active group))
4647 (- (1+ (cdr active)) (car active)) 0)
4650 (defun gnus-group-insert-group-line
4651 (gnus-tmp-group gnus-tmp-level gnus-tmp-marked number
4653 "Insert a group line in the group buffer."
4654 (let* ((gnus-tmp-active (gnus-active gnus-tmp-group))
4655 (gnus-tmp-number-total
4657 (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active)))
4659 (gnus-tmp-number-of-unread
4660 (if (numberp number) (int-to-string (max 0 number))
4662 (gnus-tmp-number-of-read
4663 (if (numberp number)
4664 (int-to-string (max 0 (- gnus-tmp-number-total number)))
4666 (gnus-tmp-subscribed
4667 (cond ((<= gnus-tmp-level gnus-level-subscribed) ? )
4668 ((<= gnus-tmp-level gnus-level-unsubscribed) ?U)
4669 ((= gnus-tmp-level gnus-level-zombie) ?Z)
4671 (gnus-tmp-qualified-group (gnus-group-real-name gnus-tmp-group))
4672 (gnus-tmp-newsgroup-description
4673 (if gnus-description-hashtb
4674 (or (gnus-gethash gnus-tmp-group gnus-description-hashtb) "")
4677 (if (member gnus-tmp-group gnus-moderated-list) ?m ? ))
4678 (gnus-tmp-moderated-string
4679 (if (eq gnus-tmp-moderated ?m) "(m)" ""))
4681 (gnus-server-get-method gnus-tmp-group gnus-tmp-method))
4682 (gnus-tmp-news-server (or (car (cdr gnus-tmp-method)) ""))
4683 (gnus-tmp-news-method (or (car gnus-tmp-method) ""))
4684 (gnus-tmp-news-method-string
4686 (format "(%s:%s)" (car gnus-tmp-method)
4687 (car (cdr gnus-tmp-method))) ""))
4688 (gnus-tmp-marked-mark
4689 (if (and (numberp number)
4691 (cdr (assq 'tick gnus-tmp-marked)))
4693 (gnus-tmp-process-marked
4694 (if (member gnus-tmp-group gnus-group-marked)
4695 gnus-process-mark ? ))
4696 (buffer-read-only nil)
4697 header gnus-tmp-header) ; passed as parameter to user-funcs.
4699 (add-text-properties
4703 (eval gnus-group-line-format-spec))
4704 `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb)
4705 gnus-unread ,(if (numberp number)
4706 (string-to-int gnus-tmp-number-of-unread)
4708 gnus-marked ,gnus-tmp-marked-mark
4709 gnus-indentation ,gnus-group-indentation
4710 gnus-level ,gnus-tmp-level))
4711 (when (gnus-visual-p 'group-highlight 'highlight)
4713 (run-hooks 'gnus-group-update-hook)
4715 ;; Allow XEmacs to remove front-sticky text properties.
4716 (gnus-group-remove-excess-properties)))
4718 (defun gnus-group-update-group (group &optional visible-only)
4719 "Update all lines where GROUP appear.
4720 If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't
4723 (set-buffer gnus-group-buffer)
4724 ;; The buffer may be narrowed.
4727 (let ((ident (gnus-intern-safe group gnus-active-hashtb))
4729 found buffer-read-only visible)
4730 ;; Enter the current status into the dribble buffer.
4731 (let ((entry (gnus-gethash group gnus-newsrc-hashtb)))
4732 (if (and entry (not (gnus-ephemeral-group-p group)))
4734 (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry))
4736 ;; Find all group instances. If topics are in use, each group
4737 ;; may be listed in more than once.
4738 (while (setq loc (text-property-any
4739 loc (point-max) 'gnus-group ident))
4742 (let ((gnus-group-indentation (gnus-group-group-indentation)))
4744 (gnus-group-insert-group-line-info group))
4745 (setq loc (1+ loc)))
4746 (unless (or found visible-only)
4747 ;; No such line in the buffer, find out where it's supposed to
4748 ;; go, and insert it there (or at the end of the buffer).
4749 (if gnus-goto-missing-group-function
4750 (funcall gnus-goto-missing-group-function group)
4751 (let ((entry (cdr (cdr (gnus-gethash group gnus-newsrc-hashtb)))))
4752 (while (and entry (car entry)
4756 (point-min) (point-max)
4757 'gnus-group (gnus-intern-safe
4759 gnus-active-hashtb)))))
4760 (setq entry (cdr entry)))
4761 (or entry (goto-char (point-max)))))
4762 ;; Finally insert the line.
4763 (let ((gnus-group-indentation (gnus-group-group-indentation)))
4764 (gnus-group-insert-group-line-info group)))
4765 (gnus-group-set-mode-line)))))
4767 (defun gnus-group-set-mode-line ()
4768 (when (memq 'group gnus-updated-mode-lines)
4769 (let* ((gformat (or gnus-group-mode-line-format-spec
4770 (setq gnus-group-mode-line-format-spec
4772 gnus-group-mode-line-format
4773 gnus-group-mode-line-format-alist))))
4774 (gnus-tmp-news-server (car (cdr gnus-select-method)))
4775 (gnus-tmp-news-method (car gnus-select-method))
4777 gnus-tmp-header ;Dummy binding for user-defined formats
4778 ;; Get the resulting string.
4779 (mode-string (eval gformat)))
4780 ;; If the line is too long, we chop it off.
4781 (when (> (length mode-string) max-len)
4782 (setq mode-string (substring mode-string 0 (- max-len 4))))
4784 (setq mode-line-buffer-identification (list mode-string))
4785 (set-buffer-modified-p t)))))
4787 (defun gnus-group-group-name ()
4788 "Get the name of the newsgroup on the current line."
4789 (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group)))
4790 (and group (symbol-name group))))
4792 (defun gnus-group-group-level ()
4793 "Get the level of the newsgroup on the current line."
4794 (get-text-property (gnus-point-at-bol) 'gnus-level))
4796 (defun gnus-group-group-indentation ()
4797 "Get the indentation of the newsgroup on the current line."
4798 (or (get-text-property (gnus-point-at-bol) 'gnus-indentation) ""))
4800 (defun gnus-group-group-unread ()
4801 "Get the number of unread articles of the newsgroup on the current line."
4802 (get-text-property (gnus-point-at-bol) 'gnus-unread))
4804 (defun gnus-group-search-forward (&optional backward all level first-too)
4805 "Find the next newsgroup with unread articles.
4806 If BACKWARD is non-nil, find the previous newsgroup instead.
4807 If ALL is non-nil, just find any newsgroup.
4808 If LEVEL is non-nil, find group with level LEVEL, or higher if no such
4810 If FIRST-TOO, the current line is also eligible as a target."
4811 (let ((way (if backward -1 1))
4812 (low gnus-level-killed)
4815 (if (and backward (progn (beginning-of-line)) (bobp))
4817 (or first-too (forward-line way))
4825 (get-text-property (point) 'gnus-unread)))
4826 (and (numberp unread) (> unread 0)))
4827 (setq lev (get-text-property (point)
4829 (<= lev gnus-level-subscribed)))
4831 (and (setq lev (get-text-property (point)
4840 (zerop (forward-line way)))))
4842 (progn (gnus-group-position-point) t)
4843 (goto-char (or pos beg))
4846 ;;; Gnus group mode commands
4850 (defun gnus-group-mark-group (n &optional unmark no-advance)
4851 "Mark the current group."
4853 (let ((buffer-read-only nil)
4857 (setq group (gnus-group-group-name))
4861 (or (cdr (assq 'process gnus-group-mark-positions)) 2))
4866 (setq gnus-group-marked (delete group gnus-group-marked)))
4868 (setq gnus-group-marked
4869 (cons group (delete group gnus-group-marked))))
4871 (or no-advance (zerop (gnus-group-next-group 1))))
4873 (gnus-summary-position-point)
4876 (defun gnus-group-unmark-group (n)
4877 "Remove the mark from the current group."
4879 (gnus-group-mark-group n 'unmark)
4880 (gnus-group-position-point))
4882 (defun gnus-group-unmark-all-groups ()
4883 "Unmark all groups."
4884 (let ((groups gnus-group-marked))
4887 (gnus-group-remove-mark (pop groups)))))
4888 (gnus-group-position-point))
4890 (defun gnus-group-mark-region (unmark beg end)
4891 "Mark all groups between point and mark.
4892 If UNMARK, remove the mark instead."
4893 (interactive "P\nr")
4894 (let ((num (count-lines beg end)))
4897 (- num (gnus-group-mark-group num unmark)))))
4899 (defun gnus-group-mark-buffer (&optional unmark)
4900 "Mark all groups in the buffer.
4901 If UNMARK, remove the mark instead."
4903 (gnus-group-mark-region unmark (point-min) (point-max)))
4905 (defun gnus-group-mark-regexp (regexp)
4906 "Mark all groups that match some regexp."
4907 (interactive "sMark (regexp): ")
4908 (let ((alist (cdr gnus-newsrc-alist))
4911 (when (string-match regexp (setq group (gnus-info-group (pop alist))))
4912 (gnus-group-set-mark group))))
4913 (gnus-group-position-point))
4915 (defun gnus-group-remove-mark (group)
4916 "Remove the process mark from GROUP and move point there.
4917 Return nil if the group isn't displayed."
4918 (if (gnus-group-goto-group group)
4920 (gnus-group-mark-group 1 'unmark t)
4922 (setq gnus-group-marked
4923 (delete group gnus-group-marked))
4926 (defun gnus-group-set-mark (group)
4927 "Set the process mark on GROUP."
4928 (if (gnus-group-goto-group group)
4930 (gnus-group-mark-group 1 nil t))
4931 (setq gnus-group-marked
4932 (cons group (delete group gnus-group-marked)))))
4934 (defun gnus-group-universal-argument (arg &optional groups func)
4935 "Perform any command on all groups accoring to the process/prefix convention."
4937 (let ((groups (or groups (gnus-group-process-prefix arg)))
4939 (if (eq (setq func (or func
4942 (substitute-command-keys
4943 "\\<gnus-group-mode-map>\\[gnus-group-universal-argument]")))))
4946 (message "Undefined key")
4949 (gnus-group-remove-mark (setq group (pop groups)))
4950 (command-execute func))))
4951 (gnus-group-position-point))
4953 (defun gnus-group-process-prefix (n)
4954 "Return a list of groups to work on.
4955 Take into consideration N (the prefix) and the list of marked groups."
4958 (setq n (prefix-numeric-value n))
4959 ;; There is a prefix, so we return a list of the N next
4961 (let ((way (if (< n 0) -1 1))
4966 (setq group (gnus-group-group-name)))
4967 (setq groups (cons group groups))
4969 (gnus-group-next-group way)))
4971 ((and (boundp 'transient-mark-mode)
4974 ;; Work on the region between point and mark.
4975 (let ((max (max (point) (mark)))
4978 (goto-char (min (point) (mark)))
4981 (push (gnus-group-group-name) groups)
4982 (zerop (gnus-group-next-group 1))
4984 (nreverse groups))))
4986 ;; No prefix, but a list of marked articles.
4987 (reverse gnus-group-marked))
4989 ;; Neither marked articles or a prefix, so we return the
4991 (let ((group (gnus-group-group-name)))