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