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