(ido-file-extensions-order): New defcustom.
[bpt/emacs.git] / lisp / gnus / gnus.el
CommitLineData
5e67c784 1;;; gnus.el --- a newsreader for GNU Emacs
23f87bed 2
43273f39 3;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, 1997,
23f87bed 4;; 1998, 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc.
eec82323
LMI
5
6;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
6748645f 7;; Lars Magne Ingebrigtsen <larsi@gnus.org>
eec82323
LMI
8;; Keywords: news, mail
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software; you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation; either version 2, or (at your option)
15;; any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs; see the file COPYING. If not, write to the
24;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25;; Boston, MA 02111-1307, USA.
26
27;;; Commentary:
28
29;;; Code:
30
31(eval '(run-hooks 'gnus-load-hook))
32
a36c8d02 33(eval-when-compile (require 'cl))
23f87bed 34(require 'wid-edit)
16409b0b 35(require 'mm-util)
23f87bed 36(require 'nnheader)
e62e7654 37(autoload 'message-y-or-n-p "message" nil nil 'macro)
a36c8d02 38
eec82323
LMI
39(defgroup gnus nil
40 "The coffee-brewing, all singing, all dancing, kitchen sink newsreader."
41 :group 'news
42 :group 'mail)
43
23f87bed
MB
44(defgroup gnus-format nil
45 "Dealing with formatting issues."
46 :group 'gnus)
47
16409b0b
GM
48(defgroup gnus-charset nil
49 "Group character set issues."
50 :link '(custom-manual "(gnus)Charsets")
51 :version "21.1"
52 :group 'gnus)
53
6748645f
LMI
54(defgroup gnus-cache nil
55 "Cache interface."
23f87bed
MB
56 :link '(custom-manual "(gnus)Article Caching")
57 :group 'gnus)
58
59(defgroup gnus-registry nil
60 "Article Registry."
6748645f
LMI
61 :group 'gnus)
62
eec82323
LMI
63(defgroup gnus-start nil
64 "Starting your favorite newsreader."
65 :group 'gnus)
66
67(defgroup gnus-start-server nil
68 "Server options at startup."
69 :group 'gnus-start)
70
71;; These belong to gnus-group.el.
72(defgroup gnus-group nil
73 "Group buffers."
23f87bed 74 :link '(custom-manual "(gnus)Group Buffer")
eec82323
LMI
75 :group 'gnus)
76
77(defgroup gnus-group-foreign nil
78 "Foreign groups."
79 :link '(custom-manual "(gnus)Foreign Groups")
80 :group 'gnus-group)
81
82(defgroup gnus-group-new nil
83 "Automatic subscription of new groups."
84 :group 'gnus-group)
85
86(defgroup gnus-group-levels nil
87 "Group levels."
88 :link '(custom-manual "(gnus)Group Levels")
89 :group 'gnus-group)
90
91(defgroup gnus-group-select nil
92 "Selecting a Group."
93 :link '(custom-manual "(gnus)Selecting a Group")
94 :group 'gnus-group)
95
96(defgroup gnus-group-listing nil
97 "Showing slices of the group list."
98 :link '(custom-manual "(gnus)Listing Groups")
99 :group 'gnus-group)
100
101(defgroup gnus-group-visual nil
102 "Sorting the group buffer."
103 :link '(custom-manual "(gnus)Group Buffer Format")
104 :group 'gnus-group
105 :group 'gnus-visual)
106
107(defgroup gnus-group-various nil
108 "Various group options."
109 :link '(custom-manual "(gnus)Scanning New Messages")
110 :group 'gnus-group)
111
112;; These belong to gnus-sum.el.
113(defgroup gnus-summary nil
114 "Summary buffers."
23f87bed 115 :link '(custom-manual "(gnus)Summary Buffer")
eec82323
LMI
116 :group 'gnus)
117
118(defgroup gnus-summary-exit nil
119 "Leaving summary buffers."
120 :link '(custom-manual "(gnus)Exiting the Summary Buffer")
121 :group 'gnus-summary)
122
123(defgroup gnus-summary-marks nil
124 "Marks used in summary buffers."
125 :link '(custom-manual "(gnus)Marking Articles")
126 :group 'gnus-summary)
127
128(defgroup gnus-thread nil
129 "Ordering articles according to replies."
130 :link '(custom-manual "(gnus)Threading")
131 :group 'gnus-summary)
132
133(defgroup gnus-summary-format nil
134 "Formatting of the summary buffer."
135 :link '(custom-manual "(gnus)Summary Buffer Format")
136 :group 'gnus-summary)
137
138(defgroup gnus-summary-choose nil
139 "Choosing Articles."
140 :link '(custom-manual "(gnus)Choosing Articles")
141 :group 'gnus-summary)
142
143(defgroup gnus-summary-maneuvering nil
144 "Summary movement commands."
145 :link '(custom-manual "(gnus)Summary Maneuvering")
146 :group 'gnus-summary)
147
23f87bed
MB
148(defgroup gnus-picon nil
149 "Show pictures of people, domains, and newsgroups."
150 :group 'gnus-visual)
151
eec82323
LMI
152(defgroup gnus-summary-mail nil
153 "Mail group commands."
154 :link '(custom-manual "(gnus)Mail Group Commands")
155 :group 'gnus-summary)
156
157(defgroup gnus-summary-sort nil
158 "Sorting the summary buffer."
23f87bed 159 :link '(custom-manual "(gnus)Sorting the Summary Buffer")
eec82323
LMI
160 :group 'gnus-summary)
161
162(defgroup gnus-summary-visual nil
163 "Highlighting and menus in the summary buffer."
164 :link '(custom-manual "(gnus)Summary Highlighting")
165 :group 'gnus-visual
166 :group 'gnus-summary)
167
168(defgroup gnus-summary-various nil
169 "Various summary buffer options."
170 :link '(custom-manual "(gnus)Various Summary Stuff")
171 :group 'gnus-summary)
172
a8151ef7
LMI
173(defgroup gnus-summary-pick nil
174 "Pick mode in the summary buffer."
175 :link '(custom-manual "(gnus)Pick and Read")
176 :prefix "gnus-pick-"
177 :group 'gnus-summary)
178
179(defgroup gnus-summary-tree nil
180 "Tree display of threads in the summary buffer."
181 :link '(custom-manual "(gnus)Tree Display")
182 :prefix "gnus-tree-"
183 :group 'gnus-summary)
184
eec82323
LMI
185;; Belongs to gnus-uu.el
186(defgroup gnus-extract-view nil
187 "Viewing extracted files."
188 :link '(custom-manual "(gnus)Viewing Files")
189 :group 'gnus-extract)
190
191;; Belongs to gnus-score.el
192(defgroup gnus-score nil
193 "Score and kill file handling."
194 :group 'gnus)
195
196(defgroup gnus-score-kill nil
197 "Kill files."
198 :group 'gnus-score)
199
200(defgroup gnus-score-adapt nil
201 "Adaptive score files."
202 :group 'gnus-score)
203
204(defgroup gnus-score-default nil
205 "Default values for score files."
206 :group 'gnus-score)
207
208(defgroup gnus-score-expire nil
209 "Expiring score rules."
210 :group 'gnus-score)
211
212(defgroup gnus-score-decay nil
213 "Decaying score rules."
214 :group 'gnus-score)
215
216(defgroup gnus-score-files nil
217 "Score and kill file names."
218 :group 'gnus-score
219 :group 'gnus-files)
220
221(defgroup gnus-score-various nil
222 "Various scoring and killing options."
223 :group 'gnus-score)
224
225;; Other
226(defgroup gnus-visual nil
23f87bed 227 "Options controlling the visual fluff."
eec82323
LMI
228 :group 'gnus
229 :group 'faces)
230
6748645f
LMI
231(defgroup gnus-agent nil
232 "Offline support for Gnus."
233 :group 'gnus)
234
eec82323
LMI
235(defgroup gnus-files nil
236 "Files used by Gnus."
237 :group 'gnus)
238
239(defgroup gnus-dribble-file nil
240 "Auto save file."
241 :link '(custom-manual "(gnus)Auto Save")
242 :group 'gnus-files)
243
244(defgroup gnus-newsrc nil
245 "Storing Gnus state."
246 :group 'gnus-files)
247
248(defgroup gnus-server nil
249 "Options related to newsservers and other servers used by Gnus."
250 :group 'gnus)
251
23f87bed
MB
252(defgroup gnus-server-visual nil
253 "Highlighting and menus in the server buffer."
254 :group 'gnus-visual
255 :group 'gnus-server)
256
eec82323
LMI
257(defgroup gnus-message '((message custom-group))
258 "Composing replies and followups in Gnus."
259 :group 'gnus)
260
261(defgroup gnus-meta nil
23f87bed 262 "Meta variables controlling major portions of Gnus.
eec82323
LMI
263In general, modifying these variables does not take affect until Gnus
264is restarted, and sometimes reloaded."
265 :group 'gnus)
266
267(defgroup gnus-various nil
268 "Other Gnus options."
269 :link '(custom-manual "(gnus)Various Various")
270 :group 'gnus)
271
16409b0b
GM
272(defgroup gnus-mime nil
273 "Variables for controlling the Gnus MIME interface."
274 :group 'gnus)
275
eec82323
LMI
276(defgroup gnus-exit nil
277 "Exiting gnus."
278 :link '(custom-manual "(gnus)Exiting Gnus")
279 :group 'gnus)
280
23f87bed
MB
281(defgroup gnus-fun nil
282 "Frivolous Gnus extensions."
283 :link '(custom-manual "(gnus)Exiting Gnus")
284 :group 'gnus)
285
10b43d7c 286(defconst gnus-version-number "5.11"
eec82323
LMI
287 "Version number for this version of Gnus.")
288
289(defconst gnus-version (format "Gnus v%s" gnus-version-number)
290 "Version string for this version of Gnus.")
291
292(defcustom gnus-inhibit-startup-message nil
293 "If non-nil, the startup message will not be displayed.
294This variable is used before `.gnus.el' is loaded, so it should
295be set in `.emacs' instead."
296 :group 'gnus-start
297 :type 'boolean)
298
299(defcustom gnus-play-startup-jingle nil
300 "If non-nil, play the Gnus jingle at startup."
301 :group 'gnus-start
302 :type 'boolean)
303
23f87bed
MB
304(unless (fboundp 'gnus-group-remove-excess-properties)
305 (defalias 'gnus-group-remove-excess-properties 'ignore))
306
307(unless (fboundp 'gnus-set-text-properties)
308 (defalias 'gnus-set-text-properties 'set-text-properties))
309
eec82323
LMI
310(unless (featurep 'gnus-xmas)
311 (defalias 'gnus-make-overlay 'make-overlay)
6748645f 312 (defalias 'gnus-delete-overlay 'delete-overlay)
eec82323
LMI
313 (defalias 'gnus-overlay-put 'overlay-put)
314 (defalias 'gnus-move-overlay 'move-overlay)
48df946a
DL
315 (defalias 'gnus-overlay-buffer 'overlay-buffer)
316 (defalias 'gnus-overlay-start 'overlay-start)
eec82323
LMI
317 (defalias 'gnus-overlay-end 'overlay-end)
318 (defalias 'gnus-extent-detached-p 'ignore)
319 (defalias 'gnus-extent-start-open 'ignore)
eec82323
LMI
320 (defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window)
321 (defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names)
322 (defalias 'gnus-character-to-event 'identity)
23f87bed 323 (defalias 'gnus-assq-delete-all 'assq-delete-all)
eec82323
LMI
324 (defalias 'gnus-add-text-properties 'add-text-properties)
325 (defalias 'gnus-put-text-property 'put-text-property)
16409b0b
GM
326 (defvar gnus-mode-line-image-cache t)
327 (if (fboundp 'find-image)
328 (defun gnus-mode-line-buffer-identification (line)
329 (let ((str (car-safe line)))
330 (if (and (stringp str)
331 (string-match "^Gnus:" str))
332 (progn (add-text-properties
333 0 5
334 (list 'display
335 (if (eq t gnus-mode-line-image-cache)
336 (setq gnus-mode-line-image-cache
337 (find-image
338 '((:type xpm :file "gnus-pointer.xpm"
e03eed51 339 :ascent center)
16409b0b 340 (:type xbm :file "gnus-pointer.xbm"
e03eed51 341 :ascent center))))
16409b0b 342 gnus-mode-line-image-cache)
23f87bed
MB
343 'help-echo (format
344 "This is %s, %s."
345 gnus-version (gnus-emacs-version)))
16409b0b
GM
346 str)
347 (list str))
348 line)))
349 (defalias 'gnus-mode-line-buffer-identification 'identity))
eec82323 350 (defalias 'gnus-characterp 'numberp)
6748645f
LMI
351 (defalias 'gnus-deactivate-mark 'deactivate-mark)
352 (defalias 'gnus-window-edges 'window-edges)
16409b0b 353 (defalias 'gnus-key-press-event-p 'numberp)
23f87bed
MB
354 ;;(defalias 'gnus-decode-rfc1522 'ignore)
355 )
eec82323 356
eec82323
LMI
357;; We define these group faces here to avoid the display
358;; update forced when creating new faces.
359
360(defface gnus-group-news-1-face
361 '((((class color)
362 (background dark))
23f87bed 363 (:foreground "PaleTurquoise" :bold t))
eec82323
LMI
364 (((class color)
365 (background light))
23f87bed 366 (:foreground "ForestGreen" :bold t))
eec82323
LMI
367 (t
368 ()))
369 "Level 1 newsgroup face.")
370
371(defface gnus-group-news-1-empty-face
372 '((((class color)
373 (background dark))
374 (:foreground "PaleTurquoise"))
375 (((class color)
376 (background light))
377 (:foreground "ForestGreen"))
378 (t
379 ()))
380 "Level 1 empty newsgroup face.")
381
382(defface gnus-group-news-2-face
383 '((((class color)
384 (background dark))
23f87bed 385 (:foreground "turquoise" :bold t))
eec82323
LMI
386 (((class color)
387 (background light))
23f87bed 388 (:foreground "CadetBlue4" :bold t))
eec82323
LMI
389 (t
390 ()))
391 "Level 2 newsgroup face.")
392
393(defface gnus-group-news-2-empty-face
394 '((((class color)
395 (background dark))
396 (:foreground "turquoise"))
397 (((class color)
398 (background light))
399 (:foreground "CadetBlue4"))
400 (t
401 ()))
402 "Level 2 empty newsgroup face.")
403
404(defface gnus-group-news-3-face
405 '((((class color)
406 (background dark))
23f87bed 407 (:bold t))
eec82323
LMI
408 (((class color)
409 (background light))
23f87bed 410 (:bold t))
eec82323
LMI
411 (t
412 ()))
413 "Level 3 newsgroup face.")
414
415(defface gnus-group-news-3-empty-face
416 '((((class color)
417 (background dark))
418 ())
419 (((class color)
420 (background light))
421 ())
422 (t
423 ()))
424 "Level 3 empty newsgroup face.")
425
16409b0b
GM
426(defface gnus-group-news-4-face
427 '((((class color)
428 (background dark))
23f87bed 429 (:bold t))
16409b0b
GM
430 (((class color)
431 (background light))
23f87bed 432 (:bold t))
16409b0b
GM
433 (t
434 ()))
435 "Level 4 newsgroup face.")
436
437(defface gnus-group-news-4-empty-face
438 '((((class color)
439 (background dark))
440 ())
441 (((class color)
442 (background light))
443 ())
444 (t
445 ()))
446 "Level 4 empty newsgroup face.")
447
448(defface gnus-group-news-5-face
449 '((((class color)
450 (background dark))
23f87bed 451 (:bold t))
16409b0b
GM
452 (((class color)
453 (background light))
23f87bed 454 (:bold t))
16409b0b
GM
455 (t
456 ()))
457 "Level 5 newsgroup face.")
458
459(defface gnus-group-news-5-empty-face
460 '((((class color)
461 (background dark))
462 ())
463 (((class color)
464 (background light))
465 ())
466 (t
467 ()))
468 "Level 5 empty newsgroup face.")
469
470(defface gnus-group-news-6-face
471 '((((class color)
472 (background dark))
23f87bed 473 (:bold t))
16409b0b
GM
474 (((class color)
475 (background light))
23f87bed 476 (:bold t))
16409b0b
GM
477 (t
478 ()))
479 "Level 6 newsgroup face.")
480
481(defface gnus-group-news-6-empty-face
482 '((((class color)
483 (background dark))
484 ())
485 (((class color)
486 (background light))
487 ())
488 (t
489 ()))
490 "Level 6 empty newsgroup face.")
491
eec82323
LMI
492(defface gnus-group-news-low-face
493 '((((class color)
494 (background dark))
23f87bed 495 (:foreground "DarkTurquoise" :bold t))
eec82323
LMI
496 (((class color)
497 (background light))
23f87bed 498 (:foreground "DarkGreen" :bold t))
eec82323
LMI
499 (t
500 ()))
501 "Low level newsgroup face.")
502
503(defface gnus-group-news-low-empty-face
504 '((((class color)
505 (background dark))
506 (:foreground "DarkTurquoise"))
507 (((class color)
508 (background light))
509 (:foreground "DarkGreen"))
510 (t
511 ()))
512 "Low level empty newsgroup face.")
513
514(defface gnus-group-mail-1-face
515 '((((class color)
516 (background dark))
23f87bed 517 (:foreground "aquamarine1" :bold t))
eec82323
LMI
518 (((class color)
519 (background light))
23f87bed 520 (:foreground "DeepPink3" :bold t))
eec82323 521 (t
23f87bed 522 (:bold t)))
eec82323
LMI
523 "Level 1 mailgroup face.")
524
525(defface gnus-group-mail-1-empty-face
526 '((((class color)
527 (background dark))
528 (:foreground "aquamarine1"))
529 (((class color)
530 (background light))
531 (:foreground "DeepPink3"))
532 (t
23f87bed 533 (:italic t :bold t)))
eec82323
LMI
534 "Level 1 empty mailgroup face.")
535
536(defface gnus-group-mail-2-face
537 '((((class color)
538 (background dark))
23f87bed 539 (:foreground "aquamarine2" :bold t))
eec82323
LMI
540 (((class color)
541 (background light))
23f87bed 542 (:foreground "HotPink3" :bold t))
eec82323 543 (t
23f87bed 544 (:bold t)))
eec82323
LMI
545 "Level 2 mailgroup face.")
546
547(defface gnus-group-mail-2-empty-face
548 '((((class color)
549 (background dark))
550 (:foreground "aquamarine2"))
551 (((class color)
552 (background light))
553 (:foreground "HotPink3"))
554 (t
23f87bed 555 (:bold t)))
eec82323
LMI
556 "Level 2 empty mailgroup face.")
557
558(defface gnus-group-mail-3-face
559 '((((class color)
560 (background dark))
23f87bed 561 (:foreground "aquamarine3" :bold t))
eec82323
LMI
562 (((class color)
563 (background light))
23f87bed 564 (:foreground "magenta4" :bold t))
eec82323 565 (t
23f87bed 566 (:bold t)))
eec82323
LMI
567 "Level 3 mailgroup face.")
568
569(defface gnus-group-mail-3-empty-face
570 '((((class color)
571 (background dark))
572 (:foreground "aquamarine3"))
573 (((class color)
574 (background light))
575 (:foreground "magenta4"))
576 (t
577 ()))
578 "Level 3 empty mailgroup face.")
579
580(defface gnus-group-mail-low-face
581 '((((class color)
582 (background dark))
23f87bed 583 (:foreground "aquamarine4" :bold t))
eec82323
LMI
584 (((class color)
585 (background light))
23f87bed 586 (:foreground "DeepPink4" :bold t))
eec82323 587 (t
23f87bed 588 (:bold t)))
eec82323
LMI
589 "Low level mailgroup face.")
590
591(defface gnus-group-mail-low-empty-face
592 '((((class color)
593 (background dark))
594 (:foreground "aquamarine4"))
595 (((class color)
596 (background light))
597 (:foreground "DeepPink4"))
598 (t
23f87bed 599 (:bold t)))
eec82323
LMI
600 "Low level empty mailgroup face.")
601
602;; Summary mode faces.
603
604(defface gnus-summary-selected-face '((t
605 (:underline t)))
606 "Face used for selected articles.")
607
608(defface gnus-summary-cancelled-face
609 '((((class color))
610 (:foreground "yellow" :background "black")))
611 "Face used for cancelled articles.")
612
613(defface gnus-summary-high-ticked-face
614 '((((class color)
615 (background dark))
23f87bed 616 (:foreground "pink" :bold t))
eec82323
LMI
617 (((class color)
618 (background light))
23f87bed 619 (:foreground "firebrick" :bold t))
eec82323 620 (t
23f87bed 621 (:bold t)))
eec82323
LMI
622 "Face used for high interest ticked articles.")
623
624(defface gnus-summary-low-ticked-face
625 '((((class color)
626 (background dark))
23f87bed 627 (:foreground "pink" :italic t))
eec82323
LMI
628 (((class color)
629 (background light))
23f87bed 630 (:foreground "firebrick" :italic t))
eec82323 631 (t
23f87bed 632 (:italic t)))
eec82323
LMI
633 "Face used for low interest ticked articles.")
634
635(defface gnus-summary-normal-ticked-face
636 '((((class color)
637 (background dark))
638 (:foreground "pink"))
639 (((class color)
640 (background light))
641 (:foreground "firebrick"))
642 (t
643 ()))
644 "Face used for normal interest ticked articles.")
645
646(defface gnus-summary-high-ancient-face
647 '((((class color)
648 (background dark))
23f87bed 649 (:foreground "SkyBlue" :bold t))
eec82323
LMI
650 (((class color)
651 (background light))
23f87bed 652 (:foreground "RoyalBlue" :bold t))
eec82323 653 (t
23f87bed 654 (:bold t)))
eec82323
LMI
655 "Face used for high interest ancient articles.")
656
657(defface gnus-summary-low-ancient-face
658 '((((class color)
659 (background dark))
23f87bed 660 (:foreground "SkyBlue" :italic t))
eec82323
LMI
661 (((class color)
662 (background light))
23f87bed 663 (:foreground "RoyalBlue" :italic t))
eec82323 664 (t
23f87bed 665 (:italic t)))
eec82323
LMI
666 "Face used for low interest ancient articles.")
667
668(defface gnus-summary-normal-ancient-face
669 '((((class color)
670 (background dark))
671 (:foreground "SkyBlue"))
672 (((class color)
673 (background light))
674 (:foreground "RoyalBlue"))
675 (t
676 ()))
677 "Face used for normal interest ancient articles.")
678
23f87bed
MB
679(defface gnus-summary-high-undownloaded-face
680 '((((class color)
681 (background light))
682 (:bold t :foreground "cyan4"))
683 (((class color) (background dark))
684 (:bold t :foreground "LightGray"))
685 (t (:inverse-video t :bold t)))
686 "Face used for high interest uncached articles.")
687
688(defface gnus-summary-low-undownloaded-face
689 '((((class color)
690 (background light))
691 (:italic t :foreground "cyan4" :bold nil))
692 (((class color) (background dark))
693 (:italic t :foreground "LightGray" :bold nil))
694 (t (:inverse-video t :italic t)))
695 "Face used for low interest uncached articles.")
696
697(defface gnus-summary-normal-undownloaded-face
698 '((((class color)
699 (background light))
700 (:foreground "cyan4" :bold nil))
701 (((class color) (background dark))
702 (:foreground "LightGray" :bold nil))
703 (t (:inverse-video t)))
704 "Face used for normal interest uncached articles.")
705
eec82323
LMI
706(defface gnus-summary-high-unread-face
707 '((t
23f87bed 708 (:bold t)))
eec82323
LMI
709 "Face used for high interest unread articles.")
710
711(defface gnus-summary-low-unread-face
712 '((t
23f87bed 713 (:italic t)))
eec82323
LMI
714 "Face used for low interest unread articles.")
715
716(defface gnus-summary-normal-unread-face
717 '((t
718 ()))
719 "Face used for normal interest unread articles.")
720
721(defface gnus-summary-high-read-face
722 '((((class color)
723 (background dark))
724 (:foreground "PaleGreen"
23f87bed 725 :bold t))
eec82323
LMI
726 (((class color)
727 (background light))
728 (:foreground "DarkGreen"
23f87bed 729 :bold t))
eec82323 730 (t
23f87bed 731 (:bold t)))
eec82323
LMI
732 "Face used for high interest read articles.")
733
734(defface gnus-summary-low-read-face
735 '((((class color)
736 (background dark))
737 (:foreground "PaleGreen"
23f87bed 738 :italic t))
eec82323
LMI
739 (((class color)
740 (background light))
741 (:foreground "DarkGreen"
23f87bed 742 :italic t))
eec82323 743 (t
23f87bed 744 (:italic t)))
eec82323
LMI
745 "Face used for low interest read articles.")
746
747(defface gnus-summary-normal-read-face
748 '((((class color)
749 (background dark))
750 (:foreground "PaleGreen"))
751 (((class color)
752 (background light))
753 (:foreground "DarkGreen"))
754 (t
755 ()))
756 "Face used for normal interest read articles.")
757
758
6748645f
LMI
759;;;
760;;; Gnus buffers
761;;;
762
763(defvar gnus-buffers nil)
764
765(defun gnus-get-buffer-create (name)
766 "Do the same as `get-buffer-create', but store the created buffer."
767 (or (get-buffer name)
768 (car (push (get-buffer-create name) gnus-buffers))))
769
770(defun gnus-add-buffer ()
771 "Add the current buffer to the list of Gnus buffers."
772 (push (current-buffer) gnus-buffers))
773
23f87bed
MB
774(defmacro gnus-kill-buffer (buffer)
775 "Kill BUFFER and remove from the list of Gnus buffers."
776 `(let ((buf ,buffer))
777 (when (gnus-buffer-exists-p buf)
778 (setq gnus-buffers (delete (get-buffer buf) gnus-buffers))
779 (kill-buffer buf))))
780
6748645f
LMI
781(defun gnus-buffers ()
782 "Return a list of live Gnus buffers."
783 (while (and gnus-buffers
784 (not (buffer-name (car gnus-buffers))))
785 (pop gnus-buffers))
786 (let ((buffers gnus-buffers))
787 (while (cdr buffers)
788 (if (buffer-name (cadr buffers))
789 (pop buffers)
790 (setcdr buffers (cddr buffers)))))
791 gnus-buffers)
792
eec82323
LMI
793;;; Splash screen.
794
795(defvar gnus-group-buffer "*Group*")
796
797(eval-and-compile
798 (autoload 'gnus-play-jingle "gnus-audio"))
799
800(defface gnus-splash-face
801 '((((class color)
802 (background dark))
23f87bed 803 (:foreground "#888888"))
eec82323
LMI
804 (((class color)
805 (background light))
23f87bed 806 (:foreground "#888888"))
eec82323
LMI
807 (t
808 ()))
23f87bed 809 "Face for the splash screen.")
eec82323
LMI
810
811(defun gnus-splash ()
812 (save-excursion
6748645f 813 (switch-to-buffer (gnus-get-buffer-create gnus-group-buffer))
eec82323
LMI
814 (let ((buffer-read-only nil))
815 (erase-buffer)
816 (unless gnus-inhibit-startup-message
817 (gnus-group-startup-message)
818 (sit-for 0)
819 (when gnus-play-startup-jingle
820 (gnus-play-jingle))))))
821
822(defun gnus-indent-rigidly (start end arg)
823 "Indent rigidly using only spaces and no tabs."
824 (save-excursion
825 (save-restriction
826 (narrow-to-region start end)
a8151ef7
LMI
827 (let ((tab-width 8))
828 (indent-rigidly start end arg)
829 ;; We translate tabs into spaces -- not everybody uses
830 ;; an 8-character tab.
831 (goto-char (point-min))
832 (while (search-forward "\t" nil t)
833 (replace-match " " t t))))))
eec82323
LMI
834
835(defvar gnus-simple-splash nil)
836
23f87bed
MB
837;;(format "%02x%02x%02x" 114 66 20) "724214"
838
839(defvar gnus-logo-color-alist
840 '((flame "#cc3300" "#ff2200")
841 (pine "#c0cc93" "#f8ffb8")
842 (moss "#a1cc93" "#d2ffb8")
843 (irish "#04cc90" "#05ff97")
844 (sky "#049acc" "#05deff")
845 (tin "#6886cc" "#82b6ff")
846 (velvet "#7c68cc" "#8c82ff")
847 (grape "#b264cc" "#cf7df")
848 (labia "#cc64c2" "#fd7dff")
849 (berry "#cc6485" "#ff7db5")
850 (dino "#724214" "#1e3f03")
851 (oort "#cccccc" "#888888")
852 (storm "#666699" "#99ccff")
853 (pdino "#9999cc" "#99ccff")
854 (purp "#9999cc" "#666699")
855 (no "#000000" "#ff0000")
856 (neutral "#b4b4b4" "#878787")
857 (september "#bf9900" "#ffcc00"))
858 "Color alist used for the Gnus logo.")
859
860(defcustom gnus-logo-color-style 'oort
861 "*Color styles used for the Gnus logo."
862 :type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem)))
863 gnus-logo-color-alist))
864 :group 'gnus-xmas)
865
866(defvar gnus-logo-colors
867 (cdr (assq gnus-logo-color-style gnus-logo-color-alist))
868 "Colors used for the Gnus logo.")
869
eec82323
LMI
870(defun gnus-group-startup-message (&optional x y)
871 "Insert startup message in current buffer."
872 ;; Insert the message.
873 (erase-buffer)
16409b0b
GM
874 (cond
875 ((and
876 (fboundp 'find-image)
877 (display-graphic-p)
23f87bed
MB
878 (let* ((data-directory (nnheader-find-etc-directory "gnus"))
879 (image (find-image
880 `((:type xpm :file "gnus.xpm"
881 :color-symbols
882 (("thing" . ,(car gnus-logo-colors))
883 ("shadow" . ,(cadr gnus-logo-colors))
884 ("oort" . "#eeeeee")
885 ("background" . ,(face-background 'default))))
886 (:type pbm :file "gnus.pbm"
887 ;; Account for the pbm's blackground.
888 :background ,(face-foreground 'gnus-splash-face)
889 :foreground ,(face-background 'default))
890 (:type xbm :file "gnus.xbm"
891 ;; Account for the xbm's blackground.
892 :background ,(face-foreground 'gnus-splash-face)
893 :foreground ,(face-background 'default))))))
16409b0b
GM
894 (when image
895 (let ((size (image-size image)))
896 (insert-char ?\n (max 0 (round (- (window-height)
897 (or y (cdr size)) 1) 2)))
898 (insert-char ?\ (max 0 (round (- (window-width)
899 (or x (car size))) 2)))
900 (insert-image image))
901 (setq gnus-simple-splash nil)
902 t))))
903 (t
904 (insert
905 (format " %s
eec82323
LMI
906 _ ___ _ _
907 _ ___ __ ___ __ _ ___
908 __ _ ___ __ ___
909 _ ___ _
910 _ _ __ _
911 ___ __ _
912 __ _
913 _ _ _
914 _ _ _
915 _ _ _
916 __ ___
917 _ _ _ _
918 _ _
919 _ _
920 _ _
921 _
922 __
923
924"
16409b0b
GM
925 ""))
926 ;; And then hack it.
927 (gnus-indent-rigidly (point-min) (point-max)
928 (/ (max (- (window-width) (or x 46)) 0) 2))
929 (goto-char (point-min))
930 (forward-line 1)
931 (let* ((pheight (count-lines (point-min) (point-max)))
932 (wheight (window-height))
933 (rest (- wheight pheight)))
934 (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
935 ;; Fontify some.
936 (put-text-property (point-min) (point-max) 'face 'gnus-splash-face)
937 (setq gnus-simple-splash t)))
eec82323
LMI
938 (goto-char (point-min))
939 (setq mode-line-buffer-identification (concat " " gnus-version))
eec82323
LMI
940 (set-buffer-modified-p t))
941
942(eval-when (load)
943 (let ((command (format "%s" this-command)))
23f87bed
MB
944 (when (string-match "gnus" command)
945 (if (string-match "gnus-other-frame" command)
946 (gnus-get-buffer-create gnus-group-buffer)
947 (gnus-splash)))))
eec82323
LMI
948
949;;; Do the rest.
950
eec82323
LMI
951(require 'gnus-util)
952(require 'nnheader)
953
23f87bed
MB
954(defcustom gnus-parameters nil
955 "Alist of group parameters.
956
957For example:
958 ((\"mail\\\\..*\" (gnus-show-threads nil)
959 (gnus-use-scoring nil)
960 (gnus-summary-line-format
961 \"%U%R%z%I%(%[%d:%ub%-23,23f%]%) %s\\n\")
962 (gcc-self . t)
963 (display . all))
964 (\"mail\\\\.me\" (gnus-use-scoring t))
965 (\"list\\\\..*\" (total-expire . t)
966 (broken-reply-to . t)))"
a08b59c9 967 :version "21.4"
23f87bed
MB
968 :group 'gnus-group-various
969 :type '(repeat (cons regexp
970 (repeat sexp))))
971
972(defvar gnus-group-parameters-more nil)
973
974(defmacro gnus-define-group-parameter (param &rest rest)
975 "Define a group parameter PARAM.
976REST is a plist of following:
977:type One of `bool', `list' or nil.
978:function The name of the function.
979:function-document The documentation of the function.
980:parameter-type The type for customizing the parameter.
981:parameter-document The documentation for the parameter.
982:variable The name of the variable.
983:variable-document The documentation for the variable.
984:variable-group The group for customizing the variable.
985:variable-type The type for customizing the variable.
986:variable-default The default value of the variable."
987 (let* ((type (plist-get rest :type))
988 (parameter-type (plist-get rest :parameter-type))
989 (parameter-document (plist-get rest :parameter-document))
990 (function (or (plist-get rest :function)
991 (intern (format "gnus-parameter-%s" param))))
992 (function-document (or (plist-get rest :function-document) ""))
993 (variable (or (plist-get rest :variable)
994 (intern (format "gnus-parameter-%s-alist" param))))
995 (variable-document (or (plist-get rest :variable-document) ""))
996 (variable-group (plist-get rest :variable-group))
997 (variable-type (or (plist-get rest :variable-type)
998 `(quote (repeat
999 (list (regexp :tag "Group")
1000 ,(car (cdr parameter-type)))))))
1001 (variable-default (plist-get rest :variable-default)))
1002 (list
1003 'progn
1004 `(defcustom ,variable ,variable-default
1005 ,variable-document
1006 :group 'gnus-group-parameter
1007 :group ',variable-group
1008 :type ,variable-type)
1009 `(setq gnus-group-parameters-more
1010 (delq (assq ',param gnus-group-parameters-more)
1011 gnus-group-parameters-more))
1012 `(add-to-list 'gnus-group-parameters-more
1013 (list ',param
1014 ,parameter-type
1015 ,parameter-document))
1016 (if (eq type 'bool)
1017 `(defun ,function (name)
1018 ,function-document
1019 (let ((params (gnus-group-find-parameter name))
1020 val)
1021 (cond
1022 ((memq ',param params)
1023 t)
1024 ((setq val (assq ',param params))
1025 (cdr val))
1026 ((stringp ,variable)
1027 (string-match ,variable name))
1028 (,variable
1029 (let ((alist ,variable)
1030 elem value)
1031 (while (setq elem (pop alist))
1032 (when (and name
1033 (string-match (car elem) name))
1034 (setq alist nil
1035 value (cdr elem))))
1036 (if (consp value) (car value) value))))))
1037 `(defun ,function (name)
1038 ,function-document
1039 (and name
1040 (or (gnus-group-find-parameter name ',param ,(and type t))
1041 (let ((alist ,variable)
1042 elem value)
1043 (while (setq elem (pop alist))
1044 (when (and name
1045 (string-match (car elem) name))
1046 (setq alist nil
1047 value (cdr elem))))
1048 ,(if type
1049 'value
1050 '(if (consp value) (car value) value))))))))))
1051
eec82323
LMI
1052(defcustom gnus-home-directory "~/"
1053 "Directory variable that specifies the \"home\" directory.
35ef97a5 1054All other Gnus file and directory variables are initialized from this variable."
eec82323
LMI
1055 :group 'gnus-files
1056 :type 'directory)
1057
1058(defcustom gnus-directory (or (getenv "SAVEDIR")
1059 (nnheader-concat gnus-home-directory "News/"))
6748645f
LMI
1060 "*Directory variable from which all other Gnus file variables are derived.
1061
1062Note that Gnus is mostly loaded when the `.gnus.el' file is read.
1063This means that other directory variables that are initialized from
1064this variable won't be set properly if you set this variable in `.gnus.el'.
1065Set this variable in `.emacs' instead."
eec82323
LMI
1066 :group 'gnus-files
1067 :type 'directory)
1068
1069(defcustom gnus-default-directory nil
1070 "*Default directory for all Gnus buffers."
1071 :group 'gnus-files
1072 :type '(choice (const :tag "current" nil)
1073 directory))
1074
1075;; Site dependent variables. These variables should be defined in
1076;; paths.el.
1077
1078(defvar gnus-default-nntp-server nil
1079 "Specify a default NNTP server.
1080This variable should be defined in paths.el, and should never be set
1081by the user.
1082If you want to change servers, you should use `gnus-select-method'.
1083See the documentation to that variable.")
1084
1085;; Don't touch this variable.
1086(defvar gnus-nntp-service "nntp"
1087 "NNTP service name (\"nntp\" or 119).
1088This is an obsolete variable, which is scarcely used. If you use an
1089nntp server for your newsgroup and want to change the port number
1090used to 899, you would say something along these lines:
1091
1092 (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))")
1093
1094(defcustom gnus-nntpserver-file "/etc/nntpserver"
1095 "A file with only the name of the nntp server in it."
1096 :group 'gnus-files
1097 :group 'gnus-server
1098 :type 'file)
1099
eec82323 1100(defun gnus-getenv-nntpserver ()
23f87bed
MB
1101 "Find default nntp server.
1102Check the NNTPSERVER environment variable and the
1103`gnus-nntpserver-file' file."
eec82323
LMI
1104 (or (getenv "NNTPSERVER")
1105 (and (file-readable-p gnus-nntpserver-file)
23f87bed 1106 (with-temp-buffer
eec82323 1107 (insert-file-contents gnus-nntpserver-file)
f4dd4ae8
MB
1108 (when (re-search-forward "[^ \t\n\r]+" nil t)
1109 (match-string 0))))))
eec82323
LMI
1110
1111(defcustom gnus-select-method
a36c8d02 1112 (condition-case nil
16409b0b
GM
1113 (nconc
1114 (list 'nntp (or (condition-case nil
1115 (gnus-getenv-nntpserver)
1116 (error nil))
1117 (when (and gnus-default-nntp-server
1118 (not (string= gnus-default-nntp-server "")))
1119 gnus-default-nntp-server)
1120 "news"))
1121 (if (or (null gnus-nntp-service)
1122 (equal gnus-nntp-service "nntp"))
1123 nil
1124 (list gnus-nntp-service)))
a36c8d02 1125 (error nil))
16409b0b 1126 "Default method for selecting a newsgroup.
eec82323
LMI
1127This variable should be a list, where the first element is how the
1128news is to be fetched, the second is the address.
1129
23f87bed
MB
1130For instance, if you want to get your news via \"flab.flab.edu\" using
1131NNTP, you could say:
eec82323
LMI
1132
1133\(setq gnus-select-method '(nntp \"flab.flab.edu\"))
1134
1135If you want to use your local spool, say:
1136
1137\(setq gnus-select-method (list 'nnspool (system-name)))
1138
1139If you use this variable, you must set `gnus-nntp-server' to nil.
1140
1141There is a lot more to know about select methods and virtual servers -
1142see the manual for details."
1143 :group 'gnus-server
1144 :type 'gnus-select-method)
1145
23f87bed 1146(defcustom gnus-message-archive-method "archive"
6748645f 1147 "*Method used for archiving messages you've sent.
23f87bed 1148This should be a mail method."
eec82323
LMI
1149 :group 'gnus-server
1150 :group 'gnus-message
23f87bed
MB
1151 :type '(choice (const :tag "Default archive method" "archive")
1152 gnus-select-method))
eec82323
LMI
1153
1154(defcustom gnus-message-archive-group nil
1155 "*Name of the group in which to save the messages you've written.
1156This can either be a string; a list of strings; or an alist
1157of regexps/functions/forms to be evaluated to return a string (or a list
1158of strings). The functions are called with the name of the current
1159group (or nil) as a parameter.
1160
1161If you want to save your mail in one group and the news articles you
1162write in another group, you could say something like:
1163
1164 \(setq gnus-message-archive-group
23f87bed
MB
1165 '((if (message-news-p)
1166 \"misc-news\"
1167 \"misc-mail\")))
eec82323
LMI
1168
1169Normally the group names returned by this variable should be
1170unprefixed -- which implicitly means \"store on the archive server\".
1171However, you may wish to store the message on some other server. In
1172that case, just return a fully prefixed name of the group --
1173\"nnml+private:mail.misc\", for instance."
1174 :group 'gnus-message
1175 :type '(choice (const :tag "none" nil)
16409b0b 1176 function
6748645f 1177 sexp
eec82323
LMI
1178 string))
1179
1180(defcustom gnus-secondary-servers nil
1181 "List of NNTP servers that the user can choose between interactively.
1182To make Gnus query you for a server, you have to give `gnus' a
1183non-numeric prefix - `C-u M-x gnus', in short."
1184 :group 'gnus-server
1185 :type '(repeat string))
1186
1187(defcustom gnus-nntp-server nil
1188 "*The name of the host running the NNTP server.
1189This variable is semi-obsolete. Use the `gnus-select-method'
1190variable instead."
1191 :group 'gnus-server
1192 :type '(choice (const :tag "disable" nil)
1193 string))
1194
1195(defcustom gnus-secondary-select-methods nil
1196 "A list of secondary methods that will be used for reading news.
1197This is a list where each element is a complete select method (see
1198`gnus-select-method').
1199
23f87bed 1200If, for instance, you want to read your mail with the nnml back end,
eec82323
LMI
1201you could set this variable:
1202
1203\(setq gnus-secondary-select-methods '((nnml \"\")))"
16409b0b
GM
1204 :group 'gnus-server
1205 :type '(repeat gnus-select-method))
eec82323
LMI
1206
1207(defvar gnus-backup-default-subscribed-newsgroups
1208 '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus")
1209 "Default default new newsgroups the first time Gnus is run.
1210Should be set in paths.el, and shouldn't be touched by the user.")
1211
c625688c
GM
1212(defcustom gnus-local-domain nil
1213 "Local domain name without a host name.
1214The DOMAINNAME environment variable is used instead if it is defined.
0d54d415 1215If the function `system-name' returns the full Internet name, there is
c625688c
GM
1216no need to set this variable."
1217 :group 'gnus-message
1218 :type '(choice (const :tag "default" nil)
1219 string))
1220
eec82323
LMI
1221(defvar gnus-local-organization nil
1222 "String with a description of what organization (if any) the user belongs to.
1223Obsolete variable; use `message-user-organization' instead.")
1224
1225;; Customization variables
1226
1227(defcustom gnus-refer-article-method nil
1228 "Preferred method for fetching an article by Message-ID.
1229If you are reading news from the local spool (with nnspool), fetching
1230articles by Message-ID is painfully slow. By setting this method to an
1231nntp method, you might get acceptable results.
1232
1233The value of this variable must be a valid select method as discussed
16409b0b
GM
1234in the documentation of `gnus-select-method'.
1235
1236It can also be a list of select methods, as well as the special symbol
1237`current', which means to use the current select method. If it is a
1238list, Gnus will try all the methods in the list until it finds a match."
eec82323
LMI
1239 :group 'gnus-server
1240 :type '(choice (const :tag "default" nil)
23f87bed
MB
1241 (const current)
1242 (const :tag "Google" (nnweb "refer" (nnweb-type google)))
16409b0b
GM
1243 gnus-select-method
1244 (repeat :menu-tag "Try multiple"
1245 :tag "Multiple"
23f87bed 1246 :value (current (nnweb "refer" (nnweb-type google)))
16409b0b
GM
1247 (choice :tag "Method"
1248 (const current)
23f87bed
MB
1249 (const :tag "Google"
1250 (nnweb "refer" (nnweb-type google)))
16409b0b 1251 gnus-select-method))))
eec82323
LMI
1252
1253(defcustom gnus-group-faq-directory
1254 '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/"
eec82323
LMI
1255 "/ftp@sunsite.doc.ic.ac.uk:/pub/usenet/news-faqs/"
1256 "/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/"
1257 "/ftp@ftp.seas.gwu.edu:/pub/rtfm/"
23f87bed 1258 "/ftp@ftp.pasteur.fr:/pub/FAQ/"
eec82323
LMI
1259 "/ftp@rtfm.mit.edu:/pub/usenet/"
1260 "/ftp@ftp.uni-paderborn.de:/pub/FAQ/"
1261 "/ftp@ftp.sunet.se:/pub/usenet/"
23f87bed 1262 "/ftp@nctuccca.nctu.edu.tw:/pub/Documents/rtfm/usenet-by-group/"
eec82323
LMI
1263 "/ftp@hwarang.postech.ac.kr:/pub/usenet/"
1264 "/ftp@ftp.hk.super.net:/mirror/faqs/")
6748645f 1265 "*Directory where the group FAQs are stored.
eec82323
LMI
1266This will most commonly be on a remote machine, and the file will be
1267fetched by ange-ftp.
1268
1269This variable can also be a list of directories. In that case, the
1270first element in the list will be used by default. The others can
1271be used when being prompted for a site.
1272
1273Note that Gnus uses an aol machine as the default directory. If this
1274feels fundamentally unclean, just think of it as a way to finally get
1275something of value back from them.
1276
1277If the default site is too slow, try one of these:
1278
1279 North America: mirrors.aol.com /pub/rtfm/usenet
1280 ftp.seas.gwu.edu /pub/rtfm
1281 rtfm.mit.edu /pub/usenet
1282 Europe: ftp.uni-paderborn.de /pub/FAQ
23f87bed 1283 src.doc.ic.ac.uk /usenet/news-FAQS
eec82323 1284 ftp.sunet.se /pub/usenet
23f87bed
MB
1285 ftp.pasteur.fr /pub/FAQ
1286 Asia: nctuccca.nctu.edu.tw /pub/Documents/rtfm/usenet-by-group/
eec82323
LMI
1287 hwarang.postech.ac.kr /pub/usenet
1288 ftp.hk.super.net /mirror/faqs"
1289 :group 'gnus-group-various
1290 :type '(choice directory
1291 (repeat directory)))
1292
23f87bed
MB
1293(defcustom gnus-group-charter-alist
1294 '(("no" . (concat "http://no.news-admin.org/charter/" name ".txt"))
1295 ("de" . (concat "http://purl.net/charta/" name ".html"))
1296 ("dk" . (concat "http://www.usenet.dk/grupper.pl?get=" name))
1297 ("england" . (concat "http://england.news-admin.org/charters/" name))
1298 ("fr" . (concat "http://www.usenet-fr.net/fur/chartes/" name ".html"))
1299 ("europa" . (concat "http://www.europa.usenet.eu.org/chartas/charta-en-"
1300 (gnus-replace-in-string name "europa\\." "") ".html"))
1301 ("nl" . (concat "http://www.xs4all.nl/~sister/usenet/charters/" name))
1302 ("aus" . (concat "http://aus.news-admin.org/groupinfo.cgi/" name))
1303 ("pl" . (concat "http://www.usenet.pl/opisy/" name))
1304 ("ch" . (concat "http://www.use-net.ch/Usenet/charter.html#" name))
1305 ("at" . (concat "http://www.usenet.at/chartas/" name "/charta"))
1306 ("uk" . (concat "http://www.usenet.org.uk/" name ".html"))
1307 ("dfw" . (concat "http://www.cirr.com/dfw/charters/" name ".html"))
1308 ("se" . (concat "http://www.usenet-se.net/Reglementen/"
1309 (gnus-replace-in-string name "\\." "_") ".html"))
1310 ("milw" . (concat "http://usenet.mil.wi.us/"
1311 (gnus-replace-in-string name "milw\\." "") "-charter"))
1312 ("ca" . (concat "http://www.sbay.org/ca/charter-" name ".html"))
1313 ("netins" . (concat "http://www.netins.net/usenet/charter/"
1314 (gnus-replace-in-string name "\\." "-") "-charter.html")))
1315 "*An alist of (HIERARCHY . FORM) pairs used to construct the URL of a charter.
1316When FORM is evaluated `name' is bound to the name of the group."
e2642250 1317 :version "21.4"
23f87bed
MB
1318 :group 'gnus-group-various
1319 :type '(repeat (cons (string :tag "Hierarchy") (sexp :tag "Form"))))
1320
1321(defcustom gnus-group-fetch-control-use-browse-url nil
1322 "*Non-nil means that control messages are displayed using `browse-url'.
1323Otherwise they are fetched with ange-ftp and displayed in an ephemeral
1324group."
e2642250 1325 :version "21.4"
23f87bed
MB
1326 :group 'gnus-group-various
1327 :type 'boolean)
1328
eec82323
LMI
1329(defcustom gnus-use-cross-reference t
1330 "*Non-nil means that cross referenced articles will be marked as read.
1331If nil, ignore cross references. If t, mark articles as read in
1332subscribed newsgroups. If neither t nor nil, mark as read in all
1333newsgroups."
1334 :group 'gnus-server
1335 :type '(choice (const :tag "off" nil)
1336 (const :tag "subscribed" t)
1337 (sexp :format "all"
1338 :value always)))
1339
1340(defcustom gnus-process-mark ?#
1341 "*Process mark."
1342 :group 'gnus-group-visual
1343 :group 'gnus-summary-marks
1344 :type 'character)
1345
eec82323
LMI
1346(defcustom gnus-large-newsgroup 200
1347 "*The number of articles which indicates a large newsgroup.
1348If the number of articles in a newsgroup is greater than this value,
23f87bed
MB
1349confirmation is required for selecting the newsgroup.
1350If it is nil, no confirmation is required."
eec82323 1351 :group 'gnus-group-select
23f87bed
MB
1352 :type '(choice (const :tag "No limit" nil)
1353 integer))
eec82323
LMI
1354
1355(defcustom gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix)))
1356 "*Non-nil means that the default name of a file to save articles in is the group name.
1357If it's nil, the directory form of the group name is used instead.
1358
1359If this variable is a list, and the list contains the element
1360`not-score', long file names will not be used for score files; if it
1361contains the element `not-save', long file names will not be used for
1362saving; and if it contains the element `not-kill', long file names
1363will not be used for kill files.
1364
1365Note that the default for this variable varies according to what system
1366type you're using. On `usg-unix-v' and `xenix' this variable defaults
1367to nil while on all other systems it defaults to t."
1368 :group 'gnus-start
23f87bed
MB
1369 :type '(radio (sexp :format "Non-nil\n"
1370 :match (lambda (widget value)
1371 (and value (not (listp value))))
1372 :value t)
1373 (const nil)
1374 (checklist (const :format "%v " not-score)
1375 (const :format "%v " not-save)
1376 (const not-kill))))
eec82323
LMI
1377
1378(defcustom gnus-kill-files-directory gnus-directory
1379 "*Name of the directory where kill files will be stored (default \"~/News\")."
1380 :group 'gnus-score-files
1381 :group 'gnus-score-kill
1382 :type 'directory)
1383
1384(defcustom gnus-save-score nil
1385 "*If non-nil, save group scoring info."
1386 :group 'gnus-score-various
1387 :group 'gnus-start
1388 :type 'boolean)
1389
1390(defcustom gnus-use-undo t
1391 "*If non-nil, allow undoing in Gnus group mode buffers."
1392 :group 'gnus-meta
1393 :type 'boolean)
1394
1395(defcustom gnus-use-adaptive-scoring nil
1396 "*If non-nil, use some adaptive scoring scheme.
1397If a list, then the values `word' and `line' are meaningful. The
1398former will perform adaption on individual words in the subject
1399header while `line' will perform adaption on several headers."
1400 :group 'gnus-meta
1401 :group 'gnus-score-adapt
1402 :type '(set (const word) (const line)))
1403
1404(defcustom gnus-use-cache 'passive
1405 "*If nil, Gnus will ignore the article cache.
1406If `passive', it will allow entering (and reading) articles
1407explicitly entered into the cache. If anything else, use the
1408cache to the full extent of the law."
1409 :group 'gnus-meta
1410 :group 'gnus-cache
1411 :type '(choice (const :tag "off" nil)
1412 (const :tag "passive" passive)
1413 (const :tag "active" t)))
1414
1415(defcustom gnus-use-trees nil
1416 "*If non-nil, display a thread tree buffer."
1417 :group 'gnus-meta
1418 :type 'boolean)
1419
1420(defcustom gnus-use-grouplens nil
1421 "*If non-nil, use GroupLens ratings."
1422 :group 'gnus-meta
1423 :type 'boolean)
1424
23f87bed 1425(defcustom gnus-keep-backlog 20
eec82323
LMI
1426 "*If non-nil, Gnus will keep read articles for later re-retrieval.
1427If it is a number N, then Gnus will only keep the last N articles
1428read. If it is neither nil nor a number, Gnus will keep all read
1429articles. This is not a good idea."
1430 :group 'gnus-meta
1431 :type '(choice (const :tag "off" nil)
1432 integer
1433 (sexp :format "all"
1434 :value t)))
1435
1436(defcustom gnus-use-nocem nil
1437 "*If non-nil, Gnus will read NoCeM cancel messages."
1438 :group 'gnus-meta
1439 :type 'boolean)
1440
1441(defcustom gnus-suppress-duplicates nil
1442 "*If non-nil, Gnus will mark duplicate copies of the same article as read."
1443 :group 'gnus-meta
1444 :type 'boolean)
1445
eec82323
LMI
1446(defcustom gnus-use-scoring t
1447 "*If non-nil, enable scoring."
1448 :group 'gnus-meta
1449 :type 'boolean)
1450
eec82323
LMI
1451(defcustom gnus-summary-prepare-exit-hook
1452 '(gnus-summary-expire-articles)
6748645f 1453 "*A hook called when preparing to exit from the summary buffer.
eec82323
LMI
1454It calls `gnus-summary-expire-articles' by default."
1455 :group 'gnus-summary-exit
1456 :type 'hook)
1457
1458(defcustom gnus-novice-user t
23f87bed 1459 "*Non-nil means that you are a Usenet novice.
eec82323
LMI
1460If non-nil, verbose messages may be displayed and confirmations may be
1461required."
1462 :group 'gnus-meta
1463 :type 'boolean)
1464
1465(defcustom gnus-expert-user nil
1466 "*Non-nil means that you will never be asked for confirmation about anything.
6748645f
LMI
1467That doesn't mean *anything* anything; particularly destructive
1468commands will still require prompting."
eec82323
LMI
1469 :group 'gnus-meta
1470 :type 'boolean)
1471
1472(defcustom gnus-interactive-catchup t
1473 "*If non-nil, require your confirmation when catching up a group."
1474 :group 'gnus-group-select
1475 :type 'boolean)
1476
1477(defcustom gnus-interactive-exit t
1478 "*If non-nil, require your confirmation when exiting Gnus."
1479 :group 'gnus-exit
1480 :type 'boolean)
1481
1482(defcustom gnus-extract-address-components 'gnus-extract-address-components
1483 "*Function for extracting address components from a From header.
1484Two pre-defined function exist: `gnus-extract-address-components',
1485which is the default, quite fast, and too simplistic solution, and
1486`mail-extract-address-components', which works much better, but is
1487slower."
1488 :group 'gnus-summary-format
1489 :type '(radio (function-item gnus-extract-address-components)
1490 (function-item mail-extract-address-components)
1491 (function :tag "Other")))
1492
1493(defcustom gnus-carpal nil
1494 "*If non-nil, display clickable icons."
1495 :group 'gnus-meta
1496 :type 'boolean)
1497
1498(defcustom gnus-shell-command-separator ";"
23f87bed 1499 "String used to separate shell commands."
eec82323
LMI
1500 :group 'gnus-files
1501 :type 'string)
1502
1503(defcustom gnus-valid-select-methods
1504 '(("nntp" post address prompt-address physical-address)
1505 ("nnspool" post address)
1506 ("nnvirtual" post-mail virtual prompt-address)
1507 ("nnmbox" mail respool address)
23f87bed 1508 ("nnml" post-mail respool address)
eec82323
LMI
1509 ("nnmh" mail respool address)
1510 ("nndir" post-mail prompt-address physical-address)
1511 ("nneething" none address prompt-address physical-address)
1512 ("nndoc" none address prompt-address)
1513 ("nnbabyl" mail address respool)
1514 ("nnkiboze" post virtual)
1515 ("nnsoup" post-mail address)
1516 ("nndraft" post-mail)
1517 ("nnfolder" mail respool address)
6748645f
LMI
1518 ("nngateway" post-mail address prompt-address physical-address)
1519 ("nnweb" none)
23f87bed 1520 ("nngoogle" post)
16409b0b
GM
1521 ("nnslashdot" post)
1522 ("nnultimate" none)
23f87bed
MB
1523 ("nnrss" none)
1524 ("nnwfm" none)
16409b0b 1525 ("nnwarchive" none)
6748645f 1526 ("nnlistserv" none)
16409b0b 1527 ("nnagent" post-mail)
23f87bed
MB
1528 ("nnimap" post-mail address prompt-address physical-address)
1529 ("nnmaildir" mail respool address)
1530 ("nnnil" none))
6748645f 1531 "*An alist of valid select methods.
eec82323
LMI
1532The first element of each list lists should be a string with the name
1533of the select method. The other elements may be the category of
1534this method (i. e., `post', `mail', `none' or whatever) or other
1535properties that this method has (like being respoolable).
1536If you implement a new select method, all you should have to change is
1537this variable. I think."
1538 :group 'gnus-server
1539 :type '(repeat (group (string :tag "Name")
1540 (radio-button-choice (const :format "%v " post)
1541 (const :format "%v " mail)
1542 (const :format "%v " none)
1543 (const post-mail))
1544 (checklist :inline t
1545 (const :format "%v " address)
1546 (const :format "%v " prompt-address)
c06fc524 1547 (const :format "%v " physical-address)
eec82323
LMI
1548 (const :format "%v " virtual)
1549 (const respool)))))
1550
16409b0b
GM
1551(defun gnus-redefine-select-method-widget ()
1552 "Recomputes the select-method widget based on the value of
1553`gnus-valid-select-methods'."
1554 (define-widget 'gnus-select-method 'list
1555 "Widget for entering a select method."
1556 :value '(nntp "")
1557 :tag "Select Method"
1558 :args `((choice :tag "Method"
1559 ,@(mapcar (lambda (entry)
1560 (list 'const :format "%v\n"
1561 (intern (car entry))))
1562 gnus-valid-select-methods)
1563 (symbol :tag "other"))
1564 (string :tag "Address")
1565 (repeat :tag "Options"
1566 :inline t
1567 (list :format "%v"
1568 variable
23f87bed 1569 (sexp :tag "Value"))))))
16409b0b
GM
1570
1571(gnus-redefine-select-method-widget)
eec82323
LMI
1572
1573(defcustom gnus-updated-mode-lines '(group article summary tree)
1574 "List of buffers that should update their mode lines.
1575The list may contain the symbols `group', `article', `tree' and
1576`summary'. If the corresponding symbol is present, Gnus will keep
1577that mode line updated with information that may be pertinent.
1578If this variable is nil, screen refresh may be quicker."
1579 :group 'gnus-various
1580 :type '(set (const group)
1581 (const article)
1582 (const summary)
1583 (const tree)))
1584
1585;; Added by Keinonen Kari <kk85613@cs.tut.fi>.
1586(defcustom gnus-mode-non-string-length nil
1587 "*Max length of mode-line non-string contents.
1588If this is nil, Gnus will take space as is needed, leaving the rest
23f87bed 1589of the mode line intact. Note that the default of nil is unlikely
eec82323
LMI
1590to be desirable; see the manual for further details."
1591 :group 'gnus-various
1592 :type '(choice (const nil)
1593 integer))
1594
23f87bed
MB
1595;; There should be special validation for this.
1596(define-widget 'gnus-email-address 'string
1597 "An email address.")
1598
1599(gnus-define-group-parameter
1600 to-address
1601 :function-document
1602 "Return GROUP's to-address."
1603 :variable-document
1604 "*Alist of group regexps and correspondent to-addresses."
e79f14a4 1605 :variable-group gnus-group-parameter
23f87bed
MB
1606 :parameter-type '(gnus-email-address :tag "To Address")
1607 :parameter-document "\
1608This will be used when doing followups and posts.
1609
1610This is primarily useful in mail groups that represent closed
1611mailing lists--mailing lists where it's expected that everybody that
1612writes to the mailing list is subscribed to it. Since using this
1613parameter ensures that the mail only goes to the mailing list itself,
1614it means that members won't receive two copies of your followups.
1615
1616Using `to-address' will actually work whether the group is foreign or
1617not. Let's say there's a group on the server that is called
1618`fa.4ad-l'. This is a real newsgroup, but the server has gotten the
1619articles from a mail-to-news gateway. Posting directly to this group
1620is therefore impossible--you have to send mail to the mailing list
1621address instead.
1622
1623The gnus-group-split mail splitting mechanism will behave as if this
1624address was listed in gnus-group-split Addresses (see below).")
1625
1626(gnus-define-group-parameter
1627 to-list
1628 :function-document
1629 "Return GROUP's to-list."
1630 :variable-document
1631 "*Alist of group regexps and correspondent to-lists."
e79f14a4 1632 :variable-group gnus-group-parameter
23f87bed
MB
1633 :parameter-type '(gnus-email-address :tag "To List")
1634 :parameter-document "\
1635This address will be used when doing a `a' in the group.
1636
1637It is totally ignored when doing a followup--except that if it is
1638present in a news group, you'll get mail group semantics when doing
1639`f'.
1640
1641The gnus-group-split mail splitting mechanism will behave as if this
1642address was listed in gnus-group-split Addresses (see below).")
1643
1644(gnus-define-group-parameter
1645 subscribed
1646 :type bool
1647 :function-document
1648 "Return GROUP's subscription status."
1649 :variable-document
1650 "*Groups which are automatically considered subscribed."
e79f14a4 1651 :variable-group gnus-group-parameter
23f87bed
MB
1652 :parameter-type '(const :tag "Subscribed" t)
1653 :parameter-document "\
1654Gnus assumed that you are subscribed to the To/List address.
1655
1656When constructing a list of subscribed groups using
1657`gnus-find-subscribed-addresses', Gnus includes the To address given
1658above, or the list address (if the To address has not been set).")
1659
1660(gnus-define-group-parameter
1661 auto-expire
1662 :type bool
1663 :function gnus-group-auto-expirable-p
1664 :function-document
1665 "Check whether GROUP is auto-expirable or not."
1666 :variable gnus-auto-expirable-newsgroups
1667 :variable-default nil
1668 :variable-document
1669 "*Groups in which to automatically mark read articles as expirable.
eec82323
LMI
1670If non-nil, this should be a regexp that should match all groups in
1671which to perform auto-expiry. This only makes sense for mail groups."
23f87bed
MB
1672 :variable-group nnmail-expire
1673 :variable-type '(choice (const nil)
1674 regexp)
1675 :parameter-type '(const :tag "Automatic Expire" t)
1676 :parameter-document
1677 "All articles that are read will be marked as expirable.")
1678
1679(gnus-define-group-parameter
1680 total-expire
1681 :type bool
1682 :function gnus-group-total-expirable-p
1683 :function-document
1684 "Check whether GROUP is total-expirable or not."
1685 :variable gnus-total-expirable-newsgroups
1686 :variable-default nil
1687 :variable-document
1688 "*Groups in which to perform expiry of all read articles.
eec82323
LMI
1689Use with extreme caution. All groups that match this regexp will be
1690expiring - which means that all read articles will be deleted after
1691\(say) one week. (This only goes for mail groups and the like, of
1692course.)"
23f87bed
MB
1693 :variable-group nnmail-expire
1694 :variable-type '(choice (const nil)
1695 regexp)
1696 :parameter-type '(const :tag "Total Expire" t)
1697 :parameter-document
1698 "All read articles will be put through the expiry process
1699
1700This happens even if they are not marked as expirable.
1701Use with caution.")
1702
1703(gnus-define-group-parameter
1704 charset
1705 :function-document
1706 "Return the default charset of GROUP."
1707 :variable gnus-group-charset-alist
1708 :variable-default
1709 '(("\\(^\\|:\\)hk\\>\\|\\(^\\|:\\)tw\\>\\|\\<big5\\>" cn-big5)
1710 ("\\(^\\|:\\)cn\\>\\|\\<chinese\\>" cn-gb-2312)
1711 ("\\(^\\|:\\)fj\\>\\|\\(^\\|:\\)japan\\>" iso-2022-jp-2)
1712 ("\\(^\\|:\\)tnn\\>\\|\\(^\\|:\\)pin\\>\\|\\(^\\|:\\)sci.lang.japan" iso-2022-7bit)
1713 ("\\(^\\|:\\)relcom\\>" koi8-r)
1714 ("\\(^\\|:\\)fido7\\>" koi8-r)
1715 ("\\(^\\|:\\)\\(cz\\|hun\\|pl\\|sk\\|hr\\)\\>" iso-8859-2)
1716 ("\\(^\\|:\\)israel\\>" iso-8859-1)
1717 ("\\(^\\|:\\)han\\>" euc-kr)
1718 ("\\(^\\|:\\)alt.chinese.text.big5\\>" chinese-big5)
1719 ("\\(^\\|:\\)soc.culture.vietnamese\\>" vietnamese-viqr)
1720 ("\\(^\\|:\\)\\(comp\\|rec\\|alt\\|sci\\|soc\\|news\\|gnu\\|bofh\\)\\>" iso-8859-1))
1721 :variable-document
1722 "Alist of regexps (to match group names) and default charsets to be used when reading."
1723 :variable-group gnus-charset
1724 :variable-type '(repeat (list (regexp :tag "Group")
1725 (symbol :tag "Charset")))
1726 :parameter-type '(symbol :tag "Charset")
1727 :parameter-document "\
1728The default charset to use in the group.")
1729
1730(gnus-define-group-parameter
1731 post-method
1732 :type list
1733 :function-document
1734 "Return a posting method for GROUP."
1735 :variable gnus-post-method-alist
1736 :variable-document
1737 "Alist of regexps (to match group names) and method to be used when
1738posting an article."
1739 :variable-group gnus-group-foreign
1740 :parameter-type
1741 '(choice :tag "Posting Method"
1742 (const :tag "Use native server" native)
1743 (const :tag "Use current server" current)
1744 (list :convert-widget
1745 (lambda (widget)
1746 (list 'sexp :tag "Methods"
1747 :value gnus-select-method))))
1748 :parameter-document
1749 "Posting method for this group.")
1750
1751(gnus-define-group-parameter
1752 large-newsgroup-initial
1753 :type integer
1754 :function-document
1755 "Return GROUP's initial input of the number of articles."
1756 :variable-document
1757 "*Alist of group regexps and its initial input of the number of articles."
e79f14a4 1758 :variable-group gnus-group-parameter
23f87bed
MB
1759 :parameter-type '(choice :tag "Initial Input for Large Newsgroup"
1760 (const :tag "All" nil)
1761 (integer))
1762 :parameter-document "\
1763
1764This number will be prompted as the initial value of the number of
1765articles to list when the group is a large newsgroup (see
1766`gnus-large-newsgroup'). If it is nil, the default value is the
1767total number of articles in the group.")
1768
1769;; The Gnus registry's ignored groups
1770(gnus-define-group-parameter
1771 registry-ignore
1772 :type list
1773 :function-document
1774 "Whether this group should be ignored by the registry."
1775 :variable gnus-registry-ignored-groups
1776 :variable-default nil
1777 :variable-document
1778 "*Groups in which the registry should be turned off."
1779 :variable-group gnus-registry
1780 :variable-type '(repeat
1781 (list
1782 (regexp :tag "Group Name Regular Expression")
1783 (boolean :tag "Ignored")))
1784
1785 :parameter-type '(boolean :tag "Group Ignored by the Registry")
1786 :parameter-document
1787 "Whether the Gnus Registry should ignore this group.")
1788
1789;; group parameters for spam processing added by Ted Zlatanov <tzz@lifelogs.com>
1790(defcustom gnus-install-group-spam-parameters t
1791 "*Disable the group parameters for spam detection.
1792Enable if `G c' in XEmacs is giving you trouble, and make sure to submit a bug report."
e2642250 1793 :version "21.4"
23f87bed
MB
1794 :type 'boolean
1795 :group 'gnus-start)
1796
1797(when gnus-install-group-spam-parameters
1798 (defvar gnus-group-spam-classification-spam t
1799 "Spam group classification (requires spam.el).
1800This group contains spam messages. On summary entry, unread messages
1801will be marked as spam. On summary exit, the specified spam
1802processors will be invoked on spam-marked messages, then those
1803messages will be expired, so the spam processor will only see a
1804spam-marked message once.")
1805
1806 (defvar gnus-group-spam-classification-ham 'ask
1807 "The ham value for the spam group parameter (requires spam.el).
1808On summary exit, the specified ham processors will be invoked on
1809ham-marked messages. Exercise caution, since the ham processor will
1810see the same message more than once because there is no ham message
1811registry.")
1812
1813 (gnus-define-group-parameter
1814 spam-contents
1815 :type list
1816 :function-document
1817 "The spam type (spam, ham, or neither) of the group."
1818 :variable gnus-spam-newsgroup-contents
1819 :variable-default nil
1820 :variable-document
1821 "*Groups in which to automatically mark new articles as spam on
1822summary entry. If non-nil, this should be a list of group name
1823regexps that should match all groups in which to do automatic spam
1824tagging, associated with a classification (spam, ham, or neither).
1825This only makes sense for mail groups."
1826 :variable-group spam
1827 :variable-type '(repeat
1828 (list :tag "Group contents spam/ham classification"
1829 (regexp :tag "Group")
1830 (choice
1831 (variable-item gnus-group-spam-classification-spam)
1832 (variable-item gnus-group-spam-classification-ham)
1833 (const :tag "Unclassified" nil))))
1834
1835 :parameter-type '(list :tag "Group contents spam/ham classification"
1836 (choice :tag "Group contents classification for spam sorting"
1837 (variable-item gnus-group-spam-classification-spam)
1838 (variable-item gnus-group-spam-classification-ham)
1839 (const :tag "Unclassified" nil)))
1840 :parameter-document
1841 "The spam classification (spam, ham, or neither) of this group.
1842When a spam group is entered, all unread articles are marked as spam.")
1843
1844 (defvar gnus-group-spam-exit-processor-ifile "ifile"
1845 "OBSOLETE: The ifile summary exit spam processor.")
1846
1847 (defvar gnus-group-spam-exit-processor-stat "stat"
1848 "OBSOLETE: The spam-stat summary exit spam processor.")
1849
1850 (defvar gnus-group-spam-exit-processor-bogofilter "bogofilter"
1851 "OBSOLETE: The Bogofilter summary exit spam processor.")
1852
1853 (defvar gnus-group-spam-exit-processor-blacklist "blacklist"
1854 "OBSOLETE: The Blacklist summary exit spam processor.")
1855
1856 (defvar gnus-group-spam-exit-processor-report-gmane "report-gmane"
1857 "OBSOLETE: The Gmane reporting summary exit spam processor.
1858Only applicable to NNTP groups with articles from Gmane. See spam-report.el")
1859
1860 (defvar gnus-group-spam-exit-processor-spamoracle "spamoracle-spam"
1861 "OBSOLETE: The spamoracle summary exit spam processor.")
1862
1863 (defvar gnus-group-ham-exit-processor-ifile "ifile-ham"
1864 "OBSOLETE: The ifile summary exit ham processor.
1865Only applicable to non-spam (unclassified and ham) groups.")
1866
1867 (defvar gnus-group-ham-exit-processor-bogofilter "bogofilter-ham"
1868 "OBSOLETE: The Bogofilter summary exit ham processor.
1869Only applicable to non-spam (unclassified and ham) groups.")
1870
1871 (defvar gnus-group-ham-exit-processor-stat "stat-ham"
1872 "OBSOLETE: The spam-stat summary exit ham processor.
1873Only applicable to non-spam (unclassified and ham) groups.")
1874
1875 (defvar gnus-group-ham-exit-processor-whitelist "whitelist"
1876 "OBSOLETE: The whitelist summary exit ham processor.
1877Only applicable to non-spam (unclassified and ham) groups.")
1878
1879 (defvar gnus-group-ham-exit-processor-BBDB "bbdb"
1880 "OBSOLETE: The BBDB summary exit ham processor.
1881Only applicable to non-spam (unclassified and ham) groups.")
1882
1883 (defvar gnus-group-ham-exit-processor-copy "copy"
1884 "OBSOLETE: The ham copy exit ham processor.
1885Only applicable to non-spam (unclassified and ham) groups.")
1886
1887 (defvar gnus-group-ham-exit-processor-spamoracle "spamoracle-ham"
1888 "OBSOLETE: The spamoracle summary exit ham processor.
1889Only applicable to non-spam (unclassified and ham) groups.")
1890
1891 (gnus-define-group-parameter
1892 spam-process
1893 :type list
1894 :parameter-type
1895 '(choice
1896 :tag "Spam Summary Exit Processor"
1897 :value nil
1898 (list :tag "Spam Summary Exit Processor Choices"
1899 (set
1900 (variable-item gnus-group-spam-exit-processor-ifile)
1901 (variable-item gnus-group-spam-exit-processor-stat)
1902 (variable-item gnus-group-spam-exit-processor-bogofilter)
1903 (variable-item gnus-group-spam-exit-processor-blacklist)
1904 (variable-item gnus-group-spam-exit-processor-spamoracle)
1905 (variable-item gnus-group-spam-exit-processor-report-gmane)
1906 (variable-item gnus-group-ham-exit-processor-bogofilter)
1907 (variable-item gnus-group-ham-exit-processor-ifile)
1908 (variable-item gnus-group-ham-exit-processor-stat)
1909 (variable-item gnus-group-ham-exit-processor-whitelist)
1910 (variable-item gnus-group-ham-exit-processor-BBDB)
1911 (variable-item gnus-group-ham-exit-processor-spamoracle)
1912 (variable-item gnus-group-ham-exit-processor-copy)
1913 (const :tag "Spam: Gmane Report" (spam spam-use-gmane))
1914 (const :tag "Spam: Bogofilter" (spam spam-use-bogofilter))
1915 (const :tag "Spam: Blacklist" (spam spam-use-blacklist))
1916 (const :tag "Spam: ifile" (spam spam-use-ifile))
1917 (const :tag "Spam: Spam-stat" (spam spam-use-stat))
1918 (const :tag "Spam: Spam Oracle" (spam spam-use-spamoracle))
1919 (const :tag "Ham: ifile" (ham spam-use-ifile))
1920 (const :tag "Ham: Bogofilter" (ham spam-use-bogofilter))
1921 (const :tag "Ham: Spam-stat" (ham spam-use-stat))
1922 (const :tag "Ham: Whitelist" (ham spam-use-whitelist))
1923 (const :tag "Ham: BBDB" (ham spam-use-BBDB))
1924 (const :tag "Ham: Copy" (ham spam-use-ham-copy))
1925 (const :tag "Ham: Spam Oracle" (ham spam-use-spamoracle)))))
1926 :function-document
1927 "Which spam or ham processors will be applied when the summary is exited."
1928 :variable gnus-spam-process-newsgroups
1929 :variable-default nil
1930 :variable-document
1931 "*Groups in which to automatically process spam or ham articles with
1932a backend on summary exit. If non-nil, this should be a list of group
1933name regexps that should match all groups in which to do automatic
1934spam processing, associated with the appropriate processor."
1935 :variable-group spam
1936 :variable-type
1937 '(repeat :tag "Spam/Ham Processors"
1938 (list :tag "Spam Summary Exit Processor Choices"
1939 (regexp :tag "Group Regexp")
1940 (set
1941 :tag "Spam/Ham Summary Exit Processor"
1942 (variable-item gnus-group-spam-exit-processor-ifile)
1943 (variable-item gnus-group-spam-exit-processor-stat)
1944 (variable-item gnus-group-spam-exit-processor-bogofilter)
1945 (variable-item gnus-group-spam-exit-processor-blacklist)
1946 (variable-item gnus-group-spam-exit-processor-spamoracle)
1947 (variable-item gnus-group-spam-exit-processor-report-gmane)
1948 (variable-item gnus-group-ham-exit-processor-bogofilter)
1949 (variable-item gnus-group-ham-exit-processor-ifile)
1950 (variable-item gnus-group-ham-exit-processor-stat)
1951 (variable-item gnus-group-ham-exit-processor-whitelist)
1952 (variable-item gnus-group-ham-exit-processor-BBDB)
1953 (variable-item gnus-group-ham-exit-processor-spamoracle)
1954 (variable-item gnus-group-ham-exit-processor-copy)
1955 (const :tag "Spam: Gmane Report" (spam spam-use-gmane))
1956 (const :tag "Spam: Bogofilter" (spam spam-use-bogofilter))
1957 (const :tag "Spam: Blacklist" (spam spam-use-blacklist))
1958 (const :tag "Spam: ifile" (spam spam-use-ifile))
1959 (const :tag "Spam: Spam-stat" (spam spam-use-stat))
1960 (const :tag "Spam: Spam Oracle" (spam spam-use-spamoracle))
1961 (const :tag "Ham: ifile" (ham spam-use-ifile))
1962 (const :tag "Ham: Bogofilter" (ham spam-use-bogofilter))
1963 (const :tag "Ham: Spam-stat" (ham spam-use-stat))
1964 (const :tag "Ham: Whitelist" (ham spam-use-whitelist))
1965 (const :tag "Ham: BBDB" (ham spam-use-BBDB))
1966 (const :tag "Ham: Copy" (ham spam-use-ham-copy))
1967 (const :tag "Ham: Spam Oracle" (ham spam-use-spamoracle)))))
1968
1969 :parameter-document
1970 "Which spam or ham processors will be applied when the summary is exited.")
1971
1972 (gnus-define-group-parameter
1973 spam-autodetect
1974 :type list
1975 :parameter-type
1976 '(boolean :tag "Spam autodetection")
1977 :function-document
1978 "Should spam be autodetected (with spam-split) in this group?"
1979 :variable gnus-spam-autodetect
1980 :variable-default nil
1981 :variable-document
1982 "*Groups in which spam should be autodetected when they are entered.
1983 Only unseen articles will be examined, unless
1984 spam-autodetect-recheck-messages is set."
1985 :variable-group spam
1986 :variable-type
1987 '(repeat
1988 :tag "Autodetection setting"
1989 (list
1990 (regexp :tag "Group Regexp")
1991 boolean))
1992 :parameter-document
1993 "Spam autodetection.
1994Only unseen articles will be examined, unless
1995spam-autodetect-recheck-messages is set.")
1996
1997 (gnus-define-group-parameter
1998 spam-autodetect-methods
1999 :type list
2000 :parameter-type
2001 '(choice :tag "Spam autodetection-specific methods"
2002 (const none)
2003 (const default)
2004 (set :tag "Use specific methods"
2005 (variable-item spam-use-blacklist)
2006 (variable-item spam-use-regex-headers)
2007 (variable-item spam-use-regex-body)
2008 (variable-item spam-use-whitelist)
2009 (variable-item spam-use-BBDB)
2010 (variable-item spam-use-ifile)
2011 (variable-item spam-use-spamoracle)
2012 (variable-item spam-use-stat)
2013 (variable-item spam-use-blackholes)
2014 (variable-item spam-use-hashcash)
2015 (variable-item spam-use-bogofilter-headers)
2016 (variable-item spam-use-bogofilter)))
2017 :function-document
2018 "Methods to be used for autodetection in each group"
2019 :variable gnus-spam-autodetect-methods
2020 :variable-default nil
2021 :variable-document
2022 "*Methods for autodetecting spam per group.
2023Requires the spam-autodetect parameter. Only unseen articles
2024will be examined, unless spam-autodetect-recheck-messages is
2025set."
2026 :variable-group spam
2027 :variable-type
2028 '(repeat
2029 :tag "Autodetection methods"
2030 (list
2031 (regexp :tag "Group Regexp")
2032 (choice
2033 (const none)
2034 (const default)
2035 (set :tag "Use specific methods"
2036 (variable-item spam-use-blacklist)
2037 (variable-item spam-use-regex-headers)
2038 (variable-item spam-use-regex-body)
2039 (variable-item spam-use-whitelist)
2040 (variable-item spam-use-BBDB)
2041 (variable-item spam-use-ifile)
2042 (variable-item spam-use-spamoracle)
2043 (variable-item spam-use-stat)
2044 (variable-item spam-use-blackholes)
2045 (variable-item spam-use-hashcash)
2046 (variable-item spam-use-bogofilter-headers)
2047 (variable-item spam-use-bogofilter)))))
2048 :parameter-document
2049 "Spam autodetection methods.
2050Requires the spam-autodetect parameter. Only unseen articles
2051will be examined, unless spam-autodetect-recheck-messages is
2052set.")
2053
2054 (gnus-define-group-parameter
2055 spam-process-destination
2056 :type list
2057 :parameter-type
2058 '(choice :tag "Destination for spam-processed articles at summary exit"
2059 (string :tag "Move to a group")
2060 (repeat :tag "Move to multiple groups"
2061 (string :tag "Destination group"))
2062 (const :tag "Expire" nil))
2063 :function-document
2064 "Where spam-processed articles will go at summary exit."
2065 :variable gnus-spam-process-destinations
2066 :variable-default nil
2067 :variable-document
2068 "*Groups in which to explicitly send spam-processed articles to
2069another group, or expire them (the default). If non-nil, this should
2070be a list of group name regexps that should match all groups in which
2071to do spam-processed article moving, associated with the destination
2072group or nil for explicit expiration. This only makes sense for
2073mail groups."
2074 :variable-group spam
2075 :variable-type
2076 '(repeat
2077 :tag "Spam-processed articles destination"
2078 (list
2079 (regexp :tag "Group Regexp")
2080 (choice
2081 :tag "Destination for spam-processed articles at summary exit"
2082 (string :tag "Move to a group")
2083 (repeat :tag "Move to multiple groups"
2084 (string :tag "Destination group"))
2085 (const :tag "Expire" nil))))
2086 :parameter-document
2087 "Where spam-processed articles will go at summary exit.")
2088
2089 (gnus-define-group-parameter
2090 ham-process-destination
2091 :type list
2092 :parameter-type
2093 '(choice
2094 :tag "Destination for ham articles at summary exit from a spam group"
2095 (string :tag "Move to a group")
2096 (repeat :tag "Move to multiple groups"
2097 (string :tag "Destination group"))
2098 (const :tag "Respool" respool)
2099 (const :tag "Do nothing" nil))
2100 :function-document
2101 "Where ham articles will go at summary exit from a spam group."
2102 :variable gnus-ham-process-destinations
2103 :variable-default nil
2104 :variable-document
2105 "*Groups in which to explicitly send ham articles to
2106another group, or do nothing (the default). If non-nil, this should
2107be a list of group name regexps that should match all groups in which
2108to do ham article moving, associated with the destination
2109group or nil for explicit ignoring. This only makes sense for
2110mail groups, and only works in spam groups."
2111 :variable-group spam
2112 :variable-type
2113 '(repeat
2114 :tag "Ham articles destination"
2115 (list
2116 (regexp :tag "Group Regexp")
2117 (choice
2118 :tag "Destination for ham articles at summary exit from spam group"
2119 (string :tag "Move to a group")
2120 (repeat :tag "Move to multiple groups"
2121 (string :tag "Destination group"))
2122 (const :tag "Respool" respool)
2123 (const :tag "Expire" nil))))
2124 :parameter-document
2125 "Where ham articles will go at summary exit from a spam group.")
2126
2127 (gnus-define-group-parameter
2128 ham-marks
2129 :type 'list
2130 :parameter-type '(list :tag "Ham mark choices"
2131 (set
2132 (variable-item gnus-del-mark)
2133 (variable-item gnus-read-mark)
2134 (variable-item gnus-ticked-mark)
2135 (variable-item gnus-killed-mark)
2136 (variable-item gnus-kill-file-mark)
2137 (variable-item gnus-low-score-mark)))
2138
2139 :parameter-document
2140 "Marks considered ham (positively not spam). Such articles will be
2141processed as ham (non-spam) on group exit. When nil, the global
2142spam-ham-marks variable takes precedence."
2143 :variable-default '((".*" ((gnus-del-mark
2144 gnus-read-mark
2145 gnus-killed-mark
2146 gnus-kill-file-mark
2147 gnus-low-score-mark))))
2148 :variable-group spam
2149 :variable-document
2150 "*Groups in which to explicitly set the ham marks to some value.")
2151
2152 (gnus-define-group-parameter
2153 spam-marks
2154 :type 'list
2155 :parameter-type '(list :tag "Spam mark choices"
2156 (set
2157 (variable-item gnus-spam-mark)
2158 (variable-item gnus-killed-mark)
2159 (variable-item gnus-kill-file-mark)
2160 (variable-item gnus-low-score-mark)))
2161
2162 :parameter-document
2163 "Marks considered spam.
2164Such articles will be processed as spam on group exit. When nil, the global
2165spam-spam-marks variable takes precedence."
2166 :variable-default '((".*" ((gnus-spam-mark))))
2167 :variable-group spam
2168 :variable-document
2169 "*Groups in which to explicitly set the spam marks to some value."))
eec82323
LMI
2170
2171(defcustom gnus-group-uncollapsed-levels 1
2172 "Number of group name elements to leave alone when making a short group name."
2173 :group 'gnus-group-visual
2174 :type 'integer)
2175
2176(defcustom gnus-group-use-permanent-levels nil
2177 "*If non-nil, once you set a level, Gnus will use this level."
2178 :group 'gnus-group-levels
2179 :type 'boolean)
2180
2181;; Hooks.
2182
2183(defcustom gnus-load-hook nil
2184 "A hook run while Gnus is loaded."
2185 :group 'gnus-start
2186 :type 'hook)
2187
2188(defcustom gnus-apply-kill-hook '(gnus-apply-kill-file)
2189 "A hook called to apply kill files to a group.
2190This hook is intended to apply a kill file to the selected newsgroup.
2191The function `gnus-apply-kill-file' is called by default.
2192
2193Since a general kill file is too heavy to use only for a few
2194newsgroups, I recommend you to use a lighter hook function. For
2195example, if you'd like to apply a kill file to articles which contains
2196a string `rmgroup' in subject in newsgroup `control', you can use the
2197following hook:
2198
2199 (setq gnus-apply-kill-hook
2200 (list
2201 (lambda ()
2202 (cond ((string-match \"control\" gnus-newsgroup-name)
2203 (gnus-kill \"Subject\" \"rmgroup\")
2204 (gnus-expunge \"X\"))))))"
2205 :group 'gnus-score-kill
2206 :options '(gnus-apply-kill-file)
2207 :type 'hook)
2208
2209(defcustom gnus-group-change-level-function nil
2210 "Function run when a group level is changed.
2211It is called with three parameters -- GROUP, LEVEL and OLDLEVEL."
16409b0b 2212 :group 'gnus-group-levels
eec82323
LMI
2213 :type 'function)
2214
2215;;; Face thingies.
2216
2217(defcustom gnus-visual
2218 '(summary-highlight group-highlight article-highlight
2219 mouse-face
2220 summary-menu group-menu article-menu
2221 tree-highlight menu highlight
2222 browse-menu server-menu
2223 page-marker tree-menu binary-menu pick-menu
2224 grouplens-menu)
6748645f 2225 "*Enable visual features.
eec82323
LMI
2226If `visual' is disabled, there will be no menus and few faces. Most of
2227the visual customization options below will be ignored. Gnus will use
2228less space and be faster as a result.
2229
2230This variable can also be a list of visual elements to switch on. For
2231instance, to switch off all visual things except menus, you can say:
2232
2233 (setq gnus-visual '(menu))
2234
2235Valid elements include `summary-highlight', `group-highlight',
2236`article-highlight', `mouse-face', `summary-menu', `group-menu',
2237`article-menu', `tree-highlight', `menu', `highlight', `browse-menu',
2238`server-menu', `page-marker', `tree-menu', `binary-menu', `pick-menu',
2239and `grouplens-menu'."
2240 :group 'gnus-meta
2241 :group 'gnus-visual
2242 :type '(set (const summary-highlight)
2243 (const group-highlight)
2244 (const article-highlight)
2245 (const mouse-face)
2246 (const summary-menu)
2247 (const group-menu)
2248 (const article-menu)
2249 (const tree-highlight)
2250 (const menu)
2251 (const highlight)
2252 (const browse-menu)
2253 (const server-menu)
2254 (const page-marker)
2255 (const tree-menu)
2256 (const binary-menu)
2257 (const pick-menu)
2258 (const grouplens-menu)))
2259
23f87bed
MB
2260;; Byte-compiler warning.
2261(defvar gnus-visual)
2262;; Find out whether the gnus-visual TYPE is wanted.
2263(defun gnus-visual-p (&optional type class)
2264 (and gnus-visual ; Has to be non-nil, at least.
2265 (if (not type) ; We don't care about type.
2266 gnus-visual
2267 (if (listp gnus-visual) ; It's a list, so we check it.
2268 (or (memq type gnus-visual)
2269 (memq class gnus-visual))
2270 t))))
2271
eec82323
LMI
2272(defcustom gnus-mouse-face
2273 (condition-case ()
2274 (if (gnus-visual-p 'mouse-face 'highlight)
2275 (if (boundp 'gnus-mouse-face)
2276 (or gnus-mouse-face 'highlight)
2277 'highlight)
2278 'default)
2279 (error 'highlight))
6748645f 2280 "*Face used for group or summary buffer mouse highlighting.
eec82323
LMI
2281The line beneath the mouse pointer will be highlighted with this
2282face."
2283 :group 'gnus-visual
2284 :type 'face)
2285
eec82323
LMI
2286(defcustom gnus-article-save-directory gnus-directory
2287 "*Name of the directory articles will be saved in (default \"~/News\")."
2288 :group 'gnus-article-saving
2289 :type 'directory)
2290
6748645f
LMI
2291(defvar gnus-plugged t
2292 "Whether Gnus is plugged or not.")
2293
23f87bed
MB
2294(defcustom gnus-agent-cache t
2295 "Controls use of the agent cache while plugged.
2296When set, Gnus will prefer using the locally stored content rather
2297than re-fetching it from the server. You also need to enable
2298`gnus-agent' for this to have any affect."
a08b59c9 2299 :version "21.4"
23f87bed
MB
2300 :group 'gnus-agent
2301 :type 'boolean)
2302
2303(defcustom gnus-default-charset 'undecided
16409b0b
GM
2304 "Default charset assumed to be used when viewing non-ASCII characters.
2305This variable is overridden on a group-to-group basis by the
23f87bed 2306`gnus-group-charset-alist' variable and is only used on groups not
16409b0b
GM
2307covered by that variable."
2308 :type 'symbol
2309 :group 'gnus-charset)
2310
23f87bed
MB
2311;; Fixme: Doc reference to agent.
2312(defcustom gnus-agent t
2313 "Whether we want to use the Gnus agent or not.
2314
2315You may customize gnus-agent to disable its use. However, some
2316back ends have started to use the agent as a client-side cache.
2317Disabling the agent may result in noticeable loss of performance."
a08b59c9 2318 :version "21.4"
23f87bed
MB
2319 :group 'gnus-agent
2320 :type 'boolean)
2321
2322(defcustom gnus-other-frame-function 'gnus
2323 "Function called by the command `gnus-other-frame'."
2324 :group 'gnus-start
2325 :type '(choice (function-item gnus)
2326 (function-item gnus-no-server)
2327 (function-item gnus-slave)
2328 (function-item gnus-slave-no-server)))
2329
2330(defcustom gnus-other-frame-parameters nil
2331 "Frame parameters used by `gnus-other-frame' to create a Gnus frame.
2332This should be an alist for Emacs, or a plist for XEmacs."
2333 :group 'gnus-start
2334 :type (if (featurep 'xemacs)
2335 '(repeat (list :inline t :format "%v"
2336 (symbol :tag "Property")
2337 (sexp :tag "Value")))
2338 '(repeat (cons :format "%v"
2339 (symbol :tag "Parameter")
2340 (sexp :tag "Value")))))
2341
2342(defcustom gnus-user-agent 'emacs-gnus-type
2343 "Which information should be exposed in the User-Agent header.
2344
2345It can be one of the symbols `gnus' \(show only Gnus version\), `emacs-gnus'
2346\(show only Emacs and Gnus versions\), `emacs-gnus-config' \(same as
2347`emacs-gnus' plus system configuration\), `emacs-gnus-type' \(same as
2348`emacs-gnus' plus system type\) or a custom string. If you set it to a
2349string, be sure to use a valid format, see RFC 2616."
a08b59c9 2350 :version "21.4"
23f87bed
MB
2351 :group 'gnus-message
2352 :type '(choice
2353 (item :tag "Show Gnus and Emacs versions and system type"
2354 emacs-gnus-type)
2355 (item :tag "Show Gnus and Emacs versions and system configuration"
2356 emacs-gnus-config)
2357 (item :tag "Show Gnus and Emacs versions" emacs-gnus)
2358 (item :tag "Show only Gnus version" gnus)
2359 (string :tag "Other")))
16409b0b 2360
eec82323
LMI
2361\f
2362;;; Internal variables
2363
48df946a 2364(defvar gnus-agent-gcc-header "X-Gnus-Agent-Gcc")
16409b0b 2365(defvar gnus-agent-meta-information-header "X-Gnus-Agent-Meta-Information")
23f87bed
MB
2366(defvar gnus-agent-method-p-cache nil
2367 ; Reset each time gnus-agent-covered-methods is changed else
2368 ; gnus-agent-method-p may mis-report a methods status.
2369 )
2370(defvar gnus-agent-target-move-group-header "X-Gnus-Agent-Move-To")
2371(defvar gnus-draft-meta-information-header "X-Draft-From")
eec82323
LMI
2372(defvar gnus-group-get-parameter-function 'gnus-group-get-parameter)
2373(defvar gnus-original-article-buffer " *Original Article*")
2374(defvar gnus-newsgroup-name nil)
6748645f 2375(defvar gnus-ephemeral-servers nil)
23f87bed 2376(defvar gnus-server-method-cache nil)
6748645f 2377
48df946a
DL
2378(defvar gnus-agent-fetching nil
2379 "Whether Gnus agent is in fetching mode.")
2380
23f87bed
MB
2381(defvar gnus-agent-covered-methods nil
2382 "A list of servers, NOT methods, showing which servers are covered by the agent.")
2383
6748645f 2384(defvar gnus-command-method nil
23f87bed 2385 "Dynamically bound variable that says what the current back end is.")
eec82323
LMI
2386
2387(defvar gnus-current-select-method nil
2388 "The current method for selecting a newsgroup.")
2389
2390(defvar gnus-tree-buffer "*Tree*"
2391 "Buffer where Gnus thread trees are displayed.")
2392
2393;; Dummy variable.
2394(defvar gnus-use-generic-from nil)
2395
2396;; Variable holding the user answers to all method prompts.
2397(defvar gnus-method-history nil)
eec82323
LMI
2398
2399;; Variable holding the user answers to all mail method prompts.
2400(defvar gnus-mail-method-history nil)
2401
2402;; Variable holding the user answers to all group prompts.
2403(defvar gnus-group-history nil)
2404
2405(defvar gnus-server-alist nil
2406 "List of available servers.")
2407
6748645f
LMI
2408(defcustom gnus-cache-directory
2409 (nnheader-concat gnus-directory "cache/")
2410 "*The directory where cached articles will be stored."
2411 :group 'gnus-cache
2412 :type 'directory)
2413
eec82323
LMI
2414(defvar gnus-predefined-server-alist
2415 `(("cache"
6748645f
LMI
2416 nnspool "cache"
2417 (nnspool-spool-directory ,gnus-cache-directory)
2418 (nnspool-nov-directory ,gnus-cache-directory)
2419 (nnspool-active-file
2420 ,(nnheader-concat gnus-cache-directory "active"))))
eec82323
LMI
2421 "List of predefined (convenience) servers.")
2422
23f87bed 2423(defvar gnus-topic-indentation "") ;; Obsolete variable.
eec82323
LMI
2424
2425(defconst gnus-article-mark-lists
2426 '((marked . tick) (replied . reply)
2427 (expirable . expire) (killed . killed)
2428 (bookmarks . bookmark) (dormant . dormant)
2429 (scored . score) (saved . save)
6748645f 2430 (cached . cache) (downloadable . download)
23f87bed
MB
2431 (unsendable . unsend) (forwarded . forward)
2432 (recent . recent) (seen . seen)))
2433
2434(defconst gnus-article-special-mark-lists
2435 '((seen range)
2436 (killed range)
2437 (bookmark tuple)
2438 (score tuple)))
2439
2440;; Propagate flags to server, with the following exceptions:
2441;; `seen' is private to each gnus installation
2442;; `cache' is a internal gnus flag for each gnus installation
2443;; `download' is a agent flag private to each gnus installation
2444;; `unsend' are for nndraft groups only
2445;; `score' is not a proper mark
2446;; `bookmark': don't propagated it, or fix the bug in update-mark.
2447(defconst gnus-article-unpropagated-mark-lists
2448 '(seen cache download unsend score bookmark)
2449 "Marks that shouldn't be propagated to back ends.
2450Typical marks are those that make no sense in a standalone back end,
2451such as a mark that says whether an article is stored in the cache
2452\(which doesn't make sense in a standalone back end).")
eec82323
LMI
2453
2454(defvar gnus-headers-retrieved-by nil)
2455(defvar gnus-article-reply nil)
2456(defvar gnus-override-method nil)
2457(defvar gnus-article-check-size nil)
2458(defvar gnus-opened-servers nil)
2459
2460(defvar gnus-current-kill-article nil)
2461
2462(defvar gnus-have-read-active-file nil)
2463
2464(defconst gnus-maintainer
2465 "bugs@gnus.org (The Gnus Bugfixing Girls + Boys)"
2466 "The mail address of the Gnus maintainers.")
2467
2468(defvar gnus-info-nodes
23f87bed
MB
2469 '((gnus-group-mode "(gnus)Group Buffer")
2470 (gnus-summary-mode "(gnus)Summary Buffer")
2471 (gnus-article-mode "(gnus)Article Buffer")
2472 (gnus-server-mode "(gnus)Server Buffer")
eec82323
LMI
2473 (gnus-browse-mode "(gnus)Browse Foreign Server")
2474 (gnus-tree-mode "(gnus)Tree Display"))
2475 "Alist of major modes and related Info nodes.")
2476
2477(defvar gnus-group-buffer "*Group*")
2478(defvar gnus-summary-buffer "*Summary*")
2479(defvar gnus-article-buffer "*Article*")
2480(defvar gnus-server-buffer "*Server*")
2481
eec82323
LMI
2482(defvar gnus-slave nil
2483 "Whether this Gnus is a slave or not.")
2484
2485(defvar gnus-batch-mode nil
2486 "Whether this Gnus is running in batch mode or not.")
2487
2488(defvar gnus-variable-list
2489 '(gnus-newsrc-options gnus-newsrc-options-n
16409b0b
GM
2490 gnus-newsrc-last-checked-date
2491 gnus-newsrc-alist gnus-server-alist
2492 gnus-killed-list gnus-zombie-list
2493 gnus-topic-topology gnus-topic-alist
2494 gnus-format-specs)
eec82323
LMI
2495 "Gnus variables saved in the quick startup file.")
2496
2497(defvar gnus-newsrc-alist nil
2498 "Assoc list of read articles.
23f87bed
MB
2499`gnus-newsrc-hashtb' should be kept so that both hold the same information.")
2500
2501(defvar gnus-registry-alist nil
2502 "Assoc list of registry data.
2503gnus-registry.el will populate this if it's loaded.")
eec82323
LMI
2504
2505(defvar gnus-newsrc-hashtb nil
23f87bed 2506 "Hashtable of `gnus-newsrc-alist'.")
eec82323
LMI
2507
2508(defvar gnus-killed-list nil
2509 "List of killed newsgroups.")
2510
2511(defvar gnus-killed-hashtb nil
23f87bed 2512 "Hash table equivalent of `gnus-killed-list'.")
eec82323
LMI
2513
2514(defvar gnus-zombie-list nil
2515 "List of almost dead newsgroups.")
2516
2517(defvar gnus-description-hashtb nil
2518 "Descriptions of newsgroups.")
2519
2520(defvar gnus-list-of-killed-groups nil
2521 "List of newsgroups that have recently been killed by the user.")
2522
2523(defvar gnus-active-hashtb nil
2524 "Hashtable of active articles.")
2525
2526(defvar gnus-moderated-hashtb nil
2527 "Hashtable of moderated newsgroups.")
2528
2529;; Save window configuration.
2530(defvar gnus-prev-winconf nil)
2531
2532(defvar gnus-reffed-article-number nil)
2533
2534;;; Let the byte-compiler know that we know about this variable.
2535(defvar rmail-default-rmail-file)
2536
2537(defvar gnus-dead-summary nil)
2538
16409b0b
GM
2539(defvar gnus-invalid-group-regexp "[: `'\"/]\\|^$"
2540 "Regexp matching invalid groups.")
2541
23f87bed
MB
2542(defvar gnus-other-frame-object nil
2543 "A frame object which will be created by `gnus-other-frame'.")
2544
eec82323
LMI
2545;;; End of variables.
2546
2547;; Define some autoload functions Gnus might use.
2548(eval-and-compile
2549
2550 ;; This little mapcar goes through the list below and marks the
2551 ;; symbols in question as autoloaded functions.
2552 (mapcar
2553 (lambda (package)
2554 (let ((interactive (nth 1 (memq ':interactive package))))
2555 (mapcar
2556 (lambda (function)
2557 (let (keymap)
2558 (when (consp function)
2559 (setq keymap (car (memq 'keymap function)))
2560 (setq function (car function)))
16409b0b
GM
2561 (unless (fboundp function)
2562 (autoload function (car package) nil interactive keymap))))
eec82323 2563 (if (eq (nth 1 package) ':interactive)
16409b0b 2564 (nthcdr 3 package)
eec82323 2565 (cdr package)))))
16409b0b 2566 '(("info" :interactive t Info-goto-node)
ceaed79b 2567 ("pp" pp-to-string)
16409b0b 2568 ("qp" quoted-printable-decode-region quoted-printable-decode-string)
eec82323 2569 ("ps-print" ps-print-preprint)
eec82323
LMI
2570 ("message" :interactive t
2571 message-send-and-exit message-yank-original)
16409b0b
GM
2572 ("babel" babel-as-string)
2573 ("nnmail" nnmail-split-fancy nnmail-article-group)
eec82323 2574 ("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers)
16409b0b 2575 ("rmailout" rmail-output rmail-output-to-rmail-file)
eec82323 2576 ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages
6748645f
LMI
2577 rmail-show-message rmail-summary-exists
2578 rmail-select-summary rmail-update-summary)
eec82323
LMI
2579 ("gnus-audio" :interactive t gnus-audio-play)
2580 ("gnus-xmas" gnus-xmas-splash)
2581 ("gnus-soup" :interactive t
2582 gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article
2583 gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet)
2584 ("nnsoup" nnsoup-pack-replies)
2585 ("score-mode" :interactive t gnus-score-mode)
2586 ("gnus-mh" gnus-summary-save-article-folder
2587 gnus-Folder-save-name gnus-folder-save-name)
2588 ("gnus-mh" :interactive t gnus-summary-save-in-folder)
2589 ("gnus-demon" gnus-demon-add-nocem gnus-demon-add-scanmail
2590 gnus-demon-add-rescan gnus-demon-add-scan-timestamps
2591 gnus-demon-add-disconnection gnus-demon-add-handler
2592 gnus-demon-remove-handler)
2593 ("gnus-demon" :interactive t
2594 gnus-demon-init gnus-demon-cancel)
23f87bed
MB
2595 ("gnus-fun" gnus-convert-gray-x-face-to-xpm gnus-display-x-face-in-from
2596 gnus-convert-image-to-gray-x-face gnus-convert-face-to-png
2597 gnus-face-from-file)
eec82323
LMI
2598 ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree
2599 gnus-tree-open gnus-tree-close gnus-carpal-setup-buffer)
2600 ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close
2601 gnus-nocem-unwanted-article-p)
6748645f
LMI
2602 ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info
2603 gnus-server-server-name)
eec82323
LMI
2604 ("gnus-srvr" gnus-browse-foreign-server)
2605 ("gnus-cite" :interactive t
2606 gnus-article-highlight-citation gnus-article-hide-citation-maybe
2607 gnus-article-hide-citation gnus-article-fill-cited-article
2608 gnus-article-hide-citation-in-followups)
2609 ("gnus-kill" gnus-kill gnus-apply-kill-file-internal
2610 gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author
16409b0b 2611 gnus-execute gnus-expunge gnus-batch-kill gnus-batch-score)
eec82323
LMI
2612 ("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers
2613 gnus-cache-possibly-remove-articles gnus-cache-request-article
2614 gnus-cache-retrieve-headers gnus-cache-possibly-alter-active
2615 gnus-cache-enter-remove-article gnus-cached-article-p
16409b0b
GM
2616 gnus-cache-open gnus-cache-close gnus-cache-update-article
2617 gnus-cache-articles-in-group)
2618 ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article
2619 gnus-cache-remove-article gnus-summary-insert-cached-articles)
2620 ("gnus-score" :interactive t
2621 gnus-summary-increase-score gnus-summary-set-score
2622 gnus-summary-raise-thread gnus-summary-raise-same-subject
2623 gnus-summary-raise-score gnus-summary-raise-same-subject-and-select
2624 gnus-summary-lower-thread gnus-summary-lower-same-subject
2625 gnus-summary-lower-score gnus-summary-lower-same-subject-and-select
2626 gnus-summary-current-score gnus-score-delta-default
2627 gnus-score-flush-cache gnus-score-close
2628 gnus-possibly-score-headers gnus-score-followup-article
2629 gnus-score-followup-thread)
2630 ("gnus-score"
2631 (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers
eec82323
LMI
2632 gnus-current-score-file-nondirectory gnus-score-adaptive
2633 gnus-score-find-trace gnus-score-file-name)
2634 ("gnus-cus" :interactive t gnus-group-customize gnus-score-customize)
2635 ("gnus-topic" :interactive t gnus-topic-mode)
16409b0b
GM
2636 ("gnus-topic" gnus-topic-remove-group gnus-topic-set-parameters
2637 gnus-subscribe-topics)
eec82323
LMI
2638 ("gnus-salt" :interactive t gnus-pick-mode gnus-binary-mode)
2639 ("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap))
2640 ("gnus-uu" :interactive t
2641 gnus-uu-digest-mail-forward gnus-uu-digest-post-forward
2642 gnus-uu-mark-series gnus-uu-mark-region gnus-uu-mark-buffer
2643 gnus-uu-mark-by-regexp gnus-uu-mark-all
2644 gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu
2645 gnus-uu-decode-uu-and-save gnus-uu-decode-unshar
2646 gnus-uu-decode-unshar-and-save gnus-uu-decode-save
2647 gnus-uu-decode-binhex gnus-uu-decode-uu-view
2648 gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view
2649 gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view
6748645f 2650 gnus-uu-decode-binhex-view gnus-uu-unmark-thread
16409b0b
GM
2651 gnus-uu-mark-over gnus-uu-post-news)
2652 ("gnus-uu" gnus-uu-delete-work-dir gnus-uu-unmark-thread)
eec82323
LMI
2653 ("gnus-msg" (gnus-summary-send-map keymap)
2654 gnus-article-mail gnus-copy-article-buffer gnus-extended-version)
2655 ("gnus-msg" :interactive t
23f87bed
MB
2656 gnus-group-post-news gnus-group-mail gnus-group-news
2657 gnus-summary-post-news gnus-summary-news-other-window
eec82323
LMI
2658 gnus-summary-followup gnus-summary-followup-with-original
2659 gnus-summary-cancel-article gnus-summary-supersede-article
2660 gnus-post-news gnus-summary-reply gnus-summary-reply-with-original
2661 gnus-summary-mail-forward gnus-summary-mail-other-window
2662 gnus-summary-resend-message gnus-summary-resend-bounced-mail
6748645f
LMI
2663 gnus-summary-wide-reply gnus-summary-followup-to-mail
2664 gnus-summary-followup-to-mail-with-original gnus-bug
2665 gnus-summary-wide-reply-with-original
2666 gnus-summary-post-forward gnus-summary-wide-reply-with-original
2667 gnus-summary-post-forward)
23f87bed 2668 ("gnus-picon" :interactive t gnus-treat-from-picon)
eec82323
LMI
2669 ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p
2670 gnus-grouplens-mode)
23f87bed 2671 ("smiley" :interactive t smiley-region)
eec82323
LMI
2672 ("gnus-win" gnus-configure-windows gnus-add-configuration)
2673 ("gnus-sum" gnus-summary-insert-line gnus-summary-read-group
2674 gnus-list-of-unread-articles gnus-list-of-read-articles
2675 gnus-offer-save-summaries gnus-make-thread-indent-array
6748645f
LMI
2676 gnus-summary-exit gnus-update-read-articles gnus-summary-last-subject
2677 gnus-summary-skip-intangible gnus-summary-article-number
2678 gnus-data-header gnus-data-find)
eec82323
LMI
2679 ("gnus-group" gnus-group-insert-group-line gnus-group-quit
2680 gnus-group-list-groups gnus-group-first-unread-group
2681 gnus-group-set-mode-line gnus-group-set-info gnus-group-save-newsrc
2682 gnus-group-setup-buffer gnus-group-get-new-news
6748645f 2683 gnus-group-make-help-group gnus-group-update-group
16409b0b 2684 gnus-group-iterate gnus-group-group-name)
eec82323
LMI
2685 ("gnus-bcklg" gnus-backlog-request-article gnus-backlog-enter-article
2686 gnus-backlog-remove-article)
2687 ("gnus-art" gnus-article-read-summary-keys gnus-article-save
2688 gnus-article-prepare gnus-article-set-window-start
2689 gnus-article-next-page gnus-article-prev-page
2690 gnus-request-article-this-buffer gnus-article-mode
2691 gnus-article-setup-buffer gnus-narrow-to-page
16409b0b 2692 gnus-article-delete-invisible-text gnus-treat-article)
eec82323
LMI
2693 ("gnus-art" :interactive t
2694 gnus-article-hide-headers gnus-article-hide-boring-headers
16409b0b 2695 gnus-article-treat-overstrike
eec82323
LMI
2696 gnus-article-remove-cr gnus-article-remove-trailing-blank-lines
2697 gnus-article-display-x-face gnus-article-de-quoted-unreadable
16409b0b
GM
2698 gnus-article-de-base64-unreadable
2699 gnus-article-decode-HZ
2700 gnus-article-wash-html
23f87bed 2701 gnus-article-unsplit-urls
eec82323
LMI
2702 gnus-article-hide-pem gnus-article-hide-signature
2703 gnus-article-strip-leading-blank-lines gnus-article-date-local
2704 gnus-article-date-original gnus-article-date-lapsed
23f87bed 2705;; gnus-article-show-all-headers
eec82323 2706 gnus-article-edit-mode gnus-article-edit-article
16409b0b
GM
2707 gnus-article-edit-done gnus-article-decode-encoded-words
2708 gnus-start-date-timer gnus-stop-date-timer
2709 gnus-mime-view-all-parts)
eec82323
LMI
2710 ("gnus-int" gnus-request-type)
2711 ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1
6748645f 2712 gnus-dribble-enter gnus-read-init-file gnus-dribble-touch)
eec82323
LMI
2713 ("gnus-dup" gnus-dup-suppress-articles gnus-dup-unsuppress-article
2714 gnus-dup-enter-articles)
2715 ("gnus-range" gnus-copy-sequence)
2716 ("gnus-eform" gnus-edit-form)
2717 ("gnus-move" :interactive t
2718 gnus-group-move-group-to-server gnus-change-server)
2719 ("gnus-logic" gnus-score-advanced)
2720 ("gnus-undo" gnus-undo-mode gnus-undo-register)
2721 ("gnus-async" gnus-async-request-fetched-article gnus-async-prefetch-next
2722 gnus-async-prefetch-article gnus-async-prefetch-remove-group
2723 gnus-async-halt-prefetch)
6748645f
LMI
2724 ("gnus-agent" gnus-open-agent gnus-agent-get-function
2725 gnus-agent-save-groups gnus-agent-save-active gnus-agent-method-p
2726 gnus-agent-get-undownloaded-list gnus-agent-fetch-session
23f87bed
MB
2727 gnus-summary-set-agent-mark gnus-agent-save-group-info
2728 gnus-agent-request-article gnus-agent-retrieve-headers)
6748645f
LMI
2729 ("gnus-agent" :interactive t
2730 gnus-unplugged gnus-agentize gnus-agent-batch)
eec82323 2731 ("gnus-vm" :interactive t gnus-summary-save-in-vm
6748645f 2732 gnus-summary-save-article-vm)
23f87bed
MB
2733 ("compface" uncompface)
2734 ("gnus-draft" :interactive t gnus-draft-mode gnus-group-send-queue)
16409b0b
GM
2735 ("gnus-mlspl" gnus-group-split gnus-group-split-fancy)
2736 ("gnus-mlspl" :interactive t gnus-group-split-setup
23f87bed
MB
2737 gnus-group-split-update)
2738 ("gnus-delay" gnus-delay-initialize))))
eec82323
LMI
2739
2740;;; gnus-sum.el thingies
2741
2742
23f87bed 2743(defcustom gnus-summary-line-format "%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n"
eec82323
LMI
2744 "*The format specification of the lines in the summary buffer.
2745
2746It works along the same lines as a normal formatting string,
2747with some simple extensions.
2748
2749%N Article number, left padded with spaces (string)
2750%S Subject (string)
2751%s Subject if it is at the root of a thread, and \"\" otherwise (string)
2752%n Name of the poster (string)
2753%a Extracted name of the poster (string)
2754%A Extracted address of the poster (string)
2755%F Contents of the From: header (string)
16409b0b 2756%f Contents of the From: or To: headers (string)
eec82323
LMI
2757%x Contents of the Xref: header (string)
2758%D Date of the article (string)
2759%d Date of the article (string) in DD-MMM format
23f87bed 2760%o Date of the article (string) in YYYYMMDD`T'HHMMSS format
eec82323
LMI
2761%M Message-id of the article (string)
2762%r References of the article (string)
2763%c Number of characters in the article (integer)
23f87bed
MB
2764%k Pretty-printed version of the above (string)
2765 For example, \"1.2k\" or \"0.4M\".
eec82323
LMI
2766%L Number of lines in the article (integer)
2767%I Indentation based on thread level (a string of spaces)
23f87bed
MB
2768%B A complex trn-style thread tree (string)
2769 The variables `gnus-sum-thread-*' can be used for customization.
eec82323
LMI
2770%T A string with two possible values: 80 spaces if the article
2771 is on thread level two or larger and 0 spaces on level one
2772%R \"A\" if this article has been replied to, \" \" otherwise (character)
2773%U Status of this article (character, \"R\", \"K\", \"-\" or \" \")
2774%[ Opening bracket (character, \"[\" or \"<\")
2775%] Closing bracket (character, \"]\" or \">\")
2776%> Spaces of length thread-level (string)
2777%< Spaces of length (- 20 thread-level) (string)
2778%i Article score (number)
2779%z Article zcore (character)
2780%t Number of articles under the current thread (number).
2781%e Whether the thread is empty or not (character).
2782%l GroupLens score (string).
2783%V Total thread score (number).
2784%P The line number (number).
6748645f 2785%O Download mark (character).
23f87bed
MB
2786%* If present, indicates desired cursor position
2787 (instead of after first colon).
eec82323
LMI
2788%u User defined specifier. The next character in the format string should
2789 be a letter. Gnus will call the function gnus-user-format-function-X,
2790 where X is the letter following %u. The function will be passed the
2791 current header as argument. The function should return a string, which
2792 will be inserted into the summary just like information from any other
2793 summary specifier.
2794
eec82323
LMI
2795The %U (status), %R (replied) and %z (zcore) specs have to be handled
2796with care. For reasons of efficiency, Gnus will compute what column
2797these characters will end up in, and \"hard-code\" that. This means that
16409b0b 2798it is invalid to have these specs after a variable-length spec. Well,
eec82323
LMI
2799you might not be arrested, but your summary buffer will look strange,
2800which is bad enough.
2801
23f87bed 2802The smart choice is to have these specs as far to the left as
eec82323
LMI
2803possible.
2804
23f87bed
MB
2805This restriction may disappear in later versions of Gnus.
2806
2807General format specifiers can also be used.
2808See Info node `(gnus)Formatting Variables'."
2809 :link '(custom-manual "(gnus)Formatting Variables")
eec82323
LMI
2810 :type 'string
2811 :group 'gnus-summary-format)
2812
2813;;;
2814;;; Skeleton keymaps
2815;;;
2816
2817(defun gnus-suppress-keymap (keymap)
2818 (suppress-keymap keymap)
6748645f 2819 (let ((keys `([backspace] [delete] "\177" "\M-u"))) ;gnus-mouse-2
eec82323
LMI
2820 (while keys
2821 (define-key keymap (pop keys) 'undefined))))
2822
2823(defvar gnus-article-mode-map
16409b0b 2824 (let ((keymap (make-sparse-keymap)))
eec82323
LMI
2825 (gnus-suppress-keymap keymap)
2826 keymap))
2827(defvar gnus-summary-mode-map
2828 (let ((keymap (make-keymap)))
2829 (gnus-suppress-keymap keymap)
2830 keymap))
2831(defvar gnus-group-mode-map
2832 (let ((keymap (make-keymap)))
2833 (gnus-suppress-keymap keymap)
2834 keymap))
2835
2836\f
2837
2838;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
2839;; If you want the cursor to go somewhere else, set these two
2840;; functions in some startup hook to whatever you want.
2841(defalias 'gnus-summary-position-point 'gnus-goto-colon)
2842(defalias 'gnus-group-position-point 'gnus-goto-colon)
2843
2844;;; Various macros and substs.
2845
2846(defun gnus-header-from (header)
2847 (mail-header-from header))
2848
2849(defmacro gnus-gethash (string hashtable)
2850 "Get hash value of STRING in HASHTABLE."
2851 `(symbol-value (intern-soft ,string ,hashtable)))
2852
23f87bed
MB
2853(defmacro gnus-gethash-safe (string hashtable)
2854 "Get hash value of STRING in HASHTABLE.
2855Return nil if not defined."
2856 `(let ((sym (intern-soft ,string ,hashtable)))
2857 (and (boundp sym) (symbol-value sym))))
2858
eec82323
LMI
2859(defmacro gnus-sethash (string value hashtable)
2860 "Set hash value. Arguments are STRING, VALUE, and HASHTABLE."
2861 `(set (intern ,string ,hashtable) ,value))
2862(put 'gnus-sethash 'edebug-form-spec '(form form form))
2863
2864(defmacro gnus-group-unread (group)
2865 "Get the currently computed number of unread articles in GROUP."
2866 `(car (gnus-gethash ,group gnus-newsrc-hashtb)))
2867
2868(defmacro gnus-group-entry (group)
2869 "Get the newsrc entry for GROUP."
2870 `(gnus-gethash ,group gnus-newsrc-hashtb))
2871
2872(defmacro gnus-active (group)
2873 "Get active info on GROUP."
2874 `(gnus-gethash ,group gnus-active-hashtb))
2875
2876(defmacro gnus-set-active (group active)
2877 "Set GROUP's active info."
2878 `(gnus-sethash ,group ,active gnus-active-hashtb))
2879
eec82323
LMI
2880;; Info access macros.
2881
2882(defmacro gnus-info-group (info)
2883 `(nth 0 ,info))
2884(defmacro gnus-info-rank (info)
2885 `(nth 1 ,info))
2886(defmacro gnus-info-read (info)
2887 `(nth 2 ,info))
2888(defmacro gnus-info-marks (info)
2889 `(nth 3 ,info))
2890(defmacro gnus-info-method (info)
2891 `(nth 4 ,info))
2892(defmacro gnus-info-params (info)
2893 `(nth 5 ,info))
2894
2895(defmacro gnus-info-level (info)
2896 `(let ((rank (gnus-info-rank ,info)))
2897 (if (consp rank)
2898 (car rank)
2899 rank)))
2900(defmacro gnus-info-score (info)
2901 `(let ((rank (gnus-info-rank ,info)))
2902 (or (and (consp rank) (cdr rank)) 0)))
2903
2904(defmacro gnus-info-set-group (info group)
2905 `(setcar ,info ,group))
2906(defmacro gnus-info-set-rank (info rank)
2907 `(setcar (nthcdr 1 ,info) ,rank))
2908(defmacro gnus-info-set-read (info read)
2909 `(setcar (nthcdr 2 ,info) ,read))
2910(defmacro gnus-info-set-marks (info marks &optional extend)
2911 (if extend
2912 `(gnus-info-set-entry ,info ,marks 3)
2913 `(setcar (nthcdr 3 ,info) ,marks)))
2914(defmacro gnus-info-set-method (info method &optional extend)
2915 (if extend
2916 `(gnus-info-set-entry ,info ,method 4)
2917 `(setcar (nthcdr 4 ,info) ,method)))
2918(defmacro gnus-info-set-params (info params &optional extend)
2919 (if extend
2920 `(gnus-info-set-entry ,info ,params 5)
2921 `(setcar (nthcdr 5 ,info) ,params)))
2922
2923(defun gnus-info-set-entry (info entry number)
2924 ;; Extend the info until we have enough elements.
2925 (while (<= (length info) number)
2926 (nconc info (list nil)))
2927 ;; Set the entry.
2928 (setcar (nthcdr number info) entry))
2929
2930(defmacro gnus-info-set-level (info level)
2931 `(let ((rank (cdr ,info)))
2932 (if (consp (car rank))
2933 (setcar (car rank) ,level)
2934 (setcar rank ,level))))
2935(defmacro gnus-info-set-score (info score)
2936 `(let ((rank (cdr ,info)))
2937 (if (consp (car rank))
2938 (setcdr (car rank) ,score)
2939 (setcar rank (cons (car rank) ,score)))))
2940
2941(defmacro gnus-get-info (group)
2942 `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb)))
2943
8f688cb0 2944;;; Load the compatibility functions.
eec82323
LMI
2945
2946(require 'gnus-ems)
2947
2948\f
2949;;;
2950;;; Shutdown
2951;;;
2952
2953(defvar gnus-shutdown-alist nil)
2954
2955(defun gnus-add-shutdown (function &rest symbols)
2956 "Run FUNCTION whenever one of SYMBOLS is shut down."
2957 (push (cons function symbols) gnus-shutdown-alist))
2958
2959(defun gnus-shutdown (symbol)
2960 "Shut down everything that waits for SYMBOL."
2961 (let ((alist gnus-shutdown-alist)
2962 entry)
2963 (while (setq entry (pop alist))
2964 (when (memq symbol (cdr entry))
2965 (funcall (car entry))))))
2966
2967\f
2968;;;
2969;;; Gnus Utility Functions
2970;;;
2971
23f87bed
MB
2972(defun gnus-find-subscribed-addresses ()
2973 "Return a regexp matching the addresses of all subscribed mail groups.
2974It consists of the `to-address' or `to-list' parameter of all groups
2975with a `subscribed' parameter."
2976 (let (group address addresses)
2977 (dolist (entry (cdr gnus-newsrc-alist))
2978 (setq group (car entry))
2979 (when (gnus-parameter-subscribed group)
2980 (setq address (mail-strip-quoted-names
2981 (or (gnus-group-fast-parameter group 'to-address)
2982 (gnus-group-fast-parameter group 'to-list))))
2983 (when address
2984 (add-to-list 'addresses address))))
2985 (when addresses
2986 (list (mapconcat 'regexp-quote addresses "\\|")))))
6748645f 2987
a8151ef7
LMI
2988(defmacro gnus-string-or (&rest strings)
2989 "Return the first element of STRINGS that is a non-blank string.
2990STRINGS will be evaluated in normal `or' order."
2991 `(gnus-string-or-1 ',strings))
2992
2993(defun gnus-string-or-1 (strings)
2994 (let (string)
2995 (while strings
2996 (setq string (eval (pop strings)))
2997 (if (string-match "^[ \t]*$" string)
2998 (setq string nil)
2999 (setq strings nil)))
3000 string))
3001
eec82323
LMI
3002(defun gnus-version (&optional arg)
3003 "Version number of this version of Gnus.
3004If ARG, insert string at point."
3005 (interactive "P")
6748645f
LMI
3006 (if arg
3007 (insert (message gnus-version))
3008 (message gnus-version)))
eec82323 3009
23f87bed 3010(defun gnus-continuum-version (&optional version)
eec82323 3011 "Return VERSION as a floating point number."
23f87bed
MB
3012 (interactive)
3013 (unless version
3014 (setq version gnus-version))
eec82323
LMI
3015 (when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version)
3016 (string-match "^\\(.?\\)gnus-\\([0-9.]+\\)$" version))
6748645f
LMI
3017 (let ((alpha (and (match-beginning 1) (match-string 1 version)))
3018 (number (match-string 2 version))
3019 major minor least)
3020 (unless (string-match
3021 "\\([0-9]\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?" number)
3022 (error "Invalid version string: %s" version))
3023 (setq major (string-to-number (match-string 1 number))
3024 minor (string-to-number (match-string 2 number))
3025 least (if (match-beginning 3)
eec82323
LMI
3026 (string-to-number (match-string 3 number))
3027 0))
3028 (string-to-number
3029 (if (zerop major)
23f87bed
MB
3030 (format "%s00%02d%02d"
3031 (if (member alpha '("(ding)" "d"))
3032 "4.99"
3033 (+ 5 (* 0.02
3034 (abs
3035 (- (mm-char-int (aref (downcase alpha) 0))
3036 (mm-char-int ?t))))
3037 -0.01))
3038 minor least)
eec82323
LMI
3039 (format "%d.%02d%02d" major minor least))))))
3040
23f87bed 3041(defun gnus-info-find-node (&optional nodename)
eec82323
LMI
3042 "Find Info documentation of Gnus."
3043 (interactive)
3044 ;; Enlarge info window if needed.
3045 (let (gnus-info-buffer)
23f87bed 3046 (Info-goto-node (or nodename (cadr (assq major-mode gnus-info-nodes))))
eec82323
LMI
3047 (setq gnus-info-buffer (current-buffer))
3048 (gnus-configure-windows 'info)))
3049
6748645f
LMI
3050;;;
3051;;; gnus-interactive
3052;;;
3053
3054(defvar gnus-current-prefix-symbol nil
3055 "Current prefix symbol.")
3056
3057(defvar gnus-current-prefix-symbols nil
3058 "List of current prefix symbols.")
3059
3060(defun gnus-interactive (string &optional params)
3061 "Return a list that can be fed to `interactive'.
3062See `interactive' for full documentation.
3063
3064Adds the following specs:
3065
3066y -- The current symbolic prefix.
3067Y -- A list of the current symbolic prefix(es).
3068A -- Article number.
3069H -- Article header.
3070g -- Group name."
3071 (let ((i 0)
3072 out c prompt)
3073 (while (< i (length string))
3074 (string-match ".\\([^\n]*\\)\n?" string i)
3075 (setq c (aref string i))
3076 (when (match-end 1)
3077 (setq prompt (match-string 1 string)))
3078 (setq i (match-end 0))
3079 ;; We basically emulate just about everything that
3080 ;; `interactive' does, but add the specs listed above.
3081 (push
3082 (cond
3083 ((= c ?a)
3084 (completing-read prompt obarray 'fboundp t))
3085 ((= c ?b)
3086 (read-buffer prompt (current-buffer) t))
3087 ((= c ?B)
3088 (read-buffer prompt (other-buffer (current-buffer))))
3089 ((= c ?c)
3090 (read-char))
3091 ((= c ?C)
3092 (completing-read prompt obarray 'commandp t))
3093 ((= c ?d)
3094 (point))
3095 ((= c ?D)
3096 (read-file-name prompt nil default-directory 'lambda))
3097 ((= c ?f)
3098 (read-file-name prompt nil nil 'lambda))
3099 ((= c ?F)
3100 (read-file-name prompt))
3101 ((= c ?k)
3102 (read-key-sequence prompt))
3103 ((= c ?K)
3104 (error "Not implemented spec"))
3105 ((= c ?e)
3106 (error "Not implemented spec"))
3107 ((= c ?m)
3108 (mark))
3109 ((= c ?N)
3110 (error "Not implemented spec"))
3111 ((= c ?n)
3112 (string-to-number (read-from-minibuffer prompt)))
3113 ((= c ?p)
3114 (prefix-numeric-value current-prefix-arg))
3115 ((= c ?P)
3116 current-prefix-arg)
3117 ((= c ?r)
3118 'gnus-prefix-nil)
3119 ((= c ?s)
3120 (read-string prompt))
3121 ((= c ?S)
3122 (intern (read-string prompt)))
3123 ((= c ?v)
3124 (read-variable prompt))
3125 ((= c ?x)
3126 (read-minibuffer prompt))
3127 ((= c ?x)
3128 (eval-minibuffer prompt))
3129 ;; And here the new specs come.
3130 ((= c ?y)
3131 gnus-current-prefix-symbol)
3132 ((= c ?Y)
3133 gnus-current-prefix-symbols)
3134 ((= c ?g)
3135 (gnus-group-group-name))
3136 ((= c ?A)
3137 (gnus-summary-skip-intangible)
3138 (or (get-text-property (point) 'gnus-number)
3139 (gnus-summary-last-subject)))
3140 ((= c ?H)
3141 (gnus-data-header (gnus-data-find (gnus-summary-article-number))))
3142 (t
3143 (error "Non-implemented spec")))
3144 out)
3145 (cond
3146 ((= c ?r)
fa066d09
GM
3147 (push (if (< (point) (mark)) (point) (mark)) out)
3148 (push (if (> (point) (mark)) (point) (mark)) out))))
6748645f
LMI
3149 (setq out (delq 'gnus-prefix-nil out))
3150 (nreverse out)))
3151
3152(defun gnus-symbolic-argument (&optional arg)
3153 "Read a symbolic argument and a command, and then execute command."
3154 (interactive "P")
3155 (let* ((in-command (this-command-keys))
3156 (command in-command)
3157 gnus-current-prefix-symbols
3158 gnus-current-prefix-symbol
3159 syms)
3160 (while (equal in-command command)
3161 (message "%s-" (key-description (this-command-keys)))
3162 (push (intern (char-to-string (read-char))) syms)
3163 (setq command (read-key-sequence nil t)))
3164 (setq gnus-current-prefix-symbols (nreverse syms)
3165 gnus-current-prefix-symbol (car gnus-current-prefix-symbols))
3166 (call-interactively (key-binding command t))))
3167
eec82323
LMI
3168;;; More various functions.
3169
a36c8d02
RS
3170(defsubst gnus-check-backend-function (func group)
3171 "Check whether GROUP supports function FUNC.
3172GROUP can either be a string (a group name) or a select method."
3173 (ignore-errors
3174 (let ((method (if (stringp group)
3175 (car (gnus-find-method-for-group group))
3176 group)))
3177 (unless (featurep method)
3178 (require method))
3179 (fboundp (intern (format "%s-%s" method func))))))
3180
eec82323
LMI
3181(defun gnus-group-read-only-p (&optional group)
3182 "Check whether GROUP supports editing or not.
3183If GROUP is nil, `gnus-newsgroup-name' will be checked instead. Note
3184that that variable is buffer-local to the summary buffers."
3185 (let ((group (or group gnus-newsgroup-name)))
3186 (not (gnus-check-backend-function 'request-replace-article group))))
3187
eec82323
LMI
3188(defun gnus-virtual-group-p (group)
3189 "Say whether GROUP is virtual or not."
3190 (memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group)))
3191 gnus-valid-select-methods)))
3192
3193(defun gnus-news-group-p (group &optional article)
3194 "Return non-nil if GROUP (and ARTICLE) come from a news server."
23f87bed
MB
3195 (cond ((gnus-member-of-valid 'post group) ;Ordinary news group
3196 t) ;is news of course.
3197 ((not (gnus-member-of-valid 'post-mail group)) ;Non-combined.
3198 nil) ;must be mail then.
3199 ((vectorp article) ;Has header info.
3200 (eq (gnus-request-type group (mail-header-id article)) 'news))
3201 ((null article) ;Hasn't header info
3202 (eq (gnus-request-type group) 'news)) ;(unknown ==> mail)
3203 ((< article 0) ;Virtual message
3204 nil) ;we don't know, guess mail.
3205 (t ;Has positive number
3206 (eq (gnus-request-type group article) 'news)))) ;use it.
eec82323
LMI
3207
3208;; Returns a list of writable groups.
3209(defun gnus-writable-groups ()
3210 (let ((alist gnus-newsrc-alist)
3211 groups group)
3212 (while (setq group (car (pop alist)))
3213 (unless (gnus-group-read-only-p group)
3214 (push group groups)))
3215 (nreverse groups)))
3216
3217;; Check whether to use long file names.
3218(defun gnus-use-long-file-name (symbol)
3219 ;; The variable has to be set...
3220 (and gnus-use-long-file-name
3221 ;; If it isn't a list, then we return t.
3222 (or (not (listp gnus-use-long-file-name))
3223 ;; If it is a list, and the list contains `symbol', we
3224 ;; return nil.
3225 (not (memq symbol gnus-use-long-file-name)))))
3226
3227;; Generate a unique new group name.
3228(defun gnus-generate-new-group-name (leaf)
3229 (let ((name leaf)
3230 (num 0))
3231 (while (gnus-gethash name gnus-newsrc-hashtb)
3232 (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">")))
3233 name))
3234
3235(defun gnus-ephemeral-group-p (group)
3236 "Say whether GROUP is ephemeral or not."
6748645f 3237 (gnus-group-get-parameter group 'quit-config t))
eec82323
LMI
3238
3239(defun gnus-group-quit-config (group)
3240 "Return the quit-config of GROUP."
6748645f 3241 (gnus-group-get-parameter group 'quit-config t))
eec82323
LMI
3242
3243(defun gnus-kill-ephemeral-group (group)
3244 "Remove ephemeral GROUP from relevant structures."
3245 (gnus-sethash group nil gnus-newsrc-hashtb))
3246
3247(defun gnus-simplify-mode-line ()
3248 "Make mode lines a bit simpler."
a8151ef7 3249 (setq mode-line-modified (cdr gnus-mode-line-modified))
eec82323
LMI
3250 (when (listp mode-line-format)
3251 (make-local-variable 'mode-line-format)
3252 (setq mode-line-format (copy-sequence mode-line-format))
3253 (when (equal (nth 3 mode-line-format) " ")
3254 (setcar (nthcdr 3 mode-line-format) " "))))
3255
3256;;; Servers and groups.
3257
3258(defsubst gnus-server-add-address (method)
3259 (let ((method-name (symbol-name (car method))))
3260 (if (and (memq 'address (assoc method-name gnus-valid-select-methods))
3261 (not (assq (intern (concat method-name "-address")) method))
3262 (memq 'physical-address (assq (car method)
3263 gnus-valid-select-methods)))
3264 (append method (list (list (intern (concat method-name "-address"))
3265 (nth 1 method))))
3266 method)))
3267
14e20e13
MB
3268(defsubst gnus-method-to-server (method)
3269 (catch 'server-name
3270 (setq method (or method gnus-select-method))
3271
3272 ;; Perhaps it is already in the cache.
3273 (mapc (lambda (name-method)
3274 (if (equal (cdr name-method) method)
3275 (throw 'server-name (car name-method))))
3276 gnus-server-method-cache)
3277
3278 (mapc
3279 (lambda (server-alist)
3280 (mapc (lambda (name-method)
3281 (when (gnus-methods-equal-p (cdr name-method) method)
3282 (unless (member name-method gnus-server-method-cache)
3283 (push name-method gnus-server-method-cache))
3284 (throw 'server-name (car name-method))))
3285 server-alist))
3286 (let ((alists (list gnus-server-alist
3287 gnus-predefined-server-alist)))
3288 (if gnus-select-method
3289 (push (list (cons "native" gnus-select-method)) alists))
3290 alists))
3291
3292 (let* ((name (if (member (cadr method) '(nil ""))
3293 (format "%s" (car method))
3294 (format "%s:%s" (car method) (cadr method))))
3295 (name-method (cons name method)))
3296 (unless (member name-method gnus-server-method-cache)
3297 (push name-method gnus-server-method-cache))
3298 name)))
3299
23f87bed
MB
3300(defsubst gnus-server-to-method (server)
3301 "Map virtual server names to select methods."
3302 (or (and server (listp server) server)
3303 (cdr (assoc server gnus-server-method-cache))
3304 (let ((result
3305 (or
3306 ;; Perhaps this is the native server?
3307 (and (equal server "native") gnus-select-method)
3308 ;; It should be in the server alist.
3309 (cdr (assoc server gnus-server-alist))
3310 ;; It could be in the predefined server alist.
3311 (cdr (assoc server gnus-predefined-server-alist))
3312 ;; If not, we look through all the opened server
3313 ;; to see whether we can find it there.
3314 (let ((opened gnus-opened-servers))
3315 (while (and opened
3316 (not (equal server (format "%s:%s" (caaar opened)
3317 (cadaar opened)))))
3318 (pop opened))
3319 (caar opened))
3320 ;; It could be a named method, search all servers
3321 (let ((servers gnus-secondary-select-methods))
3322 (while (and servers
3323 (not (equal server (format "%s:%s" (caar servers)
3324 (cadar servers)))))
3325 (pop servers))
3326 (car servers))
3327 ;; This could be some sort of foreign server that I
3328 ;; simply haven't opened (yet). Do a brute-force scan
3329 ;; of the entire gnus-newsrc-alist for the server name
3330 ;; of every method. As a side-effect, loads the
3331 ;; gnus-server-method-cache so this only happens once,
3332 ;; if at all.
3333 (let (match)
3334 (mapcar
3335 (lambda (info)
3336 (let ((info-method (gnus-info-method info)))
3337 (unless (stringp info-method)
3338 (let ((info-server (gnus-method-to-server info-method)))
3339 (when (equal server info-server)
3340 (setq match info-method))))))
3341 (cdr gnus-newsrc-alist))
3342 match))))
3343 (when result
3344 (push (cons server result) gnus-server-method-cache))
3345 result)))
3346
eec82323
LMI
3347(defsubst gnus-server-get-method (group method)
3348 ;; Input either a server name, and extended server name, or a
3349 ;; select method, and return a select method.
3350 (cond ((stringp method)
3351 (gnus-server-to-method method))
3352 ((equal method gnus-select-method)
3353 gnus-select-method)
6748645f
LMI
3354 ((and (stringp (car method))
3355 group)
eec82323 3356 (gnus-server-extend-method group method))
6748645f
LMI
3357 ((and method
3358 (not group)
eec82323
LMI
3359 (equal (cadr method) ""))
3360 method)
3361 (t
3362 (gnus-server-add-address method))))
3363
eec82323
LMI
3364(defmacro gnus-method-equal (ss1 ss2)
3365 "Say whether two servers are equal."
3366 `(let ((s1 ,ss1)
3367 (s2 ,ss2))
3368 (or (equal s1 s2)
3369 (and (= (length s1) (length s2))
3370 (progn
3371 (while (and s1 (member (car s1) s2))
3372 (setq s1 (cdr s1)))
3373 (null s1))))))
3374
16409b0b
GM
3375(defun gnus-methods-equal-p (m1 m2)
3376 (let ((m1 (or m1 gnus-select-method))
3377 (m2 (or m2 gnus-select-method)))
3378 (or (equal m1 m2)
3379 (and (eq (car m1) (car m2))
3380 (or (not (memq 'address (assoc (symbol-name (car m1))
3381 gnus-valid-select-methods)))
3382 (equal (nth 1 m1) (nth 1 m2)))))))
3383
eec82323
LMI
3384(defun gnus-server-equal (m1 m2)
3385 "Say whether two methods are equal."
3386 (let ((m1 (cond ((null m1) gnus-select-method)
3387 ((stringp m1) (gnus-server-to-method m1))
3388 (t m1)))
3389 (m2 (cond ((null m2) gnus-select-method)
3390 ((stringp m2) (gnus-server-to-method m2))
3391 (t m2))))
3392 (gnus-method-equal m1 m2)))
3393
3394(defun gnus-servers-using-backend (backend)
3395 "Return a list of known servers using BACKEND."
3396 (let ((opened gnus-opened-servers)
3397 out)
3398 (while opened
3399 (when (eq backend (caaar opened))
3400 (push (caar opened) out))
3401 (pop opened))
3402 out))
3403
3404(defun gnus-archive-server-wanted-p ()
3405 "Say whether the user wants to use the archive server."
3406 (cond
3407 ((or (not gnus-message-archive-method)
3408 (not gnus-message-archive-group))
3409 nil)
3410 ((and gnus-message-archive-method gnus-message-archive-group)
3411 t)
3412 (t
3413 (let ((active (cadr (assq 'nnfolder-active-file
3414 gnus-message-archive-method))))
3415 (and active
3416 (file-exists-p active))))))
3417
23f87bed
MB
3418(defsubst gnus-method-to-server-name (method)
3419 (concat
3420 (format "%s" (car method))
3421 (when (and
3422 (or (assoc (format "%s" (car method))
3423 (gnus-methods-using 'address))
3424 (gnus-server-equal method gnus-message-archive-method))
3425 (nth 1 method)
3426 (not (string= (nth 1 method) "")))
3427 (concat "+" (nth 1 method)))))
3428
3429(defsubst gnus-method-to-full-server-name (method)
3430 (format "%s+%s" (car method) (nth 1 method)))
3431
3432(defun gnus-group-prefixed-name (group method &optional full)
3433 "Return the whole name from GROUP and METHOD.
3434Call with full set to get the fully qualified group name (even if the
3435server is native)."
3436 (when (stringp method)
3437 (setq method (gnus-server-to-method method)))
6748645f 3438 (if (or (not method)
23f87bed
MB
3439 (and (not full) (gnus-server-equal method "native"))
3440 ;;;!!! This might not be right. We'll see...
3441 ;(string-match ":" group)
3442 )
eec82323 3443 group
23f87bed
MB
3444 (concat (gnus-method-to-server-name method) ":" group)))
3445
3446(defun gnus-group-guess-prefixed-name (group)
3447 "Guess the whole name from GROUP and METHOD."
3448 (gnus-group-prefixed-name group (gnus-find-method-for-group
3449 group)))
3450
3451(defun gnus-group-full-name (group method)
3452 "Return the full name from GROUP and METHOD, even if the method is native."
3453 (gnus-group-prefixed-name group method t))
3454
3455(defun gnus-group-guess-full-name (group)
3456 "Guess the full name from GROUP, even if the method is native."
3457 (if (gnus-group-prefixed-p group)
3458 group
3459 (gnus-group-full-name group (gnus-find-method-for-group group))))
3460
3461(defun gnus-group-guess-full-name-from-command-method (group)
3462 "Guess the full name from GROUP, even if the method is native."
3463 (if (gnus-group-prefixed-p group)
3464 group
3465 (gnus-group-full-name group gnus-command-method)))
eec82323
LMI
3466
3467(defun gnus-group-real-prefix (group)
3468 "Return the prefix of the current group name."
23f87bed
MB
3469 (if (stringp group)
3470 (if (string-match "^[^:]+:" group)
3471 (substring group 0 (match-end 0))
3472 "")
3473 nil))
3474
3475(defun gnus-group-short-name (group)
3476 "Return the short group name."
3477 (let ((prefix (gnus-group-real-prefix group)))
3478 (if (< 0 (length prefix))
3479 (substring group (length prefix) nil)
3480 group)))
3481
3482(defun gnus-group-prefixed-p (group)
3483 "Return the prefix of the current group name."
3484 (< 0 (length (gnus-group-real-prefix group))))
3485
3486(defun gnus-summary-buffer-name (group)
3487 "Return the summary buffer name of GROUP."
3488 (concat "*Summary " (gnus-group-decoded-name group) "*"))
eec82323
LMI
3489
3490(defun gnus-group-method (group)
3491 "Return the server or method used for selecting GROUP.
3492You should probably use `gnus-find-method-for-group' instead."
3493 (let ((prefix (gnus-group-real-prefix group)))
3494 (if (equal prefix "")
3495 gnus-select-method
3496 (let ((servers gnus-opened-servers)
3497 (server "")
3498 backend possible found)
3499 (if (string-match "^[^\\+]+\\+" prefix)
3500 (setq backend (intern (substring prefix 0 (1- (match-end 0))))
3501 server (substring prefix (match-end 0) (1- (length prefix))))
3502 (setq backend (intern (substring prefix 0 (1- (length prefix))))))
3503 (while servers
3504 (when (eq (caaar servers) backend)
3505 (setq possible (caar servers))
3506 (when (equal (cadaar servers) server)
3507 (setq found (caar servers))))
3508 (pop servers))
3509 (or (car (rassoc found gnus-server-alist))
3510 found
3511 (car (rassoc possible gnus-server-alist))
3512 possible
3513 (list backend server))))))
3514
16409b0b
GM
3515(defsubst gnus-native-method-p (method)
3516 "Return whether METHOD is the native select method."
3517 (gnus-method-equal method gnus-select-method))
3518
eec82323
LMI
3519(defsubst gnus-secondary-method-p (method)
3520 "Return whether METHOD is a secondary select method."
3521 (let ((methods gnus-secondary-select-methods)
23f87bed 3522 (gmethod (inline (gnus-server-get-method nil method))))
eec82323 3523 (while (and methods
16409b0b 3524 (not (gnus-method-equal
23f87bed 3525 (inline (gnus-server-get-method nil (car methods)))
16409b0b 3526 gmethod)))
eec82323
LMI
3527 (setq methods (cdr methods)))
3528 methods))
3529
16409b0b
GM
3530(defun gnus-method-simplify (method)
3531 "Return the shortest uniquely identifying string or method for METHOD."
3532 (cond ((stringp method)
3533 method)
3534 ((gnus-native-method-p method)
3535 nil)
3536 ((gnus-secondary-method-p method)
3537 (format "%s:%s" (nth 0 method) (nth 1 method)))
3538 (t
3539 method)))
3540
6748645f
LMI
3541(defun gnus-groups-from-server (server)
3542 "Return a list of all groups that are fetched from SERVER."
3543 (let ((alist (cdr gnus-newsrc-alist))
3544 info groups)
3545 (while (setq info (pop alist))
3546 (when (gnus-server-equal (gnus-info-method info) server)
3547 (push (gnus-info-group info) groups)))
3548 (sort groups 'string<)))
3549
eec82323
LMI
3550(defun gnus-group-foreign-p (group)
3551 "Say whether a group is foreign or not."
3552 (and (not (gnus-group-native-p group))
3553 (not (gnus-group-secondary-p group))))
3554
3555(defun gnus-group-native-p (group)
3556 "Say whether the group is native or not."
3557 (not (string-match ":" group)))
3558
3559(defun gnus-group-secondary-p (group)
3560 "Say whether the group is secondary or not."
3561 (gnus-secondary-method-p (gnus-find-method-for-group group)))
3562
23f87bed
MB
3563(defun gnus-parameters-get-parameter (group)
3564 "Return the group parameters for GROUP from `gnus-parameters'."
3565 (let (params-list)
3566 (dolist (elem gnus-parameters)
3567 (when (string-match (car elem) group)
3568 (setq params-list
3569 (nconc (gnus-expand-group-parameters
3570 (car elem) (cdr elem) group)
3571 params-list))))
3572 params-list))
3573
3574(defun gnus-expand-group-parameter (match value group)
3575 "Use MATCH to expand VALUE in GROUP."
3576 (with-temp-buffer
3577 (insert group)
3578 (goto-char (point-min))
3579 (while (re-search-forward match nil t)
3580 (replace-match value))
3581 (buffer-string)))
3582
3583(defun gnus-expand-group-parameters (match parameters group)
3584 "Go through PARAMETERS and expand them according to the match data."
3585 (let (new)
3586 (dolist (elem parameters)
3587 (if (and (stringp (cdr elem))
3588 (string-match "\\\\[0-9&]" (cdr elem)))
3589 (push (cons (car elem)
3590 (gnus-expand-group-parameter match (cdr elem) group))
3591 new)
3592 (push elem new)))
3593 new))
3594
3595(defun gnus-group-fast-parameter (group symbol &optional allow-list)
3596 "For GROUP, return the value of SYMBOL.
3597
3598You should call this in the `gnus-group-buffer' buffer.
3599The function `gnus-group-find-parameter' will do that for you."
3600 ;; The speed trick: No cons'ing and quit early.
3601 (let* ((params (funcall gnus-group-get-parameter-function group))
3602 ;; Start easy, check the "real" group parameters.
3603 (simple-results
3604 (gnus-group-parameter-value params symbol allow-list t)))
3605 (if simple-results
3606 ;; Found results; return them.
3607 (car simple-results)
3608 ;; We didn't found it there, try `gnus-parameters'.
3609 (let ((result nil)
3610 (head nil)
3611 (tail gnus-parameters))
3612 ;; A good old-fashioned non-cl loop.
3613 (while tail
3614 (setq head (car tail)
3615 tail (cdr tail))
3616 ;; The car is regexp matching for matching the group name.
3617 (when (string-match (car head) group)
3618 ;; The cdr is the parameters.
3619 (setq result (gnus-group-parameter-value (cdr head)
3620 symbol allow-list))
3621 (when result
3622 ;; Expand if necessary.
3623 (if (and (stringp result) (string-match "\\\\[0-9&]" result))
3624 (setq result (gnus-expand-group-parameter (car head)
3625 result group)))
3626 ;; Exit the loop early.
3627 (setq tail nil))))
3628 ;; Done.
3629 result))))
3630
6748645f 3631(defun gnus-group-find-parameter (group &optional symbol allow-list)
eec82323 3632 "Return the group parameters for GROUP.
23f87bed
MB
3633If SYMBOL, return the value of that symbol in the group parameters.
3634
3635If you call this function inside a loop, consider using the faster
3636`gnus-group-fast-parameter' instead."
eec82323
LMI
3637 (save-excursion
3638 (set-buffer gnus-group-buffer)
23f87bed
MB
3639 (if symbol
3640 (gnus-group-fast-parameter group symbol allow-list)
3641 (nconc
3642 (copy-sequence
3643 (funcall gnus-group-get-parameter-function group))
3644 (gnus-parameters-get-parameter group)))))
eec82323 3645
6748645f 3646(defun gnus-group-get-parameter (group &optional symbol allow-list)
eec82323 3647 "Return the group parameters for GROUP.
6748645f
LMI
3648If SYMBOL, return the value of that symbol in the group parameters.
3649Most functions should use `gnus-group-find-parameter', which
3650also examines the topic parameters."
eec82323
LMI
3651 (let ((params (gnus-info-params (gnus-get-info group))))
3652 (if symbol
6748645f 3653 (gnus-group-parameter-value params symbol allow-list)
eec82323
LMI
3654 params)))
3655
23f87bed
MB
3656(defun gnus-group-parameter-value (params symbol &optional
3657 allow-list present-p)
eec82323 3658 "Return the value of SYMBOL in group PARAMS."
6748645f
LMI
3659 ;; We only wish to return group parameters (dotted lists) and
3660 ;; not local variables, which may have the same names.
3661 ;; But first we handle single elements...
3662 (or (car (memq symbol params))
3663 ;; Handle alist.
3664 (let (elem)
3665 (catch 'found
3666 (while (setq elem (pop params))
3667 (when (and (consp elem)
3668 (eq (car elem) symbol)
3669 (or allow-list
3670 (atom (cdr elem))))
23f87bed
MB
3671 (throw 'found (if present-p (list (cdr elem))
3672 (cdr elem)))))))))
eec82323
LMI
3673
3674(defun gnus-group-add-parameter (group param)
3675 "Add parameter PARAM to GROUP."
3676 (let ((info (gnus-get-info group)))
3677 (when info
3678 (gnus-group-remove-parameter group (if (consp param) (car param) param))
3679 ;; Cons the new param to the old one and update.
3680 (gnus-group-set-info (cons param (gnus-info-params info))
3681 group 'params))))
3682
3683(defun gnus-group-set-parameter (group name value)
3684 "Set parameter NAME to VALUE in GROUP."
3685 (let ((info (gnus-get-info group)))
3686 (when info
3687 (gnus-group-remove-parameter group name)
3688 (let ((old-params (gnus-info-params info))
3689 (new-params (list (cons name value))))
3690 (while old-params
3691 (when (or (not (listp (car old-params)))
3692 (not (eq (caar old-params) name)))
3693 (setq new-params (append new-params (list (car old-params)))))
3694 (setq old-params (cdr old-params)))
3695 (gnus-group-set-info new-params group 'params)))))
3696
3697(defun gnus-group-remove-parameter (group name)
3698 "Remove parameter NAME from GROUP."
3699 (let ((info (gnus-get-info group)))
3700 (when info
3701 (let ((params (gnus-info-params info)))
3702 (when params
3703 (setq params (delq name params))
3704 (while (assq name params)
6748645f 3705 (gnus-pull name params))
eec82323
LMI
3706 (gnus-info-set-params info params))))))
3707
3708(defun gnus-group-add-score (group &optional score)
3709 "Add SCORE to the GROUP score.
3710If SCORE is nil, add 1 to the score of GROUP."
3711 (let ((info (gnus-get-info group)))
3712 (when info
3713 (gnus-info-set-score info (+ (gnus-info-score info) (or score 1))))))
3714
eec82323
LMI
3715(defun gnus-short-group-name (group &optional levels)
3716 "Collapse GROUP name LEVELS.
3717Select methods are stripped and any remote host name is stripped down to
3718just the host name."
6748645f
LMI
3719 (let* ((name "")
3720 (foreign "")
3721 (depth 0)
3722 (skip 1)
eec82323 3723 (levels (or levels
16409b0b 3724 gnus-group-uncollapsed-levels
eec82323
LMI
3725 (progn
3726 (while (string-match "\\." group skip)
3727 (setq skip (match-end 0)
3728 depth (+ depth 1)))
3729 depth))))
16409b0b 3730 ;; Separate foreign select method from group name and collapse.
23f87bed 3731 ;; If method contains a server, collapse to non-domain server name,
16409b0b
GM
3732 ;; otherwise collapse to select method.
3733 (let* ((colon (string-match ":" group))
3734 (server (and colon (substring group 0 colon)))
3735 (plus (and server (string-match "+" server))))
3736 (when server
3737 (if plus
3738 (setq foreign (substring server (+ 1 plus)
3739 (string-match "\\." server))
3740 group (substring group (+ 1 colon)))
3741 (setq foreign server
3742 group (substring group (+ 1 colon))))
3743 (setq foreign (concat foreign ":")))
3744 ;; Collapse group name leaving LEVELS uncollapsed elements
3745 (let* ((slist (split-string group "/"))
3746 (slen (length slist))
3747 (dlist (split-string group "\\."))
3748 (dlen (length dlist))
3749 glist
3750 glen
3751 gsep
3752 res)
3753 (if (> slen dlen)
3754 (setq glist slist
3755 glen slen
3756 gsep "/")
3757 (setq glist dlist
3758 glen dlen
3759 gsep "."))
3760 (setq levels (- glen levels))
3761 (dolist (g glist)
3762 (push (if (>= (decf levels) 0)
3763 (if (zerop (length g))
3764 ""
3765 (substring g 0 1))
3766 g)
3767 res))
3768 (concat foreign (mapconcat 'identity (nreverse res) gsep))))))
eec82323
LMI
3769
3770(defun gnus-narrow-to-body ()
3771 "Narrow to the body of an article."
3772 (narrow-to-region
3773 (progn
3774 (goto-char (point-min))
3775 (or (search-forward "\n\n" nil t)
3776 (point-max)))
3777 (point-max)))
3778
3779\f
3780;;;
3781;;; Kill file handling.
3782;;;
3783
3784(defun gnus-apply-kill-file ()
3785 "Apply a kill file to the current newsgroup.
3786Returns the number of articles marked as read."
3787 (if (or (file-exists-p (gnus-newsgroup-kill-file nil))
3788 (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)))
3789 (gnus-apply-kill-file-internal)
3790 0))
3791
3792(defun gnus-kill-save-kill-buffer ()
3793 (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name)))
3794 (when (get-file-buffer file)
3795 (save-excursion
3796 (set-buffer (get-file-buffer file))
3797 (when (buffer-modified-p)
3798 (save-buffer))
3799 (kill-buffer (current-buffer))))))
3800
3801(defcustom gnus-kill-file-name "KILL"
3802 "Suffix of the kill files."
3803 :group 'gnus-score-kill
3804 :group 'gnus-score-files
3805 :type 'string)
3806
3807(defun gnus-newsgroup-kill-file (newsgroup)
3808 "Return the name of a kill file name for NEWSGROUP.
3809If NEWSGROUP is nil, return the global kill file name instead."
3810 (cond
3811 ;; The global KILL file is placed at top of the directory.
3812 ((or (null newsgroup)
3813 (string-equal newsgroup ""))
3814 (expand-file-name gnus-kill-file-name
3815 gnus-kill-files-directory))
3816 ;; Append ".KILL" to newsgroup name.
3817 ((gnus-use-long-file-name 'not-kill)
3818 (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup)
3819 "." gnus-kill-file-name)
3820 gnus-kill-files-directory))
3821 ;; Place "KILL" under the hierarchical directory.
3822 (t
3823 (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
3824 "/" gnus-kill-file-name)
3825 gnus-kill-files-directory))))
3826
3827;;; Server things.
3828
3829(defun gnus-member-of-valid (symbol group)
3830 "Find out if GROUP has SYMBOL as part of its \"valid\" spec."
3831 (memq symbol (assoc
3832 (symbol-name (car (gnus-find-method-for-group group)))
3833 gnus-valid-select-methods)))
3834
3835(defun gnus-method-option-p (method option)
3836 "Return non-nil if select METHOD has OPTION as a parameter."
3837 (when (stringp method)
3838 (setq method (gnus-server-to-method method)))
3839 (memq option (assoc (format "%s" (car method))
3840 gnus-valid-select-methods)))
3841
3842(defun gnus-similar-server-opened (method)
3843 (let ((opened gnus-opened-servers))
3844 (while (and method opened)
3845 (when (and (equal (cadr method) (cadaar opened))
16409b0b 3846 (equal (car method) (caaar opened))
eec82323
LMI
3847 (not (equal method (caar opened))))
3848 (setq method nil))
3849 (pop opened))
3850 (not method)))
3851
3852(defun gnus-server-extend-method (group method)
3853 ;; This function "extends" a virtual server. If the server is
3854 ;; "hello", and the select method is ("hello" (my-var "something"))
3855 ;; in the group "alt.alt", this will result in a new virtual server
3856 ;; called "hello+alt.alt".
3857 (if (or (not (inline (gnus-similar-server-opened method)))
3858 (not (cddr method)))
3859 method
3860 `(,(car method) ,(concat (cadr method) "+" group)
3861 (,(intern (format "%s-address" (car method))) ,(cadr method))
3862 ,@(cddr method))))
3863
3864(defun gnus-server-status (method)
3865 "Return the status of METHOD."
3866 (nth 1 (assoc method gnus-opened-servers)))
3867
3868(defun gnus-group-name-to-method (group)
3869 "Guess a select method based on GROUP."
3870 (if (string-match ":" group)
3871 (let ((server (substring group 0 (match-beginning 0))))
3872 (if (string-match "\\+" server)
3873 (list (intern (substring server 0 (match-beginning 0)))
3874 (substring server (match-end 0)))
3875 (list (intern server) "")))
3876 gnus-select-method))
3877
23f87bed
MB
3878(defun gnus-server-string (server)
3879 "Return a readable string that describes SERVER."
3880 (let* ((server (gnus-server-to-method server))
3881 (address (nth 1 server)))
3882 (if (and address
3883 (not (zerop (length address))))
3884 (format "%s using %s" address (car server))
3885 (format "%s" (car server)))))
3886
eec82323
LMI
3887(defun gnus-find-method-for-group (group &optional info)
3888 "Find the select method that GROUP uses."
3889 (or gnus-override-method
3890 (and (not group)
3891 gnus-select-method)
23f87bed 3892 (and (not (gnus-group-entry group)) ;; a new group
16409b0b 3893 (gnus-group-name-to-method group))
eec82323
LMI
3894 (let ((info (or info (gnus-get-info group)))
3895 method)
3896 (if (or (not info)
3897 (not (setq method (gnus-info-method info)))
3898 (equal method "native"))
3899 gnus-select-method
3900 (setq method
3901 (cond ((stringp method)
3902 (inline (gnus-server-to-method method)))
3903 ((stringp (cadr method))
3904 (inline (gnus-server-extend-method group method)))
3905 (t
3906 method)))
3907 (cond ((equal (cadr method) "")
3908 method)
3909 ((null (cadr method))
3910 (list (car method) ""))
3911 (t
3912 (gnus-server-add-address method)))))))
3913
eec82323
LMI
3914(defun gnus-methods-using (feature)
3915 "Find all methods that have FEATURE."
3916 (let ((valids gnus-valid-select-methods)
3917 outs)
3918 (while valids
3919 (when (memq feature (car valids))
3920 (push (car valids) outs))
3921 (setq valids (cdr valids)))
3922 outs))
3923
3924(defun gnus-read-group (prompt &optional default)
3925 "Prompt the user for a group name.
16409b0b 3926Disallow invalid group names."
eec82323
LMI
3927 (let ((prefix "")
3928 group)
3929 (while (not group)
a1506d29 3930 (when (string-match
16409b0b 3931 gnus-invalid-group-regexp
eec82323
LMI
3932 (setq group (read-string (concat prefix prompt)
3933 (cons (or default "") 0)
3934 'gnus-group-history)))
23f87bed
MB
3935 (let ((match (match-string 0 group)))
3936 ;; Might be okay (e.g. for nnimap), so ask the user:
3937 (unless (and (not (string-match "^$\\|:" match))
3938 (message-y-or-n-p
3939 "Proceed and create group anyway? " t
3940"The group name \"" group "\" contains a forbidden character: \"" match "\".
3941
3942Usually, it's dangerous to create a group with this name, because it's not
3943supported by all back ends and servers. On IMAP servers it should work,
3944though. If you are really sure, you can proceed anyway and create the group.
3945
3946You may customize the variable `gnus-invalid-group-regexp', which currently is
3947set to \"" gnus-invalid-group-regexp
3948"\", if you want to get rid of this query permanently."))
3949 (setq prefix (format "Invalid group name: \"%s\". " group)
3950 group nil)))))
eec82323
LMI
3951 group))
3952
3953(defun gnus-read-method (prompt)
3954 "Prompt the user for a method.
3955Allow completion over sensible values."
23f87bed
MB
3956 (let* ((open-servers
3957 (mapcar (lambda (i) (cons (format "%s:%s" (caar i) (cadar i)) i))
3958 gnus-opened-servers))
3959 (valid-methods
3960 (let (methods)
3961 (dolist (method gnus-valid-select-methods)
3962 (if (or (memq 'prompt-address method)
3963 (not (assoc (format "%s:" (car method)) open-servers)))
3964 (push method methods)))
3965 methods))
3966 (servers
3967 (append valid-methods
3968 open-servers
6748645f
LMI
3969 gnus-predefined-server-alist
3970 gnus-server-alist))
3971 (method
3972 (completing-read
3973 prompt servers
3974 nil t nil 'gnus-method-history)))
eec82323
LMI
3975 (cond
3976 ((equal method "")
3977 (setq method gnus-select-method))
3978 ((assoc method gnus-valid-select-methods)
16409b0b
GM
3979 (let ((address (if (memq 'prompt-address
3980 (assoc method gnus-valid-select-methods))
3981 (read-string "Address: ")
3982 "")))
23f87bed 3983 (or (cadr (assoc (format "%s:%s" method address) open-servers))
16409b0b 3984 (list (intern method) address))))
6748645f 3985 ((assoc method servers)
eec82323
LMI
3986 method)
3987 (t
3988 (list (intern method) "")))))
3989
23f87bed
MB
3990;;; Agent functions
3991
3992(defun gnus-agent-method-p (method)
3993 "Say whether METHOD is covered by the agent."
3994 (or (eq (car gnus-agent-method-p-cache) method)
3995 (setq gnus-agent-method-p-cache
3996 (cons method
3997 (member (if (stringp method)
3998 method
3999 (gnus-method-to-server method)) gnus-agent-covered-methods))))
4000 (cdr gnus-agent-method-p-cache))
4001
4002(defun gnus-online (method)
4003 (not
4004 (if gnus-plugged
4005 (eq (cadr (assoc method gnus-opened-servers)) 'offline)
4006 (gnus-agent-method-p method))))
4007
eec82323
LMI
4008;;; User-level commands.
4009
4010;;;###autoload
4011(defun gnus-slave-no-server (&optional arg)
23f87bed 4012 "Read network news as a slave, without connecting to the local server."
eec82323
LMI
4013 (interactive "P")
4014 (gnus-no-server arg t))
4015
4016;;;###autoload
4017(defun gnus-no-server (&optional arg slave)
4018 "Read network news.
23f87bed
MB
4019If ARG is a positive number, Gnus will use that as the startup
4020level. If ARG is nil, Gnus will be started at level 2. If ARG is
4021non-nil and not a positive number, Gnus will prompt the user for the
4022name of an NNTP server to use.
4023As opposed to `gnus', this command will not connect to the local
4024server."
eec82323
LMI
4025 (interactive "P")
4026 (gnus-no-server-1 arg slave))
4027
4028;;;###autoload
4029(defun gnus-slave (&optional arg)
4030 "Read news as a slave."
4031 (interactive "P")
4032 (gnus arg nil 'slave))
4033
4034;;;###autoload
23f87bed
MB
4035(defun gnus-other-frame (&optional arg display)
4036 "Pop up a frame to read news.
4037This will call one of the Gnus commands which is specified by the user
4038option `gnus-other-frame-function' (default `gnus') with the argument
4039ARG if Gnus is not running, otherwise just pop up a Gnus frame. The
4040optional second argument DISPLAY should be a standard display string
4041such as \"unix:0\" to specify where to pop up a frame. If DISPLAY is
4042omitted or the function `make-frame-on-display' is not available, the
4043current display is used."
eec82323 4044 (interactive "P")
23f87bed
MB
4045 (if (fboundp 'make-frame-on-display)
4046 (unless display
4047 (setq display (gnus-frame-or-window-display-name (selected-frame))))
4048 (setq display nil))
4049 (let ((alive (gnus-alive-p)))
4050 (unless (and alive
4051 (catch 'found
4052 (walk-windows
4053 (lambda (window)
4054 (when (and (or (not display)
4055 (equal display
4056 (gnus-frame-or-window-display-name
4057 window)))
4058 (with-current-buffer (window-buffer window)
4059 (string-match "\\`gnus-"
4060 (symbol-name major-mode))))
4061 (gnus-select-frame-set-input-focus
4062 (setq gnus-other-frame-object (window-frame window)))
4063 (select-window window)
4064 (throw 'found t)))
4065 'ignore t)))
4066 (gnus-select-frame-set-input-focus
4067 (setq gnus-other-frame-object
4068 (if display
4069 (make-frame-on-display display gnus-other-frame-parameters)
4070 (make-frame gnus-other-frame-parameters))))
4071 (if alive
4072 (switch-to-buffer gnus-group-buffer)
4073 (funcall gnus-other-frame-function arg)
4074 (add-hook 'gnus-exit-gnus-hook
4075 '(lambda nil
4076 (when (and (frame-live-p gnus-other-frame-object)
4077 (cdr (frame-list)))
4078 (delete-frame gnus-other-frame-object))
4079 (setq gnus-other-frame-object nil)))))))
eec82323 4080
16409b0b
GM
4081;;(setq thing ? ; this is a comment
4082;; more 'yes)
4083
eec82323
LMI
4084;;;###autoload
4085(defun gnus (&optional arg dont-connect slave)
4086 "Read network news.
4087If ARG is non-nil and a positive number, Gnus will use that as the
23f87bed 4088startup level. If ARG is non-nil and not a positive number, Gnus will
eec82323
LMI
4089prompt the user for the name of an NNTP server to use."
4090 (interactive "P")
23f87bed
MB
4091 (unless (byte-code-function-p (symbol-function 'gnus))
4092 (message "You should byte-compile Gnus")
4093 (sit-for 2))
eec82323
LMI
4094 (gnus-1 arg dont-connect slave))
4095
4096;; Allow redefinition of Gnus functions.
4097
4098(gnus-ems-redefine)
4099
4100(provide 'gnus)
4101
ab5796a9 4102;;; arch-tag: acebeeab-f331-4f8f-a7ea-89c58c84f636
eec82323 4103;;; gnus.el ends here