comparison lisp/gnus/gnus.el @ 82951:0fde48feb604

Import Gnus 5.10 from the v5_10 branch of the Gnus repository.
author Andreas Schwab <schwab@suse.de>
date Thu, 22 Jul 2004 16:45:51 +0000
parents 695cf19ef79e
children e5e07e24d380
comparison
equal deleted inserted replaced
56503:8bbd2323fbf2 82951:0fde48feb604
1 ;;; gnus.el --- a newsreader for GNU Emacs 1 ;;; gnus.el --- a newsreader for GNU Emacs
2
2 ;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, 1997, 3 ;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, 1997,
3 ;; 1998, 2000, 2001, 2002 Free Software Foundation, Inc. 4 ;; 1998, 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc.
4 5
5 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> 6 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
6 ;; Lars Magne Ingebrigtsen <larsi@gnus.org> 7 ;; Lars Magne Ingebrigtsen <larsi@gnus.org>
7 ;; Keywords: news, mail 8 ;; Keywords: news, mail
8 9
28 ;;; Code: 29 ;;; Code:
29 30
30 (eval '(run-hooks 'gnus-load-hook)) 31 (eval '(run-hooks 'gnus-load-hook))
31 32
32 (eval-when-compile (require 'cl)) 33 (eval-when-compile (require 'cl))
34 (require 'wid-edit)
33 (require 'mm-util) 35 (require 'mm-util)
36 (require 'nnheader)
34 37
35 (defgroup gnus nil 38 (defgroup gnus nil
36 "The coffee-brewing, all singing, all dancing, kitchen sink newsreader." 39 "The coffee-brewing, all singing, all dancing, kitchen sink newsreader."
37 :group 'news 40 :group 'news
38 :group 'mail) 41 :group 'mail)
42
43 (defgroup gnus-format nil
44 "Dealing with formatting issues."
45 :group 'gnus)
39 46
40 (defgroup gnus-charset nil 47 (defgroup gnus-charset nil
41 "Group character set issues." 48 "Group character set issues."
42 :link '(custom-manual "(gnus)Charsets") 49 :link '(custom-manual "(gnus)Charsets")
43 :version "21.1" 50 :version "21.1"
44 :group 'gnus) 51 :group 'gnus)
45 52
46 (defgroup gnus-cache nil 53 (defgroup gnus-cache nil
47 "Cache interface." 54 "Cache interface."
55 :link '(custom-manual "(gnus)Article Caching")
56 :group 'gnus)
57
58 (defgroup gnus-registry nil
59 "Article Registry."
48 :group 'gnus) 60 :group 'gnus)
49 61
50 (defgroup gnus-start nil 62 (defgroup gnus-start nil
51 "Starting your favorite newsreader." 63 "Starting your favorite newsreader."
52 :group 'gnus) 64 :group 'gnus)
130 (defgroup gnus-summary-maneuvering nil 142 (defgroup gnus-summary-maneuvering nil
131 "Summary movement commands." 143 "Summary movement commands."
132 :link '(custom-manual "(gnus)Summary Maneuvering") 144 :link '(custom-manual "(gnus)Summary Maneuvering")
133 :group 'gnus-summary) 145 :group 'gnus-summary)
134 146
147 (defgroup gnus-picon nil
148 "Show pictures of people, domains, and newsgroups."
149 :group 'gnus-visual)
150
135 (defgroup gnus-summary-mail nil 151 (defgroup gnus-summary-mail nil
136 "Mail group commands." 152 "Mail group commands."
137 :link '(custom-manual "(gnus)Mail Group Commands") 153 :link '(custom-manual "(gnus)Mail Group Commands")
138 :group 'gnus-summary) 154 :group 'gnus-summary)
139 155
205 "Various scoring and killing options." 221 "Various scoring and killing options."
206 :group 'gnus-score) 222 :group 'gnus-score)
207 223
208 ;; Other 224 ;; Other
209 (defgroup gnus-visual nil 225 (defgroup gnus-visual nil
210 "Options controling the visual fluff." 226 "Options controlling the visual fluff."
211 :group 'gnus 227 :group 'gnus
212 :group 'faces) 228 :group 'faces)
213 229
214 (defgroup gnus-agent nil 230 (defgroup gnus-agent nil
215 "Offline support for Gnus." 231 "Offline support for Gnus."
230 246
231 (defgroup gnus-server nil 247 (defgroup gnus-server nil
232 "Options related to newsservers and other servers used by Gnus." 248 "Options related to newsservers and other servers used by Gnus."
233 :group 'gnus) 249 :group 'gnus)
234 250
251 (defgroup gnus-server-visual nil
252 "Highlighting and menus in the server buffer."
253 :group 'gnus-visual
254 :group 'gnus-server)
255
235 (defgroup gnus-message '((message custom-group)) 256 (defgroup gnus-message '((message custom-group))
236 "Composing replies and followups in Gnus." 257 "Composing replies and followups in Gnus."
237 :group 'gnus) 258 :group 'gnus)
238 259
239 (defgroup gnus-meta nil 260 (defgroup gnus-meta nil
240 "Meta variables controling major portions of Gnus. 261 "Meta variables controlling major portions of Gnus.
241 In general, modifying these variables does not take affect until Gnus 262 In general, modifying these variables does not take affect until Gnus
242 is restarted, and sometimes reloaded." 263 is restarted, and sometimes reloaded."
243 :group 'gnus) 264 :group 'gnus)
244 265
245 (defgroup gnus-various nil 266 (defgroup gnus-various nil
254 (defgroup gnus-exit nil 275 (defgroup gnus-exit nil
255 "Exiting gnus." 276 "Exiting gnus."
256 :link '(custom-manual "(gnus)Exiting Gnus") 277 :link '(custom-manual "(gnus)Exiting Gnus")
257 :group 'gnus) 278 :group 'gnus)
258 279
259 (defconst gnus-version-number "5.9.0" 280 (defgroup gnus-fun nil
281 "Frivolous Gnus extensions."
282 :link '(custom-manual "(gnus)Exiting Gnus")
283 :group 'gnus)
284
285 (defconst gnus-version-number "5.10.6"
260 "Version number for this version of Gnus.") 286 "Version number for this version of Gnus.")
261 287
262 (defconst gnus-version (format "Gnus v%s" gnus-version-number) 288 (defconst gnus-version (format "Gnus v%s" gnus-version-number)
263 "Version string for this version of Gnus.") 289 "Version string for this version of Gnus.")
264 290
271 297
272 (defcustom gnus-play-startup-jingle nil 298 (defcustom gnus-play-startup-jingle nil
273 "If non-nil, play the Gnus jingle at startup." 299 "If non-nil, play the Gnus jingle at startup."
274 :group 'gnus-start 300 :group 'gnus-start
275 :type 'boolean) 301 :type 'boolean)
302
303 (unless (fboundp 'gnus-group-remove-excess-properties)
304 (defalias 'gnus-group-remove-excess-properties 'ignore))
305
306 (unless (fboundp 'gnus-set-text-properties)
307 (defalias 'gnus-set-text-properties 'set-text-properties))
276 308
277 (unless (featurep 'gnus-xmas) 309 (unless (featurep 'gnus-xmas)
278 (defalias 'gnus-make-overlay 'make-overlay) 310 (defalias 'gnus-make-overlay 'make-overlay)
279 (defalias 'gnus-delete-overlay 'delete-overlay) 311 (defalias 'gnus-delete-overlay 'delete-overlay)
280 (defalias 'gnus-overlay-put 'overlay-put) 312 (defalias 'gnus-overlay-put 'overlay-put)
282 (defalias 'gnus-overlay-buffer 'overlay-buffer) 314 (defalias 'gnus-overlay-buffer 'overlay-buffer)
283 (defalias 'gnus-overlay-start 'overlay-start) 315 (defalias 'gnus-overlay-start 'overlay-start)
284 (defalias 'gnus-overlay-end 'overlay-end) 316 (defalias 'gnus-overlay-end 'overlay-end)
285 (defalias 'gnus-extent-detached-p 'ignore) 317 (defalias 'gnus-extent-detached-p 'ignore)
286 (defalias 'gnus-extent-start-open 'ignore) 318 (defalias 'gnus-extent-start-open 'ignore)
287 (defalias 'gnus-set-text-properties 'set-text-properties)
288 (defalias 'gnus-group-remove-excess-properties 'ignore)
289 (defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window) 319 (defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window)
290 (defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names) 320 (defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names)
291 (defalias 'gnus-character-to-event 'identity) 321 (defalias 'gnus-character-to-event 'identity)
322 (defalias 'gnus-assq-delete-all 'assq-delete-all)
292 (defalias 'gnus-add-text-properties 'add-text-properties) 323 (defalias 'gnus-add-text-properties 'add-text-properties)
293 (defalias 'gnus-put-text-property 'put-text-property) 324 (defalias 'gnus-put-text-property 'put-text-property)
294 (defvar gnus-mode-line-image-cache t) 325 (defvar gnus-mode-line-image-cache t)
295 (if (fboundp 'find-image) 326 (if (fboundp 'find-image)
296 (defun gnus-mode-line-buffer-identification (line) 327 (defun gnus-mode-line-buffer-identification (line)
306 '((:type xpm :file "gnus-pointer.xpm" 337 '((:type xpm :file "gnus-pointer.xpm"
307 :ascent center) 338 :ascent center)
308 (:type xbm :file "gnus-pointer.xbm" 339 (:type xbm :file "gnus-pointer.xbm"
309 :ascent center)))) 340 :ascent center))))
310 gnus-mode-line-image-cache) 341 gnus-mode-line-image-cache)
311 'help-echo "This is Gnus") 342 'help-echo (format
343 "This is %s, %s."
344 gnus-version (gnus-emacs-version)))
312 str) 345 str)
313 (list str)) 346 (list str))
314 line))) 347 line)))
315 (defalias 'gnus-mode-line-buffer-identification 'identity)) 348 (defalias 'gnus-mode-line-buffer-identification 'identity))
316 (defalias 'gnus-characterp 'numberp) 349 (defalias 'gnus-characterp 'numberp)
317 (defalias 'gnus-deactivate-mark 'deactivate-mark) 350 (defalias 'gnus-deactivate-mark 'deactivate-mark)
318 (defalias 'gnus-window-edges 'window-edges) 351 (defalias 'gnus-window-edges 'window-edges)
319 (defalias 'gnus-key-press-event-p 'numberp) 352 (defalias 'gnus-key-press-event-p 'numberp)
320 (defalias 'gnus-decode-rfc1522 'ignore)) 353 ;;(defalias 'gnus-decode-rfc1522 'ignore)
354 )
321 355
322 ;; We define these group faces here to avoid the display 356 ;; We define these group faces here to avoid the display
323 ;; update forced when creating new faces. 357 ;; update forced when creating new faces.
324 358
325 (defface gnus-group-news-1-face 359 (defface gnus-group-news-1-face
326 '((((class color) 360 '((((class color)
327 (background dark)) 361 (background dark))
328 (:foreground "PaleTurquoise" :weight bold)) 362 (:foreground "PaleTurquoise" :bold t))
329 (((class color) 363 (((class color)
330 (background light)) 364 (background light))
331 (:foreground "ForestGreen" :weight bold)) 365 (:foreground "ForestGreen" :bold t))
332 (t 366 (t
333 ())) 367 ()))
334 "Level 1 newsgroup face.") 368 "Level 1 newsgroup face.")
335 369
336 (defface gnus-group-news-1-empty-face 370 (defface gnus-group-news-1-empty-face
345 "Level 1 empty newsgroup face.") 379 "Level 1 empty newsgroup face.")
346 380
347 (defface gnus-group-news-2-face 381 (defface gnus-group-news-2-face
348 '((((class color) 382 '((((class color)
349 (background dark)) 383 (background dark))
350 (:foreground "turquoise" :weight bold)) 384 (:foreground "turquoise" :bold t))
351 (((class color) 385 (((class color)
352 (background light)) 386 (background light))
353 (:foreground "CadetBlue4" :weight bold)) 387 (:foreground "CadetBlue4" :bold t))
354 (t 388 (t
355 ())) 389 ()))
356 "Level 2 newsgroup face.") 390 "Level 2 newsgroup face.")
357 391
358 (defface gnus-group-news-2-empty-face 392 (defface gnus-group-news-2-empty-face
367 "Level 2 empty newsgroup face.") 401 "Level 2 empty newsgroup face.")
368 402
369 (defface gnus-group-news-3-face 403 (defface gnus-group-news-3-face
370 '((((class color) 404 '((((class color)
371 (background dark)) 405 (background dark))
372 (:weight bold)) 406 (:bold t))
373 (((class color) 407 (((class color)
374 (background light)) 408 (background light))
375 (:weight bold)) 409 (:bold t))
376 (t 410 (t
377 ())) 411 ()))
378 "Level 3 newsgroup face.") 412 "Level 3 newsgroup face.")
379 413
380 (defface gnus-group-news-3-empty-face 414 (defface gnus-group-news-3-empty-face
389 "Level 3 empty newsgroup face.") 423 "Level 3 empty newsgroup face.")
390 424
391 (defface gnus-group-news-4-face 425 (defface gnus-group-news-4-face
392 '((((class color) 426 '((((class color)
393 (background dark)) 427 (background dark))
394 (:weight bold)) 428 (:bold t))
395 (((class color) 429 (((class color)
396 (background light)) 430 (background light))
397 (:weight bold)) 431 (:bold t))
398 (t 432 (t
399 ())) 433 ()))
400 "Level 4 newsgroup face.") 434 "Level 4 newsgroup face.")
401 435
402 (defface gnus-group-news-4-empty-face 436 (defface gnus-group-news-4-empty-face
411 "Level 4 empty newsgroup face.") 445 "Level 4 empty newsgroup face.")
412 446
413 (defface gnus-group-news-5-face 447 (defface gnus-group-news-5-face
414 '((((class color) 448 '((((class color)
415 (background dark)) 449 (background dark))
416 (:weight bold)) 450 (:bold t))
417 (((class color) 451 (((class color)
418 (background light)) 452 (background light))
419 (:weight bold)) 453 (:bold t))
420 (t 454 (t
421 ())) 455 ()))
422 "Level 5 newsgroup face.") 456 "Level 5 newsgroup face.")
423 457
424 (defface gnus-group-news-5-empty-face 458 (defface gnus-group-news-5-empty-face
433 "Level 5 empty newsgroup face.") 467 "Level 5 empty newsgroup face.")
434 468
435 (defface gnus-group-news-6-face 469 (defface gnus-group-news-6-face
436 '((((class color) 470 '((((class color)
437 (background dark)) 471 (background dark))
438 (:weight bold)) 472 (:bold t))
439 (((class color) 473 (((class color)
440 (background light)) 474 (background light))
441 (:weight bold)) 475 (:bold t))
442 (t 476 (t
443 ())) 477 ()))
444 "Level 6 newsgroup face.") 478 "Level 6 newsgroup face.")
445 479
446 (defface gnus-group-news-6-empty-face 480 (defface gnus-group-news-6-empty-face
455 "Level 6 empty newsgroup face.") 489 "Level 6 empty newsgroup face.")
456 490
457 (defface gnus-group-news-low-face 491 (defface gnus-group-news-low-face
458 '((((class color) 492 '((((class color)
459 (background dark)) 493 (background dark))
460 (:foreground "DarkTurquoise" :weight bold)) 494 (:foreground "DarkTurquoise" :bold t))
461 (((class color) 495 (((class color)
462 (background light)) 496 (background light))
463 (:foreground "DarkGreen" :weight bold)) 497 (:foreground "DarkGreen" :bold t))
464 (t 498 (t
465 ())) 499 ()))
466 "Low level newsgroup face.") 500 "Low level newsgroup face.")
467 501
468 (defface gnus-group-news-low-empty-face 502 (defface gnus-group-news-low-empty-face
477 "Low level empty newsgroup face.") 511 "Low level empty newsgroup face.")
478 512
479 (defface gnus-group-mail-1-face 513 (defface gnus-group-mail-1-face
480 '((((class color) 514 '((((class color)
481 (background dark)) 515 (background dark))
482 (:foreground "aquamarine1" :weight bold)) 516 (:foreground "aquamarine1" :bold t))
483 (((class color) 517 (((class color)
484 (background light)) 518 (background light))
485 (:foreground "DeepPink3" :weight bold)) 519 (:foreground "DeepPink3" :bold t))
486 (t 520 (t
487 (:weight bold))) 521 (:bold t)))
488 "Level 1 mailgroup face.") 522 "Level 1 mailgroup face.")
489 523
490 (defface gnus-group-mail-1-empty-face 524 (defface gnus-group-mail-1-empty-face
491 '((((class color) 525 '((((class color)
492 (background dark)) 526 (background dark))
493 (:foreground "aquamarine1")) 527 (:foreground "aquamarine1"))
494 (((class color) 528 (((class color)
495 (background light)) 529 (background light))
496 (:foreground "DeepPink3")) 530 (:foreground "DeepPink3"))
497 (t 531 (t
498 (:slant italic :weight bold))) 532 (:italic t :bold t)))
499 "Level 1 empty mailgroup face.") 533 "Level 1 empty mailgroup face.")
500 534
501 (defface gnus-group-mail-2-face 535 (defface gnus-group-mail-2-face
502 '((((class color) 536 '((((class color)
503 (background dark)) 537 (background dark))
504 (:foreground "aquamarine2" :weight bold)) 538 (:foreground "aquamarine2" :bold t))
505 (((class color) 539 (((class color)
506 (background light)) 540 (background light))
507 (:foreground "HotPink3" :weight bold)) 541 (:foreground "HotPink3" :bold t))
508 (t 542 (t
509 (:weight bold))) 543 (:bold t)))
510 "Level 2 mailgroup face.") 544 "Level 2 mailgroup face.")
511 545
512 (defface gnus-group-mail-2-empty-face 546 (defface gnus-group-mail-2-empty-face
513 '((((class color) 547 '((((class color)
514 (background dark)) 548 (background dark))
515 (:foreground "aquamarine2")) 549 (:foreground "aquamarine2"))
516 (((class color) 550 (((class color)
517 (background light)) 551 (background light))
518 (:foreground "HotPink3")) 552 (:foreground "HotPink3"))
519 (t 553 (t
520 (:weight bold))) 554 (:bold t)))
521 "Level 2 empty mailgroup face.") 555 "Level 2 empty mailgroup face.")
522 556
523 (defface gnus-group-mail-3-face 557 (defface gnus-group-mail-3-face
524 '((((class color) 558 '((((class color)
525 (background dark)) 559 (background dark))
526 (:foreground "aquamarine3" :weight bold)) 560 (:foreground "aquamarine3" :bold t))
527 (((class color) 561 (((class color)
528 (background light)) 562 (background light))
529 (:foreground "magenta4" :weight bold)) 563 (:foreground "magenta4" :bold t))
530 (t 564 (t
531 (:weight bold))) 565 (:bold t)))
532 "Level 3 mailgroup face.") 566 "Level 3 mailgroup face.")
533 567
534 (defface gnus-group-mail-3-empty-face 568 (defface gnus-group-mail-3-empty-face
535 '((((class color) 569 '((((class color)
536 (background dark)) 570 (background dark))
543 "Level 3 empty mailgroup face.") 577 "Level 3 empty mailgroup face.")
544 578
545 (defface gnus-group-mail-low-face 579 (defface gnus-group-mail-low-face
546 '((((class color) 580 '((((class color)
547 (background dark)) 581 (background dark))
548 (:foreground "aquamarine4" :weight bold)) 582 (:foreground "aquamarine4" :bold t))
549 (((class color) 583 (((class color)
550 (background light)) 584 (background light))
551 (:foreground "DeepPink4" :weight bold)) 585 (:foreground "DeepPink4" :bold t))
552 (t 586 (t
553 (:weight bold))) 587 (:bold t)))
554 "Low level mailgroup face.") 588 "Low level mailgroup face.")
555 589
556 (defface gnus-group-mail-low-empty-face 590 (defface gnus-group-mail-low-empty-face
557 '((((class color) 591 '((((class color)
558 (background dark)) 592 (background dark))
559 (:foreground "aquamarine4")) 593 (:foreground "aquamarine4"))
560 (((class color) 594 (((class color)
561 (background light)) 595 (background light))
562 (:foreground "DeepPink4")) 596 (:foreground "DeepPink4"))
563 (t 597 (t
564 (:weight bold))) 598 (:bold t)))
565 "Low level empty mailgroup face.") 599 "Low level empty mailgroup face.")
566 600
567 ;; Summary mode faces. 601 ;; Summary mode faces.
568 602
569 (defface gnus-summary-selected-face '((t 603 (defface gnus-summary-selected-face '((t
576 "Face used for cancelled articles.") 610 "Face used for cancelled articles.")
577 611
578 (defface gnus-summary-high-ticked-face 612 (defface gnus-summary-high-ticked-face
579 '((((class color) 613 '((((class color)
580 (background dark)) 614 (background dark))
581 (:foreground "pink" :weight bold)) 615 (:foreground "pink" :bold t))
582 (((class color) 616 (((class color)
583 (background light)) 617 (background light))
584 (:foreground "firebrick" :weight bold)) 618 (:foreground "firebrick" :bold t))
585 (t 619 (t
586 (:weight bold))) 620 (:bold t)))
587 "Face used for high interest ticked articles.") 621 "Face used for high interest ticked articles.")
588 622
589 (defface gnus-summary-low-ticked-face 623 (defface gnus-summary-low-ticked-face
590 '((((class color) 624 '((((class color)
591 (background dark)) 625 (background dark))
592 (:foreground "pink" :slant italic)) 626 (:foreground "pink" :italic t))
593 (((class color) 627 (((class color)
594 (background light)) 628 (background light))
595 (:foreground "firebrick" :slant italic)) 629 (:foreground "firebrick" :italic t))
596 (t 630 (t
597 (:slant italic))) 631 (:italic t)))
598 "Face used for low interest ticked articles.") 632 "Face used for low interest ticked articles.")
599 633
600 (defface gnus-summary-normal-ticked-face 634 (defface gnus-summary-normal-ticked-face
601 '((((class color) 635 '((((class color)
602 (background dark)) 636 (background dark))
609 "Face used for normal interest ticked articles.") 643 "Face used for normal interest ticked articles.")
610 644
611 (defface gnus-summary-high-ancient-face 645 (defface gnus-summary-high-ancient-face
612 '((((class color) 646 '((((class color)
613 (background dark)) 647 (background dark))
614 (:foreground "SkyBlue" :weight bold)) 648 (:foreground "SkyBlue" :bold t))
615 (((class color) 649 (((class color)
616 (background light)) 650 (background light))
617 (:foreground "RoyalBlue" :weight bold)) 651 (:foreground "RoyalBlue" :bold t))
618 (t 652 (t
619 (:weight bold))) 653 (:bold t)))
620 "Face used for high interest ancient articles.") 654 "Face used for high interest ancient articles.")
621 655
622 (defface gnus-summary-low-ancient-face 656 (defface gnus-summary-low-ancient-face
623 '((((class color) 657 '((((class color)
624 (background dark)) 658 (background dark))
625 (:foreground "SkyBlue" :slant italic)) 659 (:foreground "SkyBlue" :italic t))
626 (((class color) 660 (((class color)
627 (background light)) 661 (background light))
628 (:foreground "RoyalBlue" :slant italic)) 662 (:foreground "RoyalBlue" :italic t))
629 (t 663 (t
630 (:slant italic))) 664 (:italic t)))
631 "Face used for low interest ancient articles.") 665 "Face used for low interest ancient articles.")
632 666
633 (defface gnus-summary-normal-ancient-face 667 (defface gnus-summary-normal-ancient-face
634 '((((class color) 668 '((((class color)
635 (background dark)) 669 (background dark))
639 (:foreground "RoyalBlue")) 673 (:foreground "RoyalBlue"))
640 (t 674 (t
641 ())) 675 ()))
642 "Face used for normal interest ancient articles.") 676 "Face used for normal interest ancient articles.")
643 677
678 (defface gnus-summary-high-undownloaded-face
679 '((((class color)
680 (background light))
681 (:bold t :foreground "cyan4"))
682 (((class color) (background dark))
683 (:bold t :foreground "LightGray"))
684 (t (:inverse-video t :bold t)))
685 "Face used for high interest uncached articles.")
686
687 (defface gnus-summary-low-undownloaded-face
688 '((((class color)
689 (background light))
690 (:italic t :foreground "cyan4" :bold nil))
691 (((class color) (background dark))
692 (:italic t :foreground "LightGray" :bold nil))
693 (t (:inverse-video t :italic t)))
694 "Face used for low interest uncached articles.")
695
696 (defface gnus-summary-normal-undownloaded-face
697 '((((class color)
698 (background light))
699 (:foreground "cyan4" :bold nil))
700 (((class color) (background dark))
701 (:foreground "LightGray" :bold nil))
702 (t (:inverse-video t)))
703 "Face used for normal interest uncached articles.")
704
644 (defface gnus-summary-high-unread-face 705 (defface gnus-summary-high-unread-face
645 '((t 706 '((t
646 (:weight bold))) 707 (:bold t)))
647 "Face used for high interest unread articles.") 708 "Face used for high interest unread articles.")
648 709
649 (defface gnus-summary-low-unread-face 710 (defface gnus-summary-low-unread-face
650 '((t 711 '((t
651 (:slant italic))) 712 (:italic t)))
652 "Face used for low interest unread articles.") 713 "Face used for low interest unread articles.")
653 714
654 (defface gnus-summary-normal-unread-face 715 (defface gnus-summary-normal-unread-face
655 '((t 716 '((t
656 ())) 717 ()))
658 719
659 (defface gnus-summary-high-read-face 720 (defface gnus-summary-high-read-face
660 '((((class color) 721 '((((class color)
661 (background dark)) 722 (background dark))
662 (:foreground "PaleGreen" 723 (:foreground "PaleGreen"
663 :weight bold)) 724 :bold t))
664 (((class color) 725 (((class color)
665 (background light)) 726 (background light))
666 (:foreground "DarkGreen" 727 (:foreground "DarkGreen"
667 :weight bold)) 728 :bold t))
668 (t 729 (t
669 (:weight bold))) 730 (:bold t)))
670 "Face used for high interest read articles.") 731 "Face used for high interest read articles.")
671 732
672 (defface gnus-summary-low-read-face 733 (defface gnus-summary-low-read-face
673 '((((class color) 734 '((((class color)
674 (background dark)) 735 (background dark))
675 (:foreground "PaleGreen" 736 (:foreground "PaleGreen"
676 :slant italic)) 737 :italic t))
677 (((class color) 738 (((class color)
678 (background light)) 739 (background light))
679 (:foreground "DarkGreen" 740 (:foreground "DarkGreen"
680 :slant italic)) 741 :italic t))
681 (t 742 (t
682 (:slant italic))) 743 (:italic t)))
683 "Face used for low interest read articles.") 744 "Face used for low interest read articles.")
684 745
685 (defface gnus-summary-normal-read-face 746 (defface gnus-summary-normal-read-face
686 '((((class color) 747 '((((class color)
687 (background dark)) 748 (background dark))
706 (car (push (get-buffer-create name) gnus-buffers)))) 767 (car (push (get-buffer-create name) gnus-buffers))))
707 768
708 (defun gnus-add-buffer () 769 (defun gnus-add-buffer ()
709 "Add the current buffer to the list of Gnus buffers." 770 "Add the current buffer to the list of Gnus buffers."
710 (push (current-buffer) gnus-buffers)) 771 (push (current-buffer) gnus-buffers))
772
773 (defmacro gnus-kill-buffer (buffer)
774 "Kill BUFFER and remove from the list of Gnus buffers."
775 `(let ((buf ,buffer))
776 (when (gnus-buffer-exists-p buf)
777 (setq gnus-buffers (delete (get-buffer buf) gnus-buffers))
778 (kill-buffer buf))))
711 779
712 (defun gnus-buffers () 780 (defun gnus-buffers ()
713 "Return a list of live Gnus buffers." 781 "Return a list of live Gnus buffers."
714 (while (and gnus-buffers 782 (while (and gnus-buffers
715 (not (buffer-name (car gnus-buffers)))) 783 (not (buffer-name (car gnus-buffers))))
729 (autoload 'gnus-play-jingle "gnus-audio")) 797 (autoload 'gnus-play-jingle "gnus-audio"))
730 798
731 (defface gnus-splash-face 799 (defface gnus-splash-face
732 '((((class color) 800 '((((class color)
733 (background dark)) 801 (background dark))
734 (:foreground "Brown")) 802 (:foreground "#888888"))
735 (((class color) 803 (((class color)
736 (background light)) 804 (background light))
737 (:foreground "Brown")) 805 (:foreground "#888888"))
738 (t 806 (t
739 ())) 807 ()))
740 "Face of the splash screen.") 808 "Face for the splash screen.")
741 809
742 (defun gnus-splash () 810 (defun gnus-splash ()
743 (save-excursion 811 (save-excursion
744 (switch-to-buffer (gnus-get-buffer-create gnus-group-buffer)) 812 (switch-to-buffer (gnus-get-buffer-create gnus-group-buffer))
745 (let ((buffer-read-only nil)) 813 (let ((buffer-read-only nil))
763 (while (search-forward "\t" nil t) 831 (while (search-forward "\t" nil t)
764 (replace-match " " t t)))))) 832 (replace-match " " t t))))))
765 833
766 (defvar gnus-simple-splash nil) 834 (defvar gnus-simple-splash nil)
767 835
836 ;;(format "%02x%02x%02x" 114 66 20) "724214"
837
838 (defvar gnus-logo-color-alist
839 '((flame "#cc3300" "#ff2200")
840 (pine "#c0cc93" "#f8ffb8")
841 (moss "#a1cc93" "#d2ffb8")
842 (irish "#04cc90" "#05ff97")
843 (sky "#049acc" "#05deff")
844 (tin "#6886cc" "#82b6ff")
845 (velvet "#7c68cc" "#8c82ff")
846 (grape "#b264cc" "#cf7df")
847 (labia "#cc64c2" "#fd7dff")
848 (berry "#cc6485" "#ff7db5")
849 (dino "#724214" "#1e3f03")
850 (oort "#cccccc" "#888888")
851 (storm "#666699" "#99ccff")
852 (pdino "#9999cc" "#99ccff")
853 (purp "#9999cc" "#666699")
854 (no "#000000" "#ff0000")
855 (neutral "#b4b4b4" "#878787")
856 (september "#bf9900" "#ffcc00"))
857 "Color alist used for the Gnus logo.")
858
859 (defcustom gnus-logo-color-style 'oort
860 "*Color styles used for the Gnus logo."
861 :type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem)))
862 gnus-logo-color-alist))
863 :group 'gnus-xmas)
864
865 (defvar gnus-logo-colors
866 (cdr (assq gnus-logo-color-style gnus-logo-color-alist))
867 "Colors used for the Gnus logo.")
868
768 (defun gnus-group-startup-message (&optional x y) 869 (defun gnus-group-startup-message (&optional x y)
769 "Insert startup message in current buffer." 870 "Insert startup message in current buffer."
770 ;; Insert the message. 871 ;; Insert the message.
771 (erase-buffer) 872 (erase-buffer)
772 (cond 873 (cond
773 ((and 874 ((and
774 (fboundp 'find-image) 875 (fboundp 'find-image)
775 (display-graphic-p) 876 (display-graphic-p)
776 (let ((image (find-image 877 (let* ((data-directory (nnheader-find-etc-directory "gnus"))
777 `((:type xpm :file "gnus.xpm") 878 (image (find-image
778 (:type pbm :file "gnus.pbm" 879 `((:type xpm :file "gnus.xpm"
779 ;; Account for the pbm's blackground. 880 :color-symbols
780 :background ,(face-foreground 'gnus-splash-face) 881 (("thing" . ,(car gnus-logo-colors))
781 :foreground ,(face-background 'default)) 882 ("shadow" . ,(cadr gnus-logo-colors))
782 (:type xbm :file "gnus.xbm" 883 ("oort" . "#eeeeee")
783 ;; Account for the xbm's blackground. 884 ("background" . ,(face-background 'default))))
784 :background ,(face-foreground 'gnus-splash-face) 885 (:type pbm :file "gnus.pbm"
785 :foreground ,(face-background 'default)))))) 886 ;; Account for the pbm's blackground.
887 :background ,(face-foreground 'gnus-splash-face)
888 :foreground ,(face-background 'default))
889 (:type xbm :file "gnus.xbm"
890 ;; Account for the xbm's blackground.
891 :background ,(face-foreground 'gnus-splash-face)
892 :foreground ,(face-background 'default))))))
786 (when image 893 (when image
787 (let ((size (image-size image))) 894 (let ((size (image-size image)))
788 (insert-char ?\n (max 0 (round (- (window-height) 895 (insert-char ?\n (max 0 (round (- (window-height)
789 (or y (cdr size)) 1) 2))) 896 (or y (cdr size)) 1) 2)))
790 (insert-char ?\ (max 0 (round (- (window-width) 897 (insert-char ?\ (max 0 (round (- (window-width)
841 ;;; Do the rest. 948 ;;; Do the rest.
842 949
843 (require 'gnus-util) 950 (require 'gnus-util)
844 (require 'nnheader) 951 (require 'nnheader)
845 952
953 (defcustom gnus-parameters nil
954 "Alist of group parameters.
955
956 For example:
957 ((\"mail\\\\..*\" (gnus-show-threads nil)
958 (gnus-use-scoring nil)
959 (gnus-summary-line-format
960 \"%U%R%z%I%(%[%d:%ub%-23,23f%]%) %s\\n\")
961 (gcc-self . t)
962 (display . all))
963 (\"mail\\\\.me\" (gnus-use-scoring t))
964 (\"list\\\\..*\" (total-expire . t)
965 (broken-reply-to . t)))"
966 :group 'gnus-group-various
967 :type '(repeat (cons regexp
968 (repeat sexp))))
969
970 (defvar gnus-group-parameters-more nil)
971
972 (defmacro gnus-define-group-parameter (param &rest rest)
973 "Define a group parameter PARAM.
974 REST is a plist of following:
975 :type One of `bool', `list' or nil.
976 :function The name of the function.
977 :function-document The documentation of the function.
978 :parameter-type The type for customizing the parameter.
979 :parameter-document The documentation for the parameter.
980 :variable The name of the variable.
981 :variable-document The documentation for the variable.
982 :variable-group The group for customizing the variable.
983 :variable-type The type for customizing the variable.
984 :variable-default The default value of the variable."
985 (let* ((type (plist-get rest :type))
986 (parameter-type (plist-get rest :parameter-type))
987 (parameter-document (plist-get rest :parameter-document))
988 (function (or (plist-get rest :function)
989 (intern (format "gnus-parameter-%s" param))))
990 (function-document (or (plist-get rest :function-document) ""))
991 (variable (or (plist-get rest :variable)
992 (intern (format "gnus-parameter-%s-alist" param))))
993 (variable-document (or (plist-get rest :variable-document) ""))
994 (variable-group (plist-get rest :variable-group))
995 (variable-type (or (plist-get rest :variable-type)
996 `(quote (repeat
997 (list (regexp :tag "Group")
998 ,(car (cdr parameter-type)))))))
999 (variable-default (plist-get rest :variable-default)))
1000 (list
1001 'progn
1002 `(defcustom ,variable ,variable-default
1003 ,variable-document
1004 :group 'gnus-group-parameter
1005 :group ',variable-group
1006 :type ,variable-type)
1007 `(setq gnus-group-parameters-more
1008 (delq (assq ',param gnus-group-parameters-more)
1009 gnus-group-parameters-more))
1010 `(add-to-list 'gnus-group-parameters-more
1011 (list ',param
1012 ,parameter-type
1013 ,parameter-document))
1014 (if (eq type 'bool)
1015 `(defun ,function (name)
1016 ,function-document
1017 (let ((params (gnus-group-find-parameter name))
1018 val)
1019 (cond
1020 ((memq ',param params)
1021 t)
1022 ((setq val (assq ',param params))
1023 (cdr val))
1024 ((stringp ,variable)
1025 (string-match ,variable name))
1026 (,variable
1027 (let ((alist ,variable)
1028 elem value)
1029 (while (setq elem (pop alist))
1030 (when (and name
1031 (string-match (car elem) name))
1032 (setq alist nil
1033 value (cdr elem))))
1034 (if (consp value) (car value) value))))))
1035 `(defun ,function (name)
1036 ,function-document
1037 (and name
1038 (or (gnus-group-find-parameter name ',param ,(and type t))
1039 (let ((alist ,variable)
1040 elem value)
1041 (while (setq elem (pop alist))
1042 (when (and name
1043 (string-match (car elem) name))
1044 (setq alist nil
1045 value (cdr elem))))
1046 ,(if type
1047 'value
1048 '(if (consp value) (car value) value))))))))))
1049
846 (defcustom gnus-home-directory "~/" 1050 (defcustom gnus-home-directory "~/"
847 "Directory variable that specifies the \"home\" directory. 1051 "Directory variable that specifies the \"home\" directory.
848 All other Gnus file and directory variables are initialized from this variable." 1052 All other Gnus file and directory variables are initialized from this variable."
849 :group 'gnus-files 1053 :group 'gnus-files
850 :type 'directory) 1054 :type 'directory)
889 "A file with only the name of the nntp server in it." 1093 "A file with only the name of the nntp server in it."
890 :group 'gnus-files 1094 :group 'gnus-files
891 :group 'gnus-server 1095 :group 'gnus-server
892 :type 'file) 1096 :type 'file)
893 1097
894 ;; This function is used to check both the environment variable
895 ;; NNTPSERVER and the /etc/nntpserver file to see whether one can find
896 ;; an nntp server name default.
897 (defun gnus-getenv-nntpserver () 1098 (defun gnus-getenv-nntpserver ()
1099 "Find default nntp server.
1100 Check the NNTPSERVER environment variable and the
1101 `gnus-nntpserver-file' file."
898 (or (getenv "NNTPSERVER") 1102 (or (getenv "NNTPSERVER")
899 (and (file-readable-p gnus-nntpserver-file) 1103 (and (file-readable-p gnus-nntpserver-file)
900 (save-excursion 1104 (with-temp-buffer
901 (set-buffer (gnus-get-buffer-create " *gnus nntp*"))
902 (insert-file-contents gnus-nntpserver-file) 1105 (insert-file-contents gnus-nntpserver-file)
903 (let ((name (buffer-string))) 1106 (let ((name (buffer-string)))
904 (prog1 1107 (unless (string-match "\\`[ \t\n]*$" name)
905 (if (string-match "\\'[ \t\n]*$" name) 1108 name))))))
906 nil
907 name)
908 (kill-buffer (current-buffer))))))))
909 1109
910 (defcustom gnus-select-method 1110 (defcustom gnus-select-method
911 (condition-case nil 1111 (condition-case nil
912 (nconc 1112 (nconc
913 (list 'nntp (or (condition-case nil 1113 (list 'nntp (or (condition-case nil
924 (error nil)) 1124 (error nil))
925 "Default method for selecting a newsgroup. 1125 "Default method for selecting a newsgroup.
926 This variable should be a list, where the first element is how the 1126 This variable should be a list, where the first element is how the
927 news is to be fetched, the second is the address. 1127 news is to be fetched, the second is the address.
928 1128
929 For instance, if you want to get your news via NNTP from 1129 For instance, if you want to get your news via \"flab.flab.edu\" using
930 \"flab.flab.edu\", you could say: 1130 NNTP, you could say:
931 1131
932 \(setq gnus-select-method '(nntp \"flab.flab.edu\")) 1132 \(setq gnus-select-method '(nntp \"flab.flab.edu\"))
933 1133
934 If you want to use your local spool, say: 1134 If you want to use your local spool, say:
935 1135
940 There is a lot more to know about select methods and virtual servers - 1140 There is a lot more to know about select methods and virtual servers -
941 see the manual for details." 1141 see the manual for details."
942 :group 'gnus-server 1142 :group 'gnus-server
943 :type 'gnus-select-method) 1143 :type 'gnus-select-method)
944 1144
945 (defcustom gnus-message-archive-method 1145 (defcustom gnus-message-archive-method "archive"
946 (progn
947 ;; Don't require it at top level to avoid circularity.
948 (require 'message)
949 `(nnfolder
950 "archive"
951 (nnfolder-directory ,(nnheader-concat message-directory "archive"))
952 (nnfolder-active-file
953 ,(nnheader-concat message-directory "archive/active"))
954 (nnfolder-get-new-mail nil)
955 (nnfolder-inhibit-expiry t)))
956 "*Method used for archiving messages you've sent. 1146 "*Method used for archiving messages you've sent.
957 This should be a mail method. 1147 This should be a mail method."
958
959 It's probably not very effective to change this variable once you've
960 run Gnus once. After doing that, you must edit this server from the
961 server buffer."
962 :group 'gnus-server 1148 :group 'gnus-server
963 :group 'gnus-message 1149 :group 'gnus-message
964 :type 'gnus-select-method) 1150 :type '(choice (const :tag "Default archive method" "archive")
1151 gnus-select-method))
965 1152
966 (defcustom gnus-message-archive-group nil 1153 (defcustom gnus-message-archive-group nil
967 "*Name of the group in which to save the messages you've written. 1154 "*Name of the group in which to save the messages you've written.
968 This can either be a string; a list of strings; or an alist 1155 This can either be a string; a list of strings; or an alist
969 of regexps/functions/forms to be evaluated to return a string (or a list 1156 of regexps/functions/forms to be evaluated to return a string (or a list
972 1159
973 If you want to save your mail in one group and the news articles you 1160 If you want to save your mail in one group and the news articles you
974 write in another group, you could say something like: 1161 write in another group, you could say something like:
975 1162
976 \(setq gnus-message-archive-group 1163 \(setq gnus-message-archive-group
977 '((if (message-news-p) 1164 '((if (message-news-p)
978 \"misc-news\" 1165 \"misc-news\"
979 \"misc-mail\"))) 1166 \"misc-mail\")))
980 1167
981 Normally the group names returned by this variable should be 1168 Normally the group names returned by this variable should be
982 unprefixed -- which implicitly means \"store on the archive server\". 1169 unprefixed -- which implicitly means \"store on the archive server\".
983 However, you may wish to store the message on some other server. In 1170 However, you may wish to store the message on some other server. In
984 that case, just return a fully prefixed name of the group -- 1171 that case, just return a fully prefixed name of the group --
1007 (defcustom gnus-secondary-select-methods nil 1194 (defcustom gnus-secondary-select-methods nil
1008 "A list of secondary methods that will be used for reading news. 1195 "A list of secondary methods that will be used for reading news.
1009 This is a list where each element is a complete select method (see 1196 This is a list where each element is a complete select method (see
1010 `gnus-select-method'). 1197 `gnus-select-method').
1011 1198
1012 If, for instance, you want to read your mail with the nnml backend, 1199 If, for instance, you want to read your mail with the nnml back end,
1013 you could set this variable: 1200 you could set this variable:
1014 1201
1015 \(setq gnus-secondary-select-methods '((nnml \"\")))" 1202 \(setq gnus-secondary-select-methods '((nnml \"\")))"
1016 :group 'gnus-server 1203 :group 'gnus-server
1017 :type '(repeat gnus-select-method)) 1204 :type '(repeat gnus-select-method))
1048 It can also be a list of select methods, as well as the special symbol 1235 It can also be a list of select methods, as well as the special symbol
1049 `current', which means to use the current select method. If it is a 1236 `current', which means to use the current select method. If it is a
1050 list, Gnus will try all the methods in the list until it finds a match." 1237 list, Gnus will try all the methods in the list until it finds a match."
1051 :group 'gnus-server 1238 :group 'gnus-server
1052 :type '(choice (const :tag "default" nil) 1239 :type '(choice (const :tag "default" nil)
1053 (const :tag "DejaNews" (nnweb "refer" (nnweb-type dejanews))) 1240 (const current)
1241 (const :tag "Google" (nnweb "refer" (nnweb-type google)))
1054 gnus-select-method 1242 gnus-select-method
1055 (repeat :menu-tag "Try multiple" 1243 (repeat :menu-tag "Try multiple"
1056 :tag "Multiple" 1244 :tag "Multiple"
1057 :value (current (nnweb "refer" (nnweb-type dejanews))) 1245 :value (current (nnweb "refer" (nnweb-type google)))
1058 (choice :tag "Method" 1246 (choice :tag "Method"
1059 (const current) 1247 (const current)
1060 (const :tag "DejaNews" 1248 (const :tag "Google"
1061 (nnweb "refer" (nnweb-type dejanews))) 1249 (nnweb "refer" (nnweb-type google)))
1062 gnus-select-method)))) 1250 gnus-select-method))))
1063 1251
1064 (defcustom gnus-group-faq-directory 1252 (defcustom gnus-group-faq-directory
1065 '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/" 1253 '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/"
1066 "/ftp@sunsite.auc.dk:/pub/usenet/"
1067 "/ftp@sunsite.doc.ic.ac.uk:/pub/usenet/news-faqs/" 1254 "/ftp@sunsite.doc.ic.ac.uk:/pub/usenet/news-faqs/"
1068 "/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/" 1255 "/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/"
1069 "/ftp@ftp.seas.gwu.edu:/pub/rtfm/" 1256 "/ftp@ftp.seas.gwu.edu:/pub/rtfm/"
1257 "/ftp@ftp.pasteur.fr:/pub/FAQ/"
1070 "/ftp@rtfm.mit.edu:/pub/usenet/" 1258 "/ftp@rtfm.mit.edu:/pub/usenet/"
1071 "/ftp@ftp.uni-paderborn.de:/pub/FAQ/" 1259 "/ftp@ftp.uni-paderborn.de:/pub/FAQ/"
1072 "/ftp@ftp.sunet.se:/pub/usenet/" 1260 "/ftp@ftp.sunet.se:/pub/usenet/"
1073 "/ftp@nctuccca.edu.tw:/USENET/FAQ/" 1261 "/ftp@nctuccca.nctu.edu.tw:/pub/Documents/rtfm/usenet-by-group/"
1074 "/ftp@hwarang.postech.ac.kr:/pub/usenet/" 1262 "/ftp@hwarang.postech.ac.kr:/pub/usenet/"
1075 "/ftp@ftp.hk.super.net:/mirror/faqs/") 1263 "/ftp@ftp.hk.super.net:/mirror/faqs/")
1076 "*Directory where the group FAQs are stored. 1264 "*Directory where the group FAQs are stored.
1077 This will most commonly be on a remote machine, and the file will be 1265 This will most commonly be on a remote machine, and the file will be
1078 fetched by ange-ftp. 1266 fetched by ange-ftp.
1089 1277
1090 North America: mirrors.aol.com /pub/rtfm/usenet 1278 North America: mirrors.aol.com /pub/rtfm/usenet
1091 ftp.seas.gwu.edu /pub/rtfm 1279 ftp.seas.gwu.edu /pub/rtfm
1092 rtfm.mit.edu /pub/usenet 1280 rtfm.mit.edu /pub/usenet
1093 Europe: ftp.uni-paderborn.de /pub/FAQ 1281 Europe: ftp.uni-paderborn.de /pub/FAQ
1094 src.doc.ic.ac.uk /usenet/news-FAQS 1282 src.doc.ic.ac.uk /usenet/news-FAQS
1095 ftp.sunet.se /pub/usenet 1283 ftp.sunet.se /pub/usenet
1096 sunsite.auc.dk /pub/usenet 1284 ftp.pasteur.fr /pub/FAQ
1097 Asia: nctuccca.edu.tw /USENET/FAQ 1285 Asia: nctuccca.nctu.edu.tw /pub/Documents/rtfm/usenet-by-group/
1098 hwarang.postech.ac.kr /pub/usenet 1286 hwarang.postech.ac.kr /pub/usenet
1099 ftp.hk.super.net /mirror/faqs" 1287 ftp.hk.super.net /mirror/faqs"
1100 :group 'gnus-group-various 1288 :group 'gnus-group-various
1101 :type '(choice directory 1289 :type '(choice directory
1102 (repeat directory))) 1290 (repeat directory)))
1291
1292 (defcustom gnus-group-charter-alist
1293 '(("no" . (concat "http://no.news-admin.org/charter/" name ".txt"))
1294 ("de" . (concat "http://purl.net/charta/" name ".html"))
1295 ("dk" . (concat "http://www.usenet.dk/grupper.pl?get=" name))
1296 ("england" . (concat "http://england.news-admin.org/charters/" name))
1297 ("fr" . (concat "http://www.usenet-fr.net/fur/chartes/" name ".html"))
1298 ("europa" . (concat "http://www.europa.usenet.eu.org/chartas/charta-en-"
1299 (gnus-replace-in-string name "europa\\." "") ".html"))
1300 ("nl" . (concat "http://www.xs4all.nl/~sister/usenet/charters/" name))
1301 ("aus" . (concat "http://aus.news-admin.org/groupinfo.cgi/" name))
1302 ("pl" . (concat "http://www.usenet.pl/opisy/" name))
1303 ("ch" . (concat "http://www.use-net.ch/Usenet/charter.html#" name))
1304 ("at" . (concat "http://www.usenet.at/chartas/" name "/charta"))
1305 ("uk" . (concat "http://www.usenet.org.uk/" name ".html"))
1306 ("dfw" . (concat "http://www.cirr.com/dfw/charters/" name ".html"))
1307 ("se" . (concat "http://www.usenet-se.net/Reglementen/"
1308 (gnus-replace-in-string name "\\." "_") ".html"))
1309 ("milw" . (concat "http://usenet.mil.wi.us/"
1310 (gnus-replace-in-string name "milw\\." "") "-charter"))
1311 ("ca" . (concat "http://www.sbay.org/ca/charter-" name ".html"))
1312 ("netins" . (concat "http://www.netins.net/usenet/charter/"
1313 (gnus-replace-in-string name "\\." "-") "-charter.html")))
1314 "*An alist of (HIERARCHY . FORM) pairs used to construct the URL of a charter.
1315 When FORM is evaluated `name' is bound to the name of the group."
1316 :group 'gnus-group-various
1317 :type '(repeat (cons (string :tag "Hierarchy") (sexp :tag "Form"))))
1318
1319 (defcustom gnus-group-fetch-control-use-browse-url nil
1320 "*Non-nil means that control messages are displayed using `browse-url'.
1321 Otherwise they are fetched with ange-ftp and displayed in an ephemeral
1322 group."
1323 :group 'gnus-group-various
1324 :type 'boolean)
1103 1325
1104 (defcustom gnus-use-cross-reference t 1326 (defcustom gnus-use-cross-reference t
1105 "*Non-nil means that cross referenced articles will be marked as read. 1327 "*Non-nil means that cross referenced articles will be marked as read.
1106 If nil, ignore cross references. If t, mark articles as read in 1328 If nil, ignore cross references. If t, mark articles as read in
1107 subscribed newsgroups. If neither t nor nil, mark as read in all 1329 subscribed newsgroups. If neither t nor nil, mark as read in all
1119 :type 'character) 1341 :type 'character)
1120 1342
1121 (defcustom gnus-large-newsgroup 200 1343 (defcustom gnus-large-newsgroup 200
1122 "*The number of articles which indicates a large newsgroup. 1344 "*The number of articles which indicates a large newsgroup.
1123 If the number of articles in a newsgroup is greater than this value, 1345 If the number of articles in a newsgroup is greater than this value,
1124 confirmation is required for selecting the newsgroup." 1346 confirmation is required for selecting the newsgroup.
1347 If it is nil, no confirmation is required."
1125 :group 'gnus-group-select 1348 :group 'gnus-group-select
1126 :type 'integer) 1349 :type '(choice (const :tag "No limit" nil)
1350 integer))
1127 1351
1128 (defcustom gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix))) 1352 (defcustom gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix)))
1129 "*Non-nil means that the default name of a file to save articles in is the group name. 1353 "*Non-nil means that the default name of a file to save articles in is the group name.
1130 If it's nil, the directory form of the group name is used instead. 1354 If it's nil, the directory form of the group name is used instead.
1131 1355
1137 1361
1138 Note that the default for this variable varies according to what system 1362 Note that the default for this variable varies according to what system
1139 type you're using. On `usg-unix-v' and `xenix' this variable defaults 1363 type you're using. On `usg-unix-v' and `xenix' this variable defaults
1140 to nil while on all other systems it defaults to t." 1364 to nil while on all other systems it defaults to t."
1141 :group 'gnus-start 1365 :group 'gnus-start
1142 :type 'boolean) 1366 :type '(radio (sexp :format "Non-nil\n"
1367 :match (lambda (widget value)
1368 (and value (not (listp value))))
1369 :value t)
1370 (const nil)
1371 (checklist (const :format "%v " not-score)
1372 (const :format "%v " not-save)
1373 (const not-kill))))
1143 1374
1144 (defcustom gnus-kill-files-directory gnus-directory 1375 (defcustom gnus-kill-files-directory gnus-directory
1145 "*Name of the directory where kill files will be stored (default \"~/News\")." 1376 "*Name of the directory where kill files will be stored (default \"~/News\")."
1146 :group 'gnus-score-files 1377 :group 'gnus-score-files
1147 :group 'gnus-score-kill 1378 :group 'gnus-score-kill
1186 (defcustom gnus-use-grouplens nil 1417 (defcustom gnus-use-grouplens nil
1187 "*If non-nil, use GroupLens ratings." 1418 "*If non-nil, use GroupLens ratings."
1188 :group 'gnus-meta 1419 :group 'gnus-meta
1189 :type 'boolean) 1420 :type 'boolean)
1190 1421
1191 (defcustom gnus-keep-backlog nil 1422 (defcustom gnus-keep-backlog 20
1192 "*If non-nil, Gnus will keep read articles for later re-retrieval. 1423 "*If non-nil, Gnus will keep read articles for later re-retrieval.
1193 If it is a number N, then Gnus will only keep the last N articles 1424 If it is a number N, then Gnus will only keep the last N articles
1194 read. If it is neither nil nor a number, Gnus will keep all read 1425 read. If it is neither nil nor a number, Gnus will keep all read
1195 articles. This is not a good idea." 1426 articles. This is not a good idea."
1196 :group 'gnus-meta 1427 :group 'gnus-meta
1212 (defcustom gnus-use-scoring t 1443 (defcustom gnus-use-scoring t
1213 "*If non-nil, enable scoring." 1444 "*If non-nil, enable scoring."
1214 :group 'gnus-meta 1445 :group 'gnus-meta
1215 :type 'boolean) 1446 :type 'boolean)
1216 1447
1217 (defcustom gnus-use-picons nil
1218 "*If non-nil, display picons in a frame of their own."
1219 :group 'gnus-meta
1220 :type 'boolean)
1221
1222 (defcustom gnus-summary-prepare-exit-hook 1448 (defcustom gnus-summary-prepare-exit-hook
1223 '(gnus-summary-expire-articles) 1449 '(gnus-summary-expire-articles)
1224 "*A hook called when preparing to exit from the summary buffer. 1450 "*A hook called when preparing to exit from the summary buffer.
1225 It calls `gnus-summary-expire-articles' by default." 1451 It calls `gnus-summary-expire-articles' by default."
1226 :group 'gnus-summary-exit 1452 :group 'gnus-summary-exit
1227 :type 'hook) 1453 :type 'hook)
1228 1454
1229 (defcustom gnus-novice-user t 1455 (defcustom gnus-novice-user t
1230 "*Non-nil means that you are a usenet novice. 1456 "*Non-nil means that you are a Usenet novice.
1231 If non-nil, verbose messages may be displayed and confirmations may be 1457 If non-nil, verbose messages may be displayed and confirmations may be
1232 required." 1458 required."
1233 :group 'gnus-meta 1459 :group 'gnus-meta
1234 :type 'boolean) 1460 :type 'boolean)
1235 1461
1265 "*If non-nil, display clickable icons." 1491 "*If non-nil, display clickable icons."
1266 :group 'gnus-meta 1492 :group 'gnus-meta
1267 :type 'boolean) 1493 :type 'boolean)
1268 1494
1269 (defcustom gnus-shell-command-separator ";" 1495 (defcustom gnus-shell-command-separator ";"
1270 "String used to separate to shell commands." 1496 "String used to separate shell commands."
1271 :group 'gnus-files 1497 :group 'gnus-files
1272 :type 'string) 1498 :type 'string)
1273 1499
1274 (defcustom gnus-valid-select-methods 1500 (defcustom gnus-valid-select-methods
1275 '(("nntp" post address prompt-address physical-address) 1501 '(("nntp" post address prompt-address physical-address)
1276 ("nnspool" post address) 1502 ("nnspool" post address)
1277 ("nnvirtual" post-mail virtual prompt-address) 1503 ("nnvirtual" post-mail virtual prompt-address)
1278 ("nnmbox" mail respool address) 1504 ("nnmbox" mail respool address)
1279 ("nnml" mail respool address) 1505 ("nnml" post-mail respool address)
1280 ("nnmh" mail respool address) 1506 ("nnmh" mail respool address)
1281 ("nndir" post-mail prompt-address physical-address) 1507 ("nndir" post-mail prompt-address physical-address)
1282 ("nneething" none address prompt-address physical-address) 1508 ("nneething" none address prompt-address physical-address)
1283 ("nndoc" none address prompt-address) 1509 ("nndoc" none address prompt-address)
1284 ("nnbabyl" mail address respool) 1510 ("nnbabyl" mail address respool)
1286 ("nnsoup" post-mail address) 1512 ("nnsoup" post-mail address)
1287 ("nndraft" post-mail) 1513 ("nndraft" post-mail)
1288 ("nnfolder" mail respool address) 1514 ("nnfolder" mail respool address)
1289 ("nngateway" post-mail address prompt-address physical-address) 1515 ("nngateway" post-mail address prompt-address physical-address)
1290 ("nnweb" none) 1516 ("nnweb" none)
1517 ("nngoogle" post)
1291 ("nnslashdot" post) 1518 ("nnslashdot" post)
1292 ("nnultimate" none) 1519 ("nnultimate" none)
1520 ("nnrss" none)
1521 ("nnwfm" none)
1293 ("nnwarchive" none) 1522 ("nnwarchive" none)
1294 ("nnlistserv" none) 1523 ("nnlistserv" none)
1295 ("nnagent" post-mail) 1524 ("nnagent" post-mail)
1296 ("nnimap" post-mail address prompt-address physical-address)) 1525 ("nnimap" post-mail address prompt-address physical-address)
1526 ("nnmaildir" mail respool address)
1527 ("nnnil" none))
1297 "*An alist of valid select methods. 1528 "*An alist of valid select methods.
1298 The first element of each list lists should be a string with the name 1529 The first element of each list lists should be a string with the name
1299 of the select method. The other elements may be the category of 1530 of the select method. The other elements may be the category of
1300 this method (i. e., `post', `mail', `none' or whatever) or other 1531 this method (i. e., `post', `mail', `none' or whatever) or other
1301 properties that this method has (like being respoolable). 1532 properties that this method has (like being respoolable).
1330 (string :tag "Address") 1561 (string :tag "Address")
1331 (repeat :tag "Options" 1562 (repeat :tag "Options"
1332 :inline t 1563 :inline t
1333 (list :format "%v" 1564 (list :format "%v"
1334 variable 1565 variable
1335 (sexp :tag "Value")))) 1566 (sexp :tag "Value"))))))
1336 ))
1337 1567
1338 (gnus-redefine-select-method-widget) 1568 (gnus-redefine-select-method-widget)
1339 1569
1340 (defcustom gnus-updated-mode-lines '(group article summary tree) 1570 (defcustom gnus-updated-mode-lines '(group article summary tree)
1341 "List of buffers that should update their mode lines. 1571 "List of buffers that should update their mode lines.
1351 1581
1352 ;; Added by Keinonen Kari <kk85613@cs.tut.fi>. 1582 ;; Added by Keinonen Kari <kk85613@cs.tut.fi>.
1353 (defcustom gnus-mode-non-string-length nil 1583 (defcustom gnus-mode-non-string-length nil
1354 "*Max length of mode-line non-string contents. 1584 "*Max length of mode-line non-string contents.
1355 If this is nil, Gnus will take space as is needed, leaving the rest 1585 If this is nil, Gnus will take space as is needed, leaving the rest
1356 of the modeline intact. Note that the default of nil is unlikely 1586 of the mode line intact. Note that the default of nil is unlikely
1357 to be desirable; see the manual for further details." 1587 to be desirable; see the manual for further details."
1358 :group 'gnus-various 1588 :group 'gnus-various
1359 :type '(choice (const nil) 1589 :type '(choice (const nil)
1360 integer)) 1590 integer))
1361 1591
1362 (defcustom gnus-auto-expirable-newsgroups nil 1592 ;; There should be special validation for this.
1363 "*Groups in which to automatically mark read articles as expirable. 1593 (define-widget 'gnus-email-address 'string
1594 "An email address.")
1595
1596 (gnus-define-group-parameter
1597 to-address
1598 :function-document
1599 "Return GROUP's to-address."
1600 :variable-document
1601 "*Alist of group regexps and correspondent to-addresses."
1602 :parameter-type '(gnus-email-address :tag "To Address")
1603 :parameter-document "\
1604 This will be used when doing followups and posts.
1605
1606 This is primarily useful in mail groups that represent closed
1607 mailing lists--mailing lists where it's expected that everybody that
1608 writes to the mailing list is subscribed to it. Since using this
1609 parameter ensures that the mail only goes to the mailing list itself,
1610 it means that members won't receive two copies of your followups.
1611
1612 Using `to-address' will actually work whether the group is foreign or
1613 not. Let's say there's a group on the server that is called
1614 `fa.4ad-l'. This is a real newsgroup, but the server has gotten the
1615 articles from a mail-to-news gateway. Posting directly to this group
1616 is therefore impossible--you have to send mail to the mailing list
1617 address instead.
1618
1619 The gnus-group-split mail splitting mechanism will behave as if this
1620 address was listed in gnus-group-split Addresses (see below).")
1621
1622 (gnus-define-group-parameter
1623 to-list
1624 :function-document
1625 "Return GROUP's to-list."
1626 :variable-document
1627 "*Alist of group regexps and correspondent to-lists."
1628 :parameter-type '(gnus-email-address :tag "To List")
1629 :parameter-document "\
1630 This address will be used when doing a `a' in the group.
1631
1632 It is totally ignored when doing a followup--except that if it is
1633 present in a news group, you'll get mail group semantics when doing
1634 `f'.
1635
1636 The gnus-group-split mail splitting mechanism will behave as if this
1637 address was listed in gnus-group-split Addresses (see below).")
1638
1639 (gnus-define-group-parameter
1640 subscribed
1641 :type bool
1642 :function-document
1643 "Return GROUP's subscription status."
1644 :variable-document
1645 "*Groups which are automatically considered subscribed."
1646 :parameter-type '(const :tag "Subscribed" t)
1647 :parameter-document "\
1648 Gnus assumed that you are subscribed to the To/List address.
1649
1650 When constructing a list of subscribed groups using
1651 `gnus-find-subscribed-addresses', Gnus includes the To address given
1652 above, or the list address (if the To address has not been set).")
1653
1654 (gnus-define-group-parameter
1655 auto-expire
1656 :type bool
1657 :function gnus-group-auto-expirable-p
1658 :function-document
1659 "Check whether GROUP is auto-expirable or not."
1660 :variable gnus-auto-expirable-newsgroups
1661 :variable-default nil
1662 :variable-document
1663 "*Groups in which to automatically mark read articles as expirable.
1364 If non-nil, this should be a regexp that should match all groups in 1664 If non-nil, this should be a regexp that should match all groups in
1365 which to perform auto-expiry. This only makes sense for mail groups." 1665 which to perform auto-expiry. This only makes sense for mail groups."
1366 :group 'nnmail-expire 1666 :variable-group nnmail-expire
1367 :type '(choice (const nil) 1667 :variable-type '(choice (const nil)
1368 regexp)) 1668 regexp)
1369 1669 :parameter-type '(const :tag "Automatic Expire" t)
1370 (defcustom gnus-total-expirable-newsgroups nil 1670 :parameter-document
1371 "*Groups in which to perform expiry of all read articles. 1671 "All articles that are read will be marked as expirable.")
1672
1673 (gnus-define-group-parameter
1674 total-expire
1675 :type bool
1676 :function gnus-group-total-expirable-p
1677 :function-document
1678 "Check whether GROUP is total-expirable or not."
1679 :variable gnus-total-expirable-newsgroups
1680 :variable-default nil
1681 :variable-document
1682 "*Groups in which to perform expiry of all read articles.
1372 Use with extreme caution. All groups that match this regexp will be 1683 Use with extreme caution. All groups that match this regexp will be
1373 expiring - which means that all read articles will be deleted after 1684 expiring - which means that all read articles will be deleted after
1374 \(say) one week. (This only goes for mail groups and the like, of 1685 \(say) one week. (This only goes for mail groups and the like, of
1375 course.)" 1686 course.)"
1376 :group 'nnmail-expire 1687 :variable-group nnmail-expire
1377 :type '(choice (const nil) 1688 :variable-type '(choice (const nil)
1378 regexp)) 1689 regexp)
1690 :parameter-type '(const :tag "Total Expire" t)
1691 :parameter-document
1692 "All read articles will be put through the expiry process
1693
1694 This happens even if they are not marked as expirable.
1695 Use with caution.")
1696
1697 (gnus-define-group-parameter
1698 charset
1699 :function-document
1700 "Return the default charset of GROUP."
1701 :variable gnus-group-charset-alist
1702 :variable-default
1703 '(("\\(^\\|:\\)hk\\>\\|\\(^\\|:\\)tw\\>\\|\\<big5\\>" cn-big5)
1704 ("\\(^\\|:\\)cn\\>\\|\\<chinese\\>" cn-gb-2312)
1705 ("\\(^\\|:\\)fj\\>\\|\\(^\\|:\\)japan\\>" iso-2022-jp-2)
1706 ("\\(^\\|:\\)tnn\\>\\|\\(^\\|:\\)pin\\>\\|\\(^\\|:\\)sci.lang.japan" iso-2022-7bit)
1707 ("\\(^\\|:\\)relcom\\>" koi8-r)
1708 ("\\(^\\|:\\)fido7\\>" koi8-r)
1709 ("\\(^\\|:\\)\\(cz\\|hun\\|pl\\|sk\\|hr\\)\\>" iso-8859-2)
1710 ("\\(^\\|:\\)israel\\>" iso-8859-1)
1711 ("\\(^\\|:\\)han\\>" euc-kr)
1712 ("\\(^\\|:\\)alt.chinese.text.big5\\>" chinese-big5)
1713 ("\\(^\\|:\\)soc.culture.vietnamese\\>" vietnamese-viqr)
1714 ("\\(^\\|:\\)\\(comp\\|rec\\|alt\\|sci\\|soc\\|news\\|gnu\\|bofh\\)\\>" iso-8859-1))
1715 :variable-document
1716 "Alist of regexps (to match group names) and default charsets to be used when reading."
1717 :variable-group gnus-charset
1718 :variable-type '(repeat (list (regexp :tag "Group")
1719 (symbol :tag "Charset")))
1720 :parameter-type '(symbol :tag "Charset")
1721 :parameter-document "\
1722 The default charset to use in the group.")
1723
1724 (gnus-define-group-parameter
1725 post-method
1726 :type list
1727 :function-document
1728 "Return a posting method for GROUP."
1729 :variable gnus-post-method-alist
1730 :variable-document
1731 "Alist of regexps (to match group names) and method to be used when
1732 posting an article."
1733 :variable-group gnus-group-foreign
1734 :parameter-type
1735 '(choice :tag "Posting Method"
1736 (const :tag "Use native server" native)
1737 (const :tag "Use current server" current)
1738 (list :convert-widget
1739 (lambda (widget)
1740 (list 'sexp :tag "Methods"
1741 :value gnus-select-method))))
1742 :parameter-document
1743 "Posting method for this group.")
1744
1745 (gnus-define-group-parameter
1746 large-newsgroup-initial
1747 :type integer
1748 :function-document
1749 "Return GROUP's initial input of the number of articles."
1750 :variable-document
1751 "*Alist of group regexps and its initial input of the number of articles."
1752 :parameter-type '(choice :tag "Initial Input for Large Newsgroup"
1753 (const :tag "All" nil)
1754 (integer))
1755 :parameter-document "\
1756
1757 This number will be prompted as the initial value of the number of
1758 articles to list when the group is a large newsgroup (see
1759 `gnus-large-newsgroup'). If it is nil, the default value is the
1760 total number of articles in the group.")
1761
1762 ;; The Gnus registry's ignored groups
1763 (gnus-define-group-parameter
1764 registry-ignore
1765 :type list
1766 :function-document
1767 "Whether this group should be ignored by the registry."
1768 :variable gnus-registry-ignored-groups
1769 :variable-default nil
1770 :variable-document
1771 "*Groups in which the registry should be turned off."
1772 :variable-group gnus-registry
1773 :variable-type '(repeat
1774 (list
1775 (regexp :tag "Group Name Regular Expression")
1776 (boolean :tag "Ignored")))
1777
1778 :parameter-type '(boolean :tag "Group Ignored by the Registry")
1779 :parameter-document
1780 "Whether the Gnus Registry should ignore this group.")
1781
1782 ;; group parameters for spam processing added by Ted Zlatanov <tzz@lifelogs.com>
1783 (defcustom gnus-install-group-spam-parameters t
1784 "*Disable the group parameters for spam detection.
1785 Enable if `G c' in XEmacs is giving you trouble, and make sure to submit a bug report."
1786 :type 'boolean
1787 :group 'gnus-start)
1788
1789 (when gnus-install-group-spam-parameters
1790 (defvar gnus-group-spam-classification-spam t
1791 "Spam group classification (requires spam.el).
1792 This group contains spam messages. On summary entry, unread messages
1793 will be marked as spam. On summary exit, the specified spam
1794 processors will be invoked on spam-marked messages, then those
1795 messages will be expired, so the spam processor will only see a
1796 spam-marked message once.")
1797
1798 (defvar gnus-group-spam-classification-ham 'ask
1799 "The ham value for the spam group parameter (requires spam.el).
1800 On summary exit, the specified ham processors will be invoked on
1801 ham-marked messages. Exercise caution, since the ham processor will
1802 see the same message more than once because there is no ham message
1803 registry.")
1804
1805 (gnus-define-group-parameter
1806 spam-contents
1807 :type list
1808 :function-document
1809 "The spam type (spam, ham, or neither) of the group."
1810 :variable gnus-spam-newsgroup-contents
1811 :variable-default nil
1812 :variable-document
1813 "*Groups in which to automatically mark new articles as spam on
1814 summary entry. If non-nil, this should be a list of group name
1815 regexps that should match all groups in which to do automatic spam
1816 tagging, associated with a classification (spam, ham, or neither).
1817 This only makes sense for mail groups."
1818 :variable-group spam
1819 :variable-type '(repeat
1820 (list :tag "Group contents spam/ham classification"
1821 (regexp :tag "Group")
1822 (choice
1823 (variable-item gnus-group-spam-classification-spam)
1824 (variable-item gnus-group-spam-classification-ham)
1825 (const :tag "Unclassified" nil))))
1826
1827 :parameter-type '(list :tag "Group contents spam/ham classification"
1828 (choice :tag "Group contents classification for spam sorting"
1829 (variable-item gnus-group-spam-classification-spam)
1830 (variable-item gnus-group-spam-classification-ham)
1831 (const :tag "Unclassified" nil)))
1832 :parameter-document
1833 "The spam classification (spam, ham, or neither) of this group.
1834 When a spam group is entered, all unread articles are marked as spam.")
1835
1836 (defvar gnus-group-spam-exit-processor-ifile "ifile"
1837 "OBSOLETE: The ifile summary exit spam processor.")
1838
1839 (defvar gnus-group-spam-exit-processor-stat "stat"
1840 "OBSOLETE: The spam-stat summary exit spam processor.")
1841
1842 (defvar gnus-group-spam-exit-processor-bogofilter "bogofilter"
1843 "OBSOLETE: The Bogofilter summary exit spam processor.")
1844
1845 (defvar gnus-group-spam-exit-processor-blacklist "blacklist"
1846 "OBSOLETE: The Blacklist summary exit spam processor.")
1847
1848 (defvar gnus-group-spam-exit-processor-report-gmane "report-gmane"
1849 "OBSOLETE: The Gmane reporting summary exit spam processor.
1850 Only applicable to NNTP groups with articles from Gmane. See spam-report.el")
1851
1852 (defvar gnus-group-spam-exit-processor-spamoracle "spamoracle-spam"
1853 "OBSOLETE: The spamoracle summary exit spam processor.")
1854
1855 (defvar gnus-group-ham-exit-processor-ifile "ifile-ham"
1856 "OBSOLETE: The ifile summary exit ham processor.
1857 Only applicable to non-spam (unclassified and ham) groups.")
1858
1859 (defvar gnus-group-ham-exit-processor-bogofilter "bogofilter-ham"
1860 "OBSOLETE: The Bogofilter summary exit ham processor.
1861 Only applicable to non-spam (unclassified and ham) groups.")
1862
1863 (defvar gnus-group-ham-exit-processor-stat "stat-ham"
1864 "OBSOLETE: The spam-stat summary exit ham processor.
1865 Only applicable to non-spam (unclassified and ham) groups.")
1866
1867 (defvar gnus-group-ham-exit-processor-whitelist "whitelist"
1868 "OBSOLETE: The whitelist summary exit ham processor.
1869 Only applicable to non-spam (unclassified and ham) groups.")
1870
1871 (defvar gnus-group-ham-exit-processor-BBDB "bbdb"
1872 "OBSOLETE: The BBDB summary exit ham processor.
1873 Only applicable to non-spam (unclassified and ham) groups.")
1874
1875 (defvar gnus-group-ham-exit-processor-copy "copy"
1876 "OBSOLETE: The ham copy exit ham processor.
1877 Only applicable to non-spam (unclassified and ham) groups.")
1878
1879 (defvar gnus-group-ham-exit-processor-spamoracle "spamoracle-ham"
1880 "OBSOLETE: The spamoracle summary exit ham processor.
1881 Only applicable to non-spam (unclassified and ham) groups.")
1882
1883 (gnus-define-group-parameter
1884 spam-process
1885 :type list
1886 :parameter-type
1887 '(choice
1888 :tag "Spam Summary Exit Processor"
1889 :value nil
1890 (list :tag "Spam Summary Exit Processor Choices"
1891 (set
1892 (variable-item gnus-group-spam-exit-processor-ifile)
1893 (variable-item gnus-group-spam-exit-processor-stat)
1894 (variable-item gnus-group-spam-exit-processor-bogofilter)
1895 (variable-item gnus-group-spam-exit-processor-blacklist)
1896 (variable-item gnus-group-spam-exit-processor-spamoracle)
1897 (variable-item gnus-group-spam-exit-processor-report-gmane)
1898 (variable-item gnus-group-ham-exit-processor-bogofilter)
1899 (variable-item gnus-group-ham-exit-processor-ifile)
1900 (variable-item gnus-group-ham-exit-processor-stat)
1901 (variable-item gnus-group-ham-exit-processor-whitelist)
1902 (variable-item gnus-group-ham-exit-processor-BBDB)
1903 (variable-item gnus-group-ham-exit-processor-spamoracle)
1904 (variable-item gnus-group-ham-exit-processor-copy)
1905 (const :tag "Spam: Gmane Report" (spam spam-use-gmane))
1906 (const :tag "Spam: Bogofilter" (spam spam-use-bogofilter))
1907 (const :tag "Spam: Blacklist" (spam spam-use-blacklist))
1908 (const :tag "Spam: ifile" (spam spam-use-ifile))
1909 (const :tag "Spam: Spam-stat" (spam spam-use-stat))
1910 (const :tag "Spam: Spam Oracle" (spam spam-use-spamoracle))
1911 (const :tag "Ham: ifile" (ham spam-use-ifile))
1912 (const :tag "Ham: Bogofilter" (ham spam-use-bogofilter))
1913 (const :tag "Ham: Spam-stat" (ham spam-use-stat))
1914 (const :tag "Ham: Whitelist" (ham spam-use-whitelist))
1915 (const :tag "Ham: BBDB" (ham spam-use-BBDB))
1916 (const :tag "Ham: Copy" (ham spam-use-ham-copy))
1917 (const :tag "Ham: Spam Oracle" (ham spam-use-spamoracle)))))
1918 :function-document
1919 "Which spam or ham processors will be applied when the summary is exited."
1920 :variable gnus-spam-process-newsgroups
1921 :variable-default nil
1922 :variable-document
1923 "*Groups in which to automatically process spam or ham articles with
1924 a backend on summary exit. If non-nil, this should be a list of group
1925 name regexps that should match all groups in which to do automatic
1926 spam processing, associated with the appropriate processor."
1927 :variable-group spam
1928 :variable-type
1929 '(repeat :tag "Spam/Ham Processors"
1930 (list :tag "Spam Summary Exit Processor Choices"
1931 (regexp :tag "Group Regexp")
1932 (set
1933 :tag "Spam/Ham Summary Exit Processor"
1934 (variable-item gnus-group-spam-exit-processor-ifile)
1935 (variable-item gnus-group-spam-exit-processor-stat)
1936 (variable-item gnus-group-spam-exit-processor-bogofilter)
1937 (variable-item gnus-group-spam-exit-processor-blacklist)
1938 (variable-item gnus-group-spam-exit-processor-spamoracle)
1939 (variable-item gnus-group-spam-exit-processor-report-gmane)
1940 (variable-item gnus-group-ham-exit-processor-bogofilter)
1941 (variable-item gnus-group-ham-exit-processor-ifile)
1942 (variable-item gnus-group-ham-exit-processor-stat)
1943 (variable-item gnus-group-ham-exit-processor-whitelist)
1944 (variable-item gnus-group-ham-exit-processor-BBDB)
1945 (variable-item gnus-group-ham-exit-processor-spamoracle)
1946 (variable-item gnus-group-ham-exit-processor-copy)
1947 (const :tag "Spam: Gmane Report" (spam spam-use-gmane))
1948 (const :tag "Spam: Bogofilter" (spam spam-use-bogofilter))
1949 (const :tag "Spam: Blacklist" (spam spam-use-blacklist))
1950 (const :tag "Spam: ifile" (spam spam-use-ifile))
1951 (const :tag "Spam: Spam-stat" (spam spam-use-stat))
1952 (const :tag "Spam: Spam Oracle" (spam spam-use-spamoracle))
1953 (const :tag "Ham: ifile" (ham spam-use-ifile))
1954 (const :tag "Ham: Bogofilter" (ham spam-use-bogofilter))
1955 (const :tag "Ham: Spam-stat" (ham spam-use-stat))
1956 (const :tag "Ham: Whitelist" (ham spam-use-whitelist))
1957 (const :tag "Ham: BBDB" (ham spam-use-BBDB))
1958 (const :tag "Ham: Copy" (ham spam-use-ham-copy))
1959 (const :tag "Ham: Spam Oracle" (ham spam-use-spamoracle)))))
1960
1961 :parameter-document
1962 "Which spam or ham processors will be applied when the summary is exited.")
1963
1964 (gnus-define-group-parameter
1965 spam-autodetect
1966 :type list
1967 :parameter-type
1968 '(boolean :tag "Spam autodetection")
1969 :function-document
1970 "Should spam be autodetected (with spam-split) in this group?"
1971 :variable gnus-spam-autodetect
1972 :variable-default nil
1973 :variable-document
1974 "*Groups in which spam should be autodetected when they are entered.
1975 Only unseen articles will be examined, unless
1976 spam-autodetect-recheck-messages is set."
1977 :variable-group spam
1978 :variable-type
1979 '(repeat
1980 :tag "Autodetection setting"
1981 (list
1982 (regexp :tag "Group Regexp")
1983 boolean))
1984 :parameter-document
1985 "Spam autodetection.
1986 Only unseen articles will be examined, unless
1987 spam-autodetect-recheck-messages is set.")
1988
1989 (gnus-define-group-parameter
1990 spam-autodetect-methods
1991 :type list
1992 :parameter-type
1993 '(choice :tag "Spam autodetection-specific methods"
1994 (const none)
1995 (const default)
1996 (set :tag "Use specific methods"
1997 (variable-item spam-use-blacklist)
1998 (variable-item spam-use-regex-headers)
1999 (variable-item spam-use-regex-body)
2000 (variable-item spam-use-whitelist)
2001 (variable-item spam-use-BBDB)
2002 (variable-item spam-use-ifile)
2003 (variable-item spam-use-spamoracle)
2004 (variable-item spam-use-stat)
2005 (variable-item spam-use-blackholes)
2006 (variable-item spam-use-hashcash)
2007 (variable-item spam-use-bogofilter-headers)
2008 (variable-item spam-use-bogofilter)))
2009 :function-document
2010 "Methods to be used for autodetection in each group"
2011 :variable gnus-spam-autodetect-methods
2012 :variable-default nil
2013 :variable-document
2014 "*Methods for autodetecting spam per group.
2015 Requires the spam-autodetect parameter. Only unseen articles
2016 will be examined, unless spam-autodetect-recheck-messages is
2017 set."
2018 :variable-group spam
2019 :variable-type
2020 '(repeat
2021 :tag "Autodetection methods"
2022 (list
2023 (regexp :tag "Group Regexp")
2024 (choice
2025 (const none)
2026 (const default)
2027 (set :tag "Use specific methods"
2028 (variable-item spam-use-blacklist)
2029 (variable-item spam-use-regex-headers)
2030 (variable-item spam-use-regex-body)
2031 (variable-item spam-use-whitelist)
2032 (variable-item spam-use-BBDB)
2033 (variable-item spam-use-ifile)
2034 (variable-item spam-use-spamoracle)
2035 (variable-item spam-use-stat)
2036 (variable-item spam-use-blackholes)
2037 (variable-item spam-use-hashcash)
2038 (variable-item spam-use-bogofilter-headers)
2039 (variable-item spam-use-bogofilter)))))
2040 :parameter-document
2041 "Spam autodetection methods.
2042 Requires the spam-autodetect parameter. Only unseen articles
2043 will be examined, unless spam-autodetect-recheck-messages is
2044 set.")
2045
2046 (gnus-define-group-parameter
2047 spam-process-destination
2048 :type list
2049 :parameter-type
2050 '(choice :tag "Destination for spam-processed articles at summary exit"
2051 (string :tag "Move to a group")
2052 (repeat :tag "Move to multiple groups"
2053 (string :tag "Destination group"))
2054 (const :tag "Expire" nil))
2055 :function-document
2056 "Where spam-processed articles will go at summary exit."
2057 :variable gnus-spam-process-destinations
2058 :variable-default nil
2059 :variable-document
2060 "*Groups in which to explicitly send spam-processed articles to
2061 another group, or expire them (the default). If non-nil, this should
2062 be a list of group name regexps that should match all groups in which
2063 to do spam-processed article moving, associated with the destination
2064 group or nil for explicit expiration. This only makes sense for
2065 mail groups."
2066 :variable-group spam
2067 :variable-type
2068 '(repeat
2069 :tag "Spam-processed articles destination"
2070 (list
2071 (regexp :tag "Group Regexp")
2072 (choice
2073 :tag "Destination for spam-processed articles at summary exit"
2074 (string :tag "Move to a group")
2075 (repeat :tag "Move to multiple groups"
2076 (string :tag "Destination group"))
2077 (const :tag "Expire" nil))))
2078 :parameter-document
2079 "Where spam-processed articles will go at summary exit.")
2080
2081 (gnus-define-group-parameter
2082 ham-process-destination
2083 :type list
2084 :parameter-type
2085 '(choice
2086 :tag "Destination for ham articles at summary exit from a spam group"
2087 (string :tag "Move to a group")
2088 (repeat :tag "Move to multiple groups"
2089 (string :tag "Destination group"))
2090 (const :tag "Respool" respool)
2091 (const :tag "Do nothing" nil))
2092 :function-document
2093 "Where ham articles will go at summary exit from a spam group."
2094 :variable gnus-ham-process-destinations
2095 :variable-default nil
2096 :variable-document
2097 "*Groups in which to explicitly send ham articles to
2098 another group, or do nothing (the default). If non-nil, this should
2099 be a list of group name regexps that should match all groups in which
2100 to do ham article moving, associated with the destination
2101 group or nil for explicit ignoring. This only makes sense for
2102 mail groups, and only works in spam groups."
2103 :variable-group spam
2104 :variable-type
2105 '(repeat
2106 :tag "Ham articles destination"
2107 (list
2108 (regexp :tag "Group Regexp")
2109 (choice
2110 :tag "Destination for ham articles at summary exit from spam group"
2111 (string :tag "Move to a group")
2112 (repeat :tag "Move to multiple groups"
2113 (string :tag "Destination group"))
2114 (const :tag "Respool" respool)
2115 (const :tag "Expire" nil))))
2116 :parameter-document
2117 "Where ham articles will go at summary exit from a spam group.")
2118
2119 (gnus-define-group-parameter
2120 ham-marks
2121 :type 'list
2122 :parameter-type '(list :tag "Ham mark choices"
2123 (set
2124 (variable-item gnus-del-mark)
2125 (variable-item gnus-read-mark)
2126 (variable-item gnus-ticked-mark)
2127 (variable-item gnus-killed-mark)
2128 (variable-item gnus-kill-file-mark)
2129 (variable-item gnus-low-score-mark)))
2130
2131 :parameter-document
2132 "Marks considered ham (positively not spam). Such articles will be
2133 processed as ham (non-spam) on group exit. When nil, the global
2134 spam-ham-marks variable takes precedence."
2135 :variable-default '((".*" ((gnus-del-mark
2136 gnus-read-mark
2137 gnus-killed-mark
2138 gnus-kill-file-mark
2139 gnus-low-score-mark))))
2140 :variable-group spam
2141 :variable-document
2142 "*Groups in which to explicitly set the ham marks to some value.")
2143
2144 (gnus-define-group-parameter
2145 spam-marks
2146 :type 'list
2147 :parameter-type '(list :tag "Spam mark choices"
2148 (set
2149 (variable-item gnus-spam-mark)
2150 (variable-item gnus-killed-mark)
2151 (variable-item gnus-kill-file-mark)
2152 (variable-item gnus-low-score-mark)))
2153
2154 :parameter-document
2155 "Marks considered spam.
2156 Such articles will be processed as spam on group exit. When nil, the global
2157 spam-spam-marks variable takes precedence."
2158 :variable-default '((".*" ((gnus-spam-mark))))
2159 :variable-group spam
2160 :variable-document
2161 "*Groups in which to explicitly set the spam marks to some value."))
1379 2162
1380 (defcustom gnus-group-uncollapsed-levels 1 2163 (defcustom gnus-group-uncollapsed-levels 1
1381 "Number of group name elements to leave alone when making a short group name." 2164 "Number of group name elements to leave alone when making a short group name."
1382 :group 'gnus-group-visual 2165 :group 'gnus-group-visual
1383 :type 'integer) 2166 :type 'integer)
1464 (const tree-menu) 2247 (const tree-menu)
1465 (const binary-menu) 2248 (const binary-menu)
1466 (const pick-menu) 2249 (const pick-menu)
1467 (const grouplens-menu))) 2250 (const grouplens-menu)))
1468 2251
2252 ;; Byte-compiler warning.
2253 (defvar gnus-visual)
2254 ;; Find out whether the gnus-visual TYPE is wanted.
2255 (defun gnus-visual-p (&optional type class)
2256 (and gnus-visual ; Has to be non-nil, at least.
2257 (if (not type) ; We don't care about type.
2258 gnus-visual
2259 (if (listp gnus-visual) ; It's a list, so we check it.
2260 (or (memq type gnus-visual)
2261 (memq class gnus-visual))
2262 t))))
2263
1469 (defcustom gnus-mouse-face 2264 (defcustom gnus-mouse-face
1470 (condition-case () 2265 (condition-case ()
1471 (if (gnus-visual-p 'mouse-face 'highlight) 2266 (if (gnus-visual-p 'mouse-face 'highlight)
1472 (if (boundp 'gnus-mouse-face) 2267 (if (boundp 'gnus-mouse-face)
1473 (or gnus-mouse-face 'highlight) 2268 (or gnus-mouse-face 'highlight)
1486 :type 'directory) 2281 :type 'directory)
1487 2282
1488 (defvar gnus-plugged t 2283 (defvar gnus-plugged t
1489 "Whether Gnus is plugged or not.") 2284 "Whether Gnus is plugged or not.")
1490 2285
1491 (defcustom gnus-default-charset 'iso-8859-1 2286 (defcustom gnus-agent-cache t
2287 "Controls use of the agent cache while plugged.
2288 When set, Gnus will prefer using the locally stored content rather
2289 than re-fetching it from the server. You also need to enable
2290 `gnus-agent' for this to have any affect."
2291 :version "21.3"
2292 :group 'gnus-agent
2293 :type 'boolean)
2294
2295 (defcustom gnus-default-charset 'undecided
1492 "Default charset assumed to be used when viewing non-ASCII characters. 2296 "Default charset assumed to be used when viewing non-ASCII characters.
1493 This variable is overridden on a group-to-group basis by the 2297 This variable is overridden on a group-to-group basis by the
1494 gnus-group-charset-alist variable and is only used on groups not 2298 `gnus-group-charset-alist' variable and is only used on groups not
1495 covered by that variable." 2299 covered by that variable."
1496 :type 'symbol 2300 :type 'symbol
1497 :group 'gnus-charset) 2301 :group 'gnus-charset)
1498 2302
1499 (defcustom gnus-default-posting-charset nil 2303 ;; Fixme: Doc reference to agent.
1500 "Default charset assumed to be used when posting non-ASCII characters. 2304 (defcustom gnus-agent t
1501 This variable is overridden on a group-to-group basis by the 2305 "Whether we want to use the Gnus agent or not.
1502 gnus-group-posting-charset-alist variable and is only used on groups not 2306
1503 covered by that variable. 2307 You may customize gnus-agent to disable its use. However, some
1504 If nil, no default charset is assumed when posting." 2308 back ends have started to use the agent as a client-side cache.
1505 :type 'symbol 2309 Disabling the agent may result in noticeable loss of performance."
1506 :group 'gnus-charset) 2310 :version "21.3"
2311 :group 'gnus-agent
2312 :type 'boolean)
2313
2314 (defcustom gnus-other-frame-function 'gnus
2315 "Function called by the command `gnus-other-frame'."
2316 :group 'gnus-start
2317 :type '(choice (function-item gnus)
2318 (function-item gnus-no-server)
2319 (function-item gnus-slave)
2320 (function-item gnus-slave-no-server)))
2321
2322 (defcustom gnus-other-frame-parameters nil
2323 "Frame parameters used by `gnus-other-frame' to create a Gnus frame.
2324 This should be an alist for Emacs, or a plist for XEmacs."
2325 :group 'gnus-start
2326 :type (if (featurep 'xemacs)
2327 '(repeat (list :inline t :format "%v"
2328 (symbol :tag "Property")
2329 (sexp :tag "Value")))
2330 '(repeat (cons :format "%v"
2331 (symbol :tag "Parameter")
2332 (sexp :tag "Value")))))
2333
2334 (defcustom gnus-user-agent 'emacs-gnus-type
2335 "Which information should be exposed in the User-Agent header.
2336
2337 It can be one of the symbols `gnus' \(show only Gnus version\), `emacs-gnus'
2338 \(show only Emacs and Gnus versions\), `emacs-gnus-config' \(same as
2339 `emacs-gnus' plus system configuration\), `emacs-gnus-type' \(same as
2340 `emacs-gnus' plus system type\) or a custom string. If you set it to a
2341 string, be sure to use a valid format, see RFC 2616."
2342 :group 'gnus-message
2343 :type '(choice
2344 (item :tag "Show Gnus and Emacs versions and system type"
2345 emacs-gnus-type)
2346 (item :tag "Show Gnus and Emacs versions and system configuration"
2347 emacs-gnus-config)
2348 (item :tag "Show Gnus and Emacs versions" emacs-gnus)
2349 (item :tag "Show only Gnus version" gnus)
2350 (string :tag "Other")))
1507 2351
1508 2352
1509 ;;; Internal variables 2353 ;;; Internal variables
1510 2354
1511 (defvar gnus-agent-gcc-header "X-Gnus-Agent-Gcc") 2355 (defvar gnus-agent-gcc-header "X-Gnus-Agent-Gcc")
1512 (defvar gnus-agent-meta-information-header "X-Gnus-Agent-Meta-Information") 2356 (defvar gnus-agent-meta-information-header "X-Gnus-Agent-Meta-Information")
2357 (defvar gnus-agent-method-p-cache nil
2358 ; Reset each time gnus-agent-covered-methods is changed else
2359 ; gnus-agent-method-p may mis-report a methods status.
2360 )
2361 (defvar gnus-agent-target-move-group-header "X-Gnus-Agent-Move-To")
2362 (defvar gnus-draft-meta-information-header "X-Draft-From")
1513 (defvar gnus-group-get-parameter-function 'gnus-group-get-parameter) 2363 (defvar gnus-group-get-parameter-function 'gnus-group-get-parameter)
1514 (defvar gnus-original-article-buffer " *Original Article*") 2364 (defvar gnus-original-article-buffer " *Original Article*")
1515 (defvar gnus-newsgroup-name nil) 2365 (defvar gnus-newsgroup-name nil)
1516 (defvar gnus-ephemeral-servers nil) 2366 (defvar gnus-ephemeral-servers nil)
1517 2367 (defvar gnus-server-method-cache nil)
1518 (defvar gnus-agent nil
1519 "Whether we want to use the Gnus agent or not.")
1520 2368
1521 (defvar gnus-agent-fetching nil 2369 (defvar gnus-agent-fetching nil
1522 "Whether Gnus agent is in fetching mode.") 2370 "Whether Gnus agent is in fetching mode.")
1523 2371
2372 (defvar gnus-agent-covered-methods nil
2373 "A list of servers, NOT methods, showing which servers are covered by the agent.")
2374
1524 (defvar gnus-command-method nil 2375 (defvar gnus-command-method nil
1525 "Dynamically bound variable that says what the current backend is.") 2376 "Dynamically bound variable that says what the current back end is.")
1526 2377
1527 (defvar gnus-current-select-method nil 2378 (defvar gnus-current-select-method nil
1528 "The current method for selecting a newsgroup.") 2379 "The current method for selecting a newsgroup.")
1529 2380
1530 (defvar gnus-tree-buffer "*Tree*" 2381 (defvar gnus-tree-buffer "*Tree*"
1558 (nnspool-nov-directory ,gnus-cache-directory) 2409 (nnspool-nov-directory ,gnus-cache-directory)
1559 (nnspool-active-file 2410 (nnspool-active-file
1560 ,(nnheader-concat gnus-cache-directory "active")))) 2411 ,(nnheader-concat gnus-cache-directory "active"))))
1561 "List of predefined (convenience) servers.") 2412 "List of predefined (convenience) servers.")
1562 2413
1563 (defvar gnus-topic-indentation "");; Obsolete variable. 2414 (defvar gnus-topic-indentation "") ;; Obsolete variable.
1564 2415
1565 (defconst gnus-article-mark-lists 2416 (defconst gnus-article-mark-lists
1566 '((marked . tick) (replied . reply) 2417 '((marked . tick) (replied . reply)
1567 (expirable . expire) (killed . killed) 2418 (expirable . expire) (killed . killed)
1568 (bookmarks . bookmark) (dormant . dormant) 2419 (bookmarks . bookmark) (dormant . dormant)
1569 (scored . score) (saved . save) 2420 (scored . score) (saved . save)
1570 (cached . cache) (downloadable . download) 2421 (cached . cache) (downloadable . download)
1571 (unsendable . unsend))) 2422 (unsendable . unsend) (forwarded . forward)
2423 (recent . recent) (seen . seen)))
2424
2425 (defconst gnus-article-special-mark-lists
2426 '((seen range)
2427 (killed range)
2428 (bookmark tuple)
2429 (score tuple)))
2430
2431 ;; Propagate flags to server, with the following exceptions:
2432 ;; `seen' is private to each gnus installation
2433 ;; `cache' is a internal gnus flag for each gnus installation
2434 ;; `download' is a agent flag private to each gnus installation
2435 ;; `unsend' are for nndraft groups only
2436 ;; `score' is not a proper mark
2437 ;; `bookmark': don't propagated it, or fix the bug in update-mark.
2438 (defconst gnus-article-unpropagated-mark-lists
2439 '(seen cache download unsend score bookmark)
2440 "Marks that shouldn't be propagated to back ends.
2441 Typical marks are those that make no sense in a standalone back end,
2442 such as a mark that says whether an article is stored in the cache
2443 \(which doesn't make sense in a standalone back end).")
1572 2444
1573 (defvar gnus-headers-retrieved-by nil) 2445 (defvar gnus-headers-retrieved-by nil)
1574 (defvar gnus-article-reply nil) 2446 (defvar gnus-article-reply nil)
1575 (defvar gnus-override-method nil) 2447 (defvar gnus-override-method nil)
1576 (defvar gnus-article-check-size nil) 2448 (defvar gnus-article-check-size nil)
1583 (defconst gnus-maintainer 2455 (defconst gnus-maintainer
1584 "bugs@gnus.org (The Gnus Bugfixing Girls + Boys)" 2456 "bugs@gnus.org (The Gnus Bugfixing Girls + Boys)"
1585 "The mail address of the Gnus maintainers.") 2457 "The mail address of the Gnus maintainers.")
1586 2458
1587 (defvar gnus-info-nodes 2459 (defvar gnus-info-nodes
1588 '((gnus-group-mode "(gnus)The Group Buffer") 2460 '((gnus-group-mode "(gnus)Group Buffer")
1589 (gnus-summary-mode "(gnus)The Summary Buffer") 2461 (gnus-summary-mode "(gnus)Summary Buffer")
1590 (gnus-article-mode "(gnus)The Article Buffer") 2462 (gnus-article-mode "(gnus)Article Buffer")
1591 (gnus-server-mode "(gnus)The Server Buffer") 2463 (gnus-server-mode "(gnus)Server Buffer")
1592 (gnus-browse-mode "(gnus)Browse Foreign Server") 2464 (gnus-browse-mode "(gnus)Browse Foreign Server")
1593 (gnus-tree-mode "(gnus)Tree Display")) 2465 (gnus-tree-mode "(gnus)Tree Display"))
1594 "Alist of major modes and related Info nodes.") 2466 "Alist of major modes and related Info nodes.")
1595 2467
1596 (defvar gnus-group-buffer "*Group*") 2468 (defvar gnus-group-buffer "*Group*")
1613 gnus-format-specs) 2485 gnus-format-specs)
1614 "Gnus variables saved in the quick startup file.") 2486 "Gnus variables saved in the quick startup file.")
1615 2487
1616 (defvar gnus-newsrc-alist nil 2488 (defvar gnus-newsrc-alist nil
1617 "Assoc list of read articles. 2489 "Assoc list of read articles.
1618 gnus-newsrc-hashtb should be kept so that both hold the same information.") 2490 `gnus-newsrc-hashtb' should be kept so that both hold the same information.")
2491
2492 (defvar gnus-registry-alist nil
2493 "Assoc list of registry data.
2494 gnus-registry.el will populate this if it's loaded.")
1619 2495
1620 (defvar gnus-newsrc-hashtb nil 2496 (defvar gnus-newsrc-hashtb nil
1621 "Hashtable of gnus-newsrc-alist.") 2497 "Hashtable of `gnus-newsrc-alist'.")
1622 2498
1623 (defvar gnus-killed-list nil 2499 (defvar gnus-killed-list nil
1624 "List of killed newsgroups.") 2500 "List of killed newsgroups.")
1625 2501
1626 (defvar gnus-killed-hashtb nil 2502 (defvar gnus-killed-hashtb nil
1627 "Hash table equivalent of gnus-killed-list.") 2503 "Hash table equivalent of `gnus-killed-list'.")
1628 2504
1629 (defvar gnus-zombie-list nil 2505 (defvar gnus-zombie-list nil
1630 "List of almost dead newsgroups.") 2506 "List of almost dead newsgroups.")
1631 2507
1632 (defvar gnus-description-hashtb nil 2508 (defvar gnus-description-hashtb nil
1651 2527
1652 (defvar gnus-dead-summary nil) 2528 (defvar gnus-dead-summary nil)
1653 2529
1654 (defvar gnus-invalid-group-regexp "[: `'\"/]\\|^$" 2530 (defvar gnus-invalid-group-regexp "[: `'\"/]\\|^$"
1655 "Regexp matching invalid groups.") 2531 "Regexp matching invalid groups.")
2532
2533 (defvar gnus-other-frame-object nil
2534 "A frame object which will be created by `gnus-other-frame'.")
1656 2535
1657 ;;; End of variables. 2536 ;;; End of variables.
1658 2537
1659 ;; Define some autoload functions Gnus might use. 2538 ;; Define some autoload functions Gnus might use.
1660 (eval-and-compile 2539 (eval-and-compile
1702 gnus-demon-add-rescan gnus-demon-add-scan-timestamps 2581 gnus-demon-add-rescan gnus-demon-add-scan-timestamps
1703 gnus-demon-add-disconnection gnus-demon-add-handler 2582 gnus-demon-add-disconnection gnus-demon-add-handler
1704 gnus-demon-remove-handler) 2583 gnus-demon-remove-handler)
1705 ("gnus-demon" :interactive t 2584 ("gnus-demon" :interactive t
1706 gnus-demon-init gnus-demon-cancel) 2585 gnus-demon-init gnus-demon-cancel)
2586 ("gnus-fun" gnus-convert-gray-x-face-to-xpm gnus-display-x-face-in-from
2587 gnus-convert-image-to-gray-x-face gnus-convert-face-to-png
2588 gnus-face-from-file)
1707 ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree 2589 ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree
1708 gnus-tree-open gnus-tree-close gnus-carpal-setup-buffer) 2590 gnus-tree-open gnus-tree-close gnus-carpal-setup-buffer)
1709 ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close 2591 ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close
1710 gnus-nocem-unwanted-article-p) 2592 gnus-nocem-unwanted-article-p)
1711 ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info 2593 ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info
1760 gnus-uu-mark-over gnus-uu-post-news) 2642 gnus-uu-mark-over gnus-uu-post-news)
1761 ("gnus-uu" gnus-uu-delete-work-dir gnus-uu-unmark-thread) 2643 ("gnus-uu" gnus-uu-delete-work-dir gnus-uu-unmark-thread)
1762 ("gnus-msg" (gnus-summary-send-map keymap) 2644 ("gnus-msg" (gnus-summary-send-map keymap)
1763 gnus-article-mail gnus-copy-article-buffer gnus-extended-version) 2645 gnus-article-mail gnus-copy-article-buffer gnus-extended-version)
1764 ("gnus-msg" :interactive t 2646 ("gnus-msg" :interactive t
1765 gnus-group-post-news gnus-group-mail gnus-summary-post-news 2647 gnus-group-post-news gnus-group-mail gnus-group-news
2648 gnus-summary-post-news gnus-summary-news-other-window
1766 gnus-summary-followup gnus-summary-followup-with-original 2649 gnus-summary-followup gnus-summary-followup-with-original
1767 gnus-summary-cancel-article gnus-summary-supersede-article 2650 gnus-summary-cancel-article gnus-summary-supersede-article
1768 gnus-post-news gnus-summary-reply gnus-summary-reply-with-original 2651 gnus-post-news gnus-summary-reply gnus-summary-reply-with-original
1769 gnus-summary-mail-forward gnus-summary-mail-other-window 2652 gnus-summary-mail-forward gnus-summary-mail-other-window
1770 gnus-summary-resend-message gnus-summary-resend-bounced-mail 2653 gnus-summary-resend-message gnus-summary-resend-bounced-mail
1771 gnus-summary-wide-reply gnus-summary-followup-to-mail 2654 gnus-summary-wide-reply gnus-summary-followup-to-mail
1772 gnus-summary-followup-to-mail-with-original gnus-bug 2655 gnus-summary-followup-to-mail-with-original gnus-bug
1773 gnus-summary-wide-reply-with-original 2656 gnus-summary-wide-reply-with-original
1774 gnus-summary-post-forward gnus-summary-wide-reply-with-original 2657 gnus-summary-post-forward gnus-summary-wide-reply-with-original
1775 gnus-summary-post-forward) 2658 gnus-summary-post-forward)
1776 ("gnus-picon" :interactive t gnus-article-display-picons 2659 ("gnus-picon" :interactive t gnus-treat-from-picon)
1777 gnus-group-display-picons gnus-picons-article-display-x-face
1778 gnus-picons-display-x-face)
1779 ("gnus-picon" gnus-picons-buffer-name)
1780 ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p 2660 ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p
1781 gnus-grouplens-mode) 2661 gnus-grouplens-mode)
1782 ("smiley" :interactive t gnus-smiley-display) 2662 ("smiley" :interactive t smiley-region)
1783 ("gnus-win" gnus-configure-windows gnus-add-configuration) 2663 ("gnus-win" gnus-configure-windows gnus-add-configuration)
1784 ("gnus-sum" gnus-summary-insert-line gnus-summary-read-group 2664 ("gnus-sum" gnus-summary-insert-line gnus-summary-read-group
1785 gnus-list-of-unread-articles gnus-list-of-read-articles 2665 gnus-list-of-unread-articles gnus-list-of-read-articles
1786 gnus-offer-save-summaries gnus-make-thread-indent-array 2666 gnus-offer-save-summaries gnus-make-thread-indent-array
1787 gnus-summary-exit gnus-update-read-articles gnus-summary-last-subject 2667 gnus-summary-exit gnus-update-read-articles gnus-summary-last-subject
1807 gnus-article-remove-cr gnus-article-remove-trailing-blank-lines 2687 gnus-article-remove-cr gnus-article-remove-trailing-blank-lines
1808 gnus-article-display-x-face gnus-article-de-quoted-unreadable 2688 gnus-article-display-x-face gnus-article-de-quoted-unreadable
1809 gnus-article-de-base64-unreadable 2689 gnus-article-de-base64-unreadable
1810 gnus-article-decode-HZ 2690 gnus-article-decode-HZ
1811 gnus-article-wash-html 2691 gnus-article-wash-html
1812 gnus-article-hide-pgp 2692 gnus-article-unsplit-urls
1813 gnus-article-hide-pem gnus-article-hide-signature 2693 gnus-article-hide-pem gnus-article-hide-signature
1814 gnus-article-strip-leading-blank-lines gnus-article-date-local 2694 gnus-article-strip-leading-blank-lines gnus-article-date-local
1815 gnus-article-date-original gnus-article-date-lapsed 2695 gnus-article-date-original gnus-article-date-lapsed
1816 gnus-article-show-all-headers 2696 ;; gnus-article-show-all-headers
1817 gnus-article-edit-mode gnus-article-edit-article 2697 gnus-article-edit-mode gnus-article-edit-article
1818 gnus-article-edit-done gnus-article-decode-encoded-words 2698 gnus-article-edit-done gnus-article-decode-encoded-words
1819 gnus-start-date-timer gnus-stop-date-timer 2699 gnus-start-date-timer gnus-stop-date-timer
1820 gnus-mime-view-all-parts) 2700 gnus-mime-view-all-parts)
1821 ("gnus-int" gnus-request-type) 2701 ("gnus-int" gnus-request-type)
1833 gnus-async-prefetch-article gnus-async-prefetch-remove-group 2713 gnus-async-prefetch-article gnus-async-prefetch-remove-group
1834 gnus-async-halt-prefetch) 2714 gnus-async-halt-prefetch)
1835 ("gnus-agent" gnus-open-agent gnus-agent-get-function 2715 ("gnus-agent" gnus-open-agent gnus-agent-get-function
1836 gnus-agent-save-groups gnus-agent-save-active gnus-agent-method-p 2716 gnus-agent-save-groups gnus-agent-save-active gnus-agent-method-p
1837 gnus-agent-get-undownloaded-list gnus-agent-fetch-session 2717 gnus-agent-get-undownloaded-list gnus-agent-fetch-session
1838 gnus-summary-set-agent-mark gnus-agent-save-group-info) 2718 gnus-summary-set-agent-mark gnus-agent-save-group-info
2719 gnus-agent-request-article gnus-agent-retrieve-headers)
1839 ("gnus-agent" :interactive t 2720 ("gnus-agent" :interactive t
1840 gnus-unplugged gnus-agentize gnus-agent-batch) 2721 gnus-unplugged gnus-agentize gnus-agent-batch)
1841 ("gnus-vm" :interactive t gnus-summary-save-in-vm 2722 ("gnus-vm" :interactive t gnus-summary-save-in-vm
1842 gnus-summary-save-article-vm) 2723 gnus-summary-save-article-vm)
1843 ("gnus-draft" :interactive t gnus-draft-mode gnus-group-send-drafts) 2724 ("compface" uncompface)
2725 ("gnus-draft" :interactive t gnus-draft-mode gnus-group-send-queue)
1844 ("gnus-mlspl" gnus-group-split gnus-group-split-fancy) 2726 ("gnus-mlspl" gnus-group-split gnus-group-split-fancy)
1845 ("gnus-mlspl" :interactive t gnus-group-split-setup 2727 ("gnus-mlspl" :interactive t gnus-group-split-setup
1846 gnus-group-split-update)))) 2728 gnus-group-split-update)
2729 ("gnus-delay" gnus-delay-initialize))))
1847 2730
1848 ;;; gnus-sum.el thingies 2731 ;;; gnus-sum.el thingies
1849 2732
1850 2733
1851 (defcustom gnus-summary-line-format "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n" 2734 (defcustom gnus-summary-line-format "%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n"
1852 "*The format specification of the lines in the summary buffer. 2735 "*The format specification of the lines in the summary buffer.
1853 2736
1854 It works along the same lines as a normal formatting string, 2737 It works along the same lines as a normal formatting string,
1855 with some simple extensions. 2738 with some simple extensions.
1856 2739
1863 %F Contents of the From: header (string) 2746 %F Contents of the From: header (string)
1864 %f Contents of the From: or To: headers (string) 2747 %f Contents of the From: or To: headers (string)
1865 %x Contents of the Xref: header (string) 2748 %x Contents of the Xref: header (string)
1866 %D Date of the article (string) 2749 %D Date of the article (string)
1867 %d Date of the article (string) in DD-MMM format 2750 %d Date of the article (string) in DD-MMM format
2751 %o Date of the article (string) in YYYYMMDD`T'HHMMSS format
1868 %M Message-id of the article (string) 2752 %M Message-id of the article (string)
1869 %r References of the article (string) 2753 %r References of the article (string)
1870 %c Number of characters in the article (integer) 2754 %c Number of characters in the article (integer)
2755 %k Pretty-printed version of the above (string)
2756 For example, \"1.2k\" or \"0.4M\".
1871 %L Number of lines in the article (integer) 2757 %L Number of lines in the article (integer)
1872 %I Indentation based on thread level (a string of spaces) 2758 %I Indentation based on thread level (a string of spaces)
2759 %B A complex trn-style thread tree (string)
2760 The variables `gnus-sum-thread-*' can be used for customization.
1873 %T A string with two possible values: 80 spaces if the article 2761 %T A string with two possible values: 80 spaces if the article
1874 is on thread level two or larger and 0 spaces on level one 2762 is on thread level two or larger and 0 spaces on level one
1875 %R \"A\" if this article has been replied to, \" \" otherwise (character) 2763 %R \"A\" if this article has been replied to, \" \" otherwise (character)
1876 %U Status of this article (character, \"R\", \"K\", \"-\" or \" \") 2764 %U Status of this article (character, \"R\", \"K\", \"-\" or \" \")
1877 %[ Opening bracket (character, \"[\" or \"<\") 2765 %[ Opening bracket (character, \"[\" or \"<\")
1884 %e Whether the thread is empty or not (character). 2772 %e Whether the thread is empty or not (character).
1885 %l GroupLens score (string). 2773 %l GroupLens score (string).
1886 %V Total thread score (number). 2774 %V Total thread score (number).
1887 %P The line number (number). 2775 %P The line number (number).
1888 %O Download mark (character). 2776 %O Download mark (character).
2777 %* If present, indicates desired cursor position
2778 (instead of after first colon).
1889 %u User defined specifier. The next character in the format string should 2779 %u User defined specifier. The next character in the format string should
1890 be a letter. Gnus will call the function gnus-user-format-function-X, 2780 be a letter. Gnus will call the function gnus-user-format-function-X,
1891 where X is the letter following %u. The function will be passed the 2781 where X is the letter following %u. The function will be passed the
1892 current header as argument. The function should return a string, which 2782 current header as argument. The function should return a string, which
1893 will be inserted into the summary just like information from any other 2783 will be inserted into the summary just like information from any other
1894 summary specifier. 2784 summary specifier.
1895 2785
1896 Text between %( and %) will be highlighted with `gnus-mouse-face'
1897 when the mouse point is placed inside the area. There can only be one
1898 such area.
1899
1900 The %U (status), %R (replied) and %z (zcore) specs have to be handled 2786 The %U (status), %R (replied) and %z (zcore) specs have to be handled
1901 with care. For reasons of efficiency, Gnus will compute what column 2787 with care. For reasons of efficiency, Gnus will compute what column
1902 these characters will end up in, and \"hard-code\" that. This means that 2788 these characters will end up in, and \"hard-code\" that. This means that
1903 it is invalid to have these specs after a variable-length spec. Well, 2789 it is invalid to have these specs after a variable-length spec. Well,
1904 you might not be arrested, but your summary buffer will look strange, 2790 you might not be arrested, but your summary buffer will look strange,
1905 which is bad enough. 2791 which is bad enough.
1906 2792
1907 The smart choice is to have these specs as for to the left as 2793 The smart choice is to have these specs as far to the left as
1908 possible. 2794 possible.
1909 2795
1910 This restriction may disappear in later versions of Gnus." 2796 This restriction may disappear in later versions of Gnus.
2797
2798 General format specifiers can also be used.
2799 See Info node `(gnus)Formatting Variables'."
2800 :link '(custom-manual "(gnus)Formatting Variables")
1911 :type 'string 2801 :type 'string
1912 :group 'gnus-summary-format) 2802 :group 'gnus-summary-format)
1913 2803
1914 ;;; 2804 ;;;
1915 ;;; Skeleton keymaps 2805 ;;; Skeleton keymaps
1948 (mail-header-from header)) 2838 (mail-header-from header))
1949 2839
1950 (defmacro gnus-gethash (string hashtable) 2840 (defmacro gnus-gethash (string hashtable)
1951 "Get hash value of STRING in HASHTABLE." 2841 "Get hash value of STRING in HASHTABLE."
1952 `(symbol-value (intern-soft ,string ,hashtable))) 2842 `(symbol-value (intern-soft ,string ,hashtable)))
2843
2844 (defmacro gnus-gethash-safe (string hashtable)
2845 "Get hash value of STRING in HASHTABLE.
2846 Return nil if not defined."
2847 `(let ((sym (intern-soft ,string ,hashtable)))
2848 (and (boundp sym) (symbol-value sym))))
1953 2849
1954 (defmacro gnus-sethash (string value hashtable) 2850 (defmacro gnus-sethash (string value hashtable)
1955 "Set hash value. Arguments are STRING, VALUE, and HASHTABLE." 2851 "Set hash value. Arguments are STRING, VALUE, and HASHTABLE."
1956 `(set (intern ,string ,hashtable) ,value)) 2852 `(set (intern ,string ,hashtable) ,value))
1957 (put 'gnus-sethash 'edebug-form-spec '(form form form)) 2853 (put 'gnus-sethash 'edebug-form-spec '(form form form))
2034 (setcar rank (cons (car rank) ,score))))) 2930 (setcar rank (cons (car rank) ,score)))))
2035 2931
2036 (defmacro gnus-get-info (group) 2932 (defmacro gnus-get-info (group)
2037 `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb))) 2933 `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb)))
2038 2934
2039 ;; Byte-compiler warning.
2040 (defvar gnus-visual)
2041 ;; Find out whether the gnus-visual TYPE is wanted.
2042 (defun gnus-visual-p (&optional type class)
2043 (and gnus-visual ; Has to be non-nil, at least.
2044 (if (not type) ; We don't care about type.
2045 gnus-visual
2046 (if (listp gnus-visual) ; It's a list, so we check it.
2047 (or (memq type gnus-visual)
2048 (memq class gnus-visual))
2049 t))))
2050
2051 ;;; Load the compatibility functions. 2935 ;;; Load the compatibility functions.
2052 2936
2053 (require 'gnus-ems) 2937 (require 'gnus-ems)
2054 2938
2055 2939
2074 2958
2075 ;;; 2959 ;;;
2076 ;;; Gnus Utility Functions 2960 ;;; Gnus Utility Functions
2077 ;;; 2961 ;;;
2078 2962
2963 (defun gnus-find-subscribed-addresses ()
2964 "Return a regexp matching the addresses of all subscribed mail groups.
2965 It consists of the `to-address' or `to-list' parameter of all groups
2966 with a `subscribed' parameter."
2967 (let (group address addresses)
2968 (dolist (entry (cdr gnus-newsrc-alist))
2969 (setq group (car entry))
2970 (when (gnus-parameter-subscribed group)
2971 (setq address (mail-strip-quoted-names
2972 (or (gnus-group-fast-parameter group 'to-address)
2973 (gnus-group-fast-parameter group 'to-list))))
2974 (when address
2975 (add-to-list 'addresses address))))
2976 (when addresses
2977 (list (mapconcat 'regexp-quote addresses "\\|")))))
2079 2978
2080 (defmacro gnus-string-or (&rest strings) 2979 (defmacro gnus-string-or (&rest strings)
2081 "Return the first element of STRINGS that is a non-blank string. 2980 "Return the first element of STRINGS that is a non-blank string.
2082 STRINGS will be evaluated in normal `or' order." 2981 STRINGS will be evaluated in normal `or' order."
2083 `(gnus-string-or-1 ',strings)) 2982 `(gnus-string-or-1 ',strings))
2097 (interactive "P") 2996 (interactive "P")
2098 (if arg 2997 (if arg
2099 (insert (message gnus-version)) 2998 (insert (message gnus-version))
2100 (message gnus-version))) 2999 (message gnus-version)))
2101 3000
2102 (defun gnus-continuum-version (version) 3001 (defun gnus-continuum-version (&optional version)
2103 "Return VERSION as a floating point number." 3002 "Return VERSION as a floating point number."
3003 (interactive)
3004 (unless version
3005 (setq version gnus-version))
2104 (when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version) 3006 (when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version)
2105 (string-match "^\\(.?\\)gnus-\\([0-9.]+\\)$" version)) 3007 (string-match "^\\(.?\\)gnus-\\([0-9.]+\\)$" version))
2106 (let ((alpha (and (match-beginning 1) (match-string 1 version))) 3008 (let ((alpha (and (match-beginning 1) (match-string 1 version)))
2107 (number (match-string 2 version)) 3009 (number (match-string 2 version))
2108 major minor least) 3010 major minor least)
2114 least (if (match-beginning 3) 3016 least (if (match-beginning 3)
2115 (string-to-number (match-string 3 number)) 3017 (string-to-number (match-string 3 number))
2116 0)) 3018 0))
2117 (string-to-number 3019 (string-to-number
2118 (if (zerop major) 3020 (if (zerop major)
2119 (format "%s00%02d%02d" 3021 (format "%s00%02d%02d"
2120 (if (member alpha '("(ding)" "d")) 3022 (if (member alpha '("(ding)" "d"))
2121 "4.99" 3023 "4.99"
2122 (+ 5 (* 0.02 3024 (+ 5 (* 0.02
2123 (abs 3025 (abs
2124 (- (mm-char-int (aref (downcase alpha) 0)) 3026 (- (mm-char-int (aref (downcase alpha) 0))
2125 (mm-char-int ?t)))) 3027 (mm-char-int ?t))))
2126 -0.01)) 3028 -0.01))
2127 minor least) 3029 minor least)
2128 (format "%d.%02d%02d" major minor least)))))) 3030 (format "%d.%02d%02d" major minor least))))))
2129 3031
2130 (defun gnus-info-find-node () 3032 (defun gnus-info-find-node (&optional nodename)
2131 "Find Info documentation of Gnus." 3033 "Find Info documentation of Gnus."
2132 (interactive) 3034 (interactive)
2133 ;; Enlarge info window if needed. 3035 ;; Enlarge info window if needed.
2134 (let (gnus-info-buffer) 3036 (let (gnus-info-buffer)
2135 (Info-goto-node (cadr (assq major-mode gnus-info-nodes))) 3037 (Info-goto-node (or nodename (cadr (assq major-mode gnus-info-nodes))))
2136 (setq gnus-info-buffer (current-buffer)) 3038 (setq gnus-info-buffer (current-buffer))
2137 (gnus-configure-windows 'info))) 3039 (gnus-configure-windows 'info)))
2138 3040
2139 ;;; 3041 ;;;
2140 ;;; gnus-interactive 3042 ;;; gnus-interactive
2272 If GROUP is nil, `gnus-newsgroup-name' will be checked instead. Note 3174 If GROUP is nil, `gnus-newsgroup-name' will be checked instead. Note
2273 that that variable is buffer-local to the summary buffers." 3175 that that variable is buffer-local to the summary buffers."
2274 (let ((group (or group gnus-newsgroup-name))) 3176 (let ((group (or group gnus-newsgroup-name)))
2275 (not (gnus-check-backend-function 'request-replace-article group)))) 3177 (not (gnus-check-backend-function 'request-replace-article group))))
2276 3178
2277 (defun gnus-group-total-expirable-p (group)
2278 "Check whether GROUP is total-expirable or not."
2279 (let ((params (gnus-group-find-parameter group))
2280 val)
2281 (cond
2282 ((memq 'total-expire params)
2283 t)
2284 ((setq val (assq 'total-expire params)) ; (auto-expire . t)
2285 (cdr val))
2286 (gnus-total-expirable-newsgroups ; Check var.
2287 (string-match gnus-total-expirable-newsgroups group)))))
2288
2289 (defun gnus-group-auto-expirable-p (group)
2290 "Check whether GROUP is auto-expirable or not."
2291 (let ((params (gnus-group-find-parameter group))
2292 val)
2293 (cond
2294 ((memq 'auto-expire params)
2295 t)
2296 ((setq val (assq 'auto-expire params)) ; (auto-expire . t)
2297 (cdr val))
2298 (gnus-auto-expirable-newsgroups ; Check var.
2299 (string-match gnus-auto-expirable-newsgroups group)))))
2300
2301 (defun gnus-virtual-group-p (group) 3179 (defun gnus-virtual-group-p (group)
2302 "Say whether GROUP is virtual or not." 3180 "Say whether GROUP is virtual or not."
2303 (memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group))) 3181 (memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group)))
2304 gnus-valid-select-methods))) 3182 gnus-valid-select-methods)))
2305 3183
2306 (defun gnus-news-group-p (group &optional article) 3184 (defun gnus-news-group-p (group &optional article)
2307 "Return non-nil if GROUP (and ARTICLE) come from a news server." 3185 "Return non-nil if GROUP (and ARTICLE) come from a news server."
2308 (or (gnus-member-of-valid 'post group) ; Ordinary news group. 3186 (cond ((gnus-member-of-valid 'post group) ;Ordinary news group
2309 (and (gnus-member-of-valid 'post-mail group) ; Combined group. 3187 t) ;is news of course.
2310 (if (or (null article) 3188 ((not (gnus-member-of-valid 'post-mail group)) ;Non-combined.
2311 (not (< article 0))) 3189 nil) ;must be mail then.
2312 (eq (gnus-request-type group article) 'news) 3190 ((vectorp article) ;Has header info.
2313 (if (not (vectorp article)) 3191 (eq (gnus-request-type group (mail-header-id article)) 'news))
2314 nil 3192 ((null article) ;Hasn't header info
2315 ;; It's a real article. 3193 (eq (gnus-request-type group) 'news)) ;(unknown ==> mail)
2316 (eq (gnus-request-type group (mail-header-id article)) 3194 ((< article 0) ;Virtual message
2317 'news)))))) 3195 nil) ;we don't know, guess mail.
3196 (t ;Has positive number
3197 (eq (gnus-request-type group article) 'news)))) ;use it.
2318 3198
2319 ;; Returns a list of writable groups. 3199 ;; Returns a list of writable groups.
2320 (defun gnus-writable-groups () 3200 (defun gnus-writable-groups ()
2321 (let ((alist gnus-newsrc-alist) 3201 (let ((alist gnus-newsrc-alist)
2322 groups group) 3202 groups group)
2373 (memq 'physical-address (assq (car method) 3253 (memq 'physical-address (assq (car method)
2374 gnus-valid-select-methods))) 3254 gnus-valid-select-methods)))
2375 (append method (list (list (intern (concat method-name "-address")) 3255 (append method (list (list (intern (concat method-name "-address"))
2376 (nth 1 method)))) 3256 (nth 1 method))))
2377 method))) 3257 method)))
3258
3259 (defsubst gnus-server-to-method (server)
3260 "Map virtual server names to select methods."
3261 (or (and server (listp server) server)
3262 (cdr (assoc server gnus-server-method-cache))
3263 (let ((result
3264 (or
3265 ;; Perhaps this is the native server?
3266 (and (equal server "native") gnus-select-method)
3267 ;; It should be in the server alist.
3268 (cdr (assoc server gnus-server-alist))
3269 ;; It could be in the predefined server alist.
3270 (cdr (assoc server gnus-predefined-server-alist))
3271 ;; If not, we look through all the opened server
3272 ;; to see whether we can find it there.
3273 (let ((opened gnus-opened-servers))
3274 (while (and opened
3275 (not (equal server (format "%s:%s" (caaar opened)
3276 (cadaar opened)))))
3277 (pop opened))
3278 (caar opened))
3279 ;; It could be a named method, search all servers
3280 (let ((servers gnus-secondary-select-methods))
3281 (while (and servers
3282 (not (equal server (format "%s:%s" (caar servers)
3283 (cadar servers)))))
3284 (pop servers))
3285 (car servers))
3286 ;; This could be some sort of foreign server that I
3287 ;; simply haven't opened (yet). Do a brute-force scan
3288 ;; of the entire gnus-newsrc-alist for the server name
3289 ;; of every method. As a side-effect, loads the
3290 ;; gnus-server-method-cache so this only happens once,
3291 ;; if at all.
3292 (let (match)
3293 (mapcar
3294 (lambda (info)
3295 (let ((info-method (gnus-info-method info)))
3296 (unless (stringp info-method)
3297 (let ((info-server (gnus-method-to-server info-method)))
3298 (when (equal server info-server)
3299 (setq match info-method))))))
3300 (cdr gnus-newsrc-alist))
3301 match))))
3302 (when result
3303 (push (cons server result) gnus-server-method-cache))
3304 result)))
3305
3306 (defsubst gnus-method-to-server (method)
3307 (catch 'server-name
3308 (setq method (or method gnus-select-method))
3309
3310 ;; Perhaps it is already in the cache.
3311 (mapc (lambda (name-method)
3312 (if (equal (cdr name-method) method)
3313 (throw 'server-name (car name-method))))
3314 gnus-server-method-cache)
3315
3316 (mapc
3317 (lambda (server-alist)
3318 (mapc (lambda (name-method)
3319 (when (gnus-methods-equal-p (cdr name-method) method)
3320 (unless (member name-method gnus-server-method-cache)
3321 (push name-method gnus-server-method-cache))
3322 (throw 'server-name (car name-method))))
3323 server-alist))
3324 (let ((alists (list gnus-server-alist
3325 gnus-predefined-server-alist)))
3326 (if gnus-select-method
3327 (push (list (cons "native" gnus-select-method)) alists))
3328 alists))
3329
3330 (let* ((name (if (member (cadr method) '(nil ""))
3331 (format "%s" (car method))
3332 (format "%s:%s" (car method) (cadr method))))
3333 (name-method (cons name method)))
3334 (unless (member name-method gnus-server-method-cache)
3335 (push name-method gnus-server-method-cache))
3336 name)))
2378 3337
2379 (defsubst gnus-server-get-method (group method) 3338 (defsubst gnus-server-get-method (group method)
2380 ;; Input either a server name, and extended server name, or a 3339 ;; Input either a server name, and extended server name, or a
2381 ;; select method, and return a select method. 3340 ;; select method, and return a select method.
2382 (cond ((stringp method) 3341 (cond ((stringp method)
2391 (equal (cadr method) "")) 3350 (equal (cadr method) ""))
2392 method) 3351 method)
2393 (t 3352 (t
2394 (gnus-server-add-address method)))) 3353 (gnus-server-add-address method))))
2395 3354
2396 (defun gnus-server-to-method (server)
2397 "Map virtual server names to select methods."
2398 (or
2399 ;; Is this a method, perhaps?
2400 (and server (listp server) server)
2401 ;; Perhaps this is the native server?
2402 (and (equal server "native") gnus-select-method)
2403 ;; It should be in the server alist.
2404 (cdr (assoc server gnus-server-alist))
2405 ;; It could be in the predefined server alist.
2406 (cdr (assoc server gnus-predefined-server-alist))
2407 ;; If not, we look through all the opened server
2408 ;; to see whether we can find it there.
2409 (let ((opened gnus-opened-servers))
2410 (while (and opened
2411 (not (equal server (format "%s:%s" (caaar opened)
2412 (cadaar opened)))))
2413 (pop opened))
2414 (caar opened))
2415 ;; It could be a named method, search all servers
2416 (let ((servers gnus-secondary-select-methods))
2417 (while (and servers
2418 (not (equal server (format "%s:%s" (caar servers)
2419 (cadar servers)))))
2420 (pop servers))
2421 (car servers))))
2422
2423 (defmacro gnus-method-equal (ss1 ss2) 3355 (defmacro gnus-method-equal (ss1 ss2)
2424 "Say whether two servers are equal." 3356 "Say whether two servers are equal."
2425 `(let ((s1 ,ss1) 3357 `(let ((s1 ,ss1)
2426 (s2 ,ss2)) 3358 (s2 ,ss2))
2427 (or (equal s1 s2) 3359 (or (equal s1 s2)
2472 (let ((active (cadr (assq 'nnfolder-active-file 3404 (let ((active (cadr (assq 'nnfolder-active-file
2473 gnus-message-archive-method)))) 3405 gnus-message-archive-method))))
2474 (and active 3406 (and active
2475 (file-exists-p active)))))) 3407 (file-exists-p active))))))
2476 3408
2477 (defun gnus-group-prefixed-name (group method) 3409 (defsubst gnus-method-to-server-name (method)
2478 "Return the whole name from GROUP and METHOD." 3410 (concat
2479 (and (stringp method) (setq method (gnus-server-to-method method))) 3411 (format "%s" (car method))
3412 (when (and
3413 (or (assoc (format "%s" (car method))
3414 (gnus-methods-using 'address))
3415 (gnus-server-equal method gnus-message-archive-method))
3416 (nth 1 method)
3417 (not (string= (nth 1 method) "")))
3418 (concat "+" (nth 1 method)))))
3419
3420 (defsubst gnus-method-to-full-server-name (method)
3421 (format "%s+%s" (car method) (nth 1 method)))
3422
3423 (defun gnus-group-prefixed-name (group method &optional full)
3424 "Return the whole name from GROUP and METHOD.
3425 Call with full set to get the fully qualified group name (even if the
3426 server is native)."
3427 (when (stringp method)
3428 (setq method (gnus-server-to-method method)))
2480 (if (or (not method) 3429 (if (or (not method)
2481 (gnus-server-equal method "native")) 3430 (and (not full) (gnus-server-equal method "native"))
3431 ;;;!!! This might not be right. We'll see...
3432 ;(string-match ":" group)
3433 )
2482 group 3434 group
2483 (concat (format "%s" (car method)) 3435 (concat (gnus-method-to-server-name method) ":" group)))
2484 (when (and 3436
2485 (or (assoc (format "%s" (car method)) 3437 (defun gnus-group-guess-prefixed-name (group)
2486 (gnus-methods-using 'address)) 3438 "Guess the whole name from GROUP and METHOD."
2487 (gnus-server-equal method gnus-message-archive-method)) 3439 (gnus-group-prefixed-name group (gnus-find-method-for-group
2488 (nth 1 method) 3440 group)))
2489 (not (string= (nth 1 method) ""))) 3441
2490 (concat "+" (nth 1 method))) 3442 (defun gnus-group-full-name (group method)
2491 ":" group))) 3443 "Return the full name from GROUP and METHOD, even if the method is native."
3444 (gnus-group-prefixed-name group method t))
3445
3446 (defun gnus-group-guess-full-name (group)
3447 "Guess the full name from GROUP, even if the method is native."
3448 (if (gnus-group-prefixed-p group)
3449 group
3450 (gnus-group-full-name group (gnus-find-method-for-group group))))
3451
3452 (defun gnus-group-guess-full-name-from-command-method (group)
3453 "Guess the full name from GROUP, even if the method is native."
3454 (if (gnus-group-prefixed-p group)
3455 group
3456 (gnus-group-full-name group gnus-command-method)))
2492 3457
2493 (defun gnus-group-real-prefix (group) 3458 (defun gnus-group-real-prefix (group)
2494 "Return the prefix of the current group name." 3459 "Return the prefix of the current group name."
2495 (if (string-match "^[^:]+:" group) 3460 (if (stringp group)
2496 (substring group 0 (match-end 0)) 3461 (if (string-match "^[^:]+:" group)
2497 "")) 3462 (substring group 0 (match-end 0))
3463 "")
3464 nil))
3465
3466 (defun gnus-group-short-name (group)
3467 "Return the short group name."
3468 (let ((prefix (gnus-group-real-prefix group)))
3469 (if (< 0 (length prefix))
3470 (substring group (length prefix) nil)
3471 group)))
3472
3473 (defun gnus-group-prefixed-p (group)
3474 "Return the prefix of the current group name."
3475 (< 0 (length (gnus-group-real-prefix group))))
3476
3477 (defun gnus-summary-buffer-name (group)
3478 "Return the summary buffer name of GROUP."
3479 (concat "*Summary " (gnus-group-decoded-name group) "*"))
2498 3480
2499 (defun gnus-group-method (group) 3481 (defun gnus-group-method (group)
2500 "Return the server or method used for selecting GROUP. 3482 "Return the server or method used for selecting GROUP.
2501 You should probably use `gnus-find-method-for-group' instead." 3483 You should probably use `gnus-find-method-for-group' instead."
2502 (let ((prefix (gnus-group-real-prefix group))) 3484 (let ((prefix (gnus-group-real-prefix group)))
2526 (gnus-method-equal method gnus-select-method)) 3508 (gnus-method-equal method gnus-select-method))
2527 3509
2528 (defsubst gnus-secondary-method-p (method) 3510 (defsubst gnus-secondary-method-p (method)
2529 "Return whether METHOD is a secondary select method." 3511 "Return whether METHOD is a secondary select method."
2530 (let ((methods gnus-secondary-select-methods) 3512 (let ((methods gnus-secondary-select-methods)
2531 (gmethod (gnus-server-get-method nil method))) 3513 (gmethod (inline (gnus-server-get-method nil method))))
2532 (while (and methods 3514 (while (and methods
2533 (not (gnus-method-equal 3515 (not (gnus-method-equal
2534 (gnus-server-get-method nil (car methods)) 3516 (inline (gnus-server-get-method nil (car methods)))
2535 gmethod))) 3517 gmethod)))
2536 (setq methods (cdr methods))) 3518 (setq methods (cdr methods)))
2537 methods)) 3519 methods))
2538 3520
2539 (defun gnus-method-simplify (method) 3521 (defun gnus-method-simplify (method)
2567 3549
2568 (defun gnus-group-secondary-p (group) 3550 (defun gnus-group-secondary-p (group)
2569 "Say whether the group is secondary or not." 3551 "Say whether the group is secondary or not."
2570 (gnus-secondary-method-p (gnus-find-method-for-group group))) 3552 (gnus-secondary-method-p (gnus-find-method-for-group group)))
2571 3553
3554 (defun gnus-parameters-get-parameter (group)
3555 "Return the group parameters for GROUP from `gnus-parameters'."
3556 (let (params-list)
3557 (dolist (elem gnus-parameters)
3558 (when (string-match (car elem) group)
3559 (setq params-list
3560 (nconc (gnus-expand-group-parameters
3561 (car elem) (cdr elem) group)
3562 params-list))))
3563 params-list))
3564
3565 (defun gnus-expand-group-parameter (match value group)
3566 "Use MATCH to expand VALUE in GROUP."
3567 (with-temp-buffer
3568 (insert group)
3569 (goto-char (point-min))
3570 (while (re-search-forward match nil t)
3571 (replace-match value))
3572 (buffer-string)))
3573
3574 (defun gnus-expand-group-parameters (match parameters group)
3575 "Go through PARAMETERS and expand them according to the match data."
3576 (let (new)
3577 (dolist (elem parameters)
3578 (if (and (stringp (cdr elem))
3579 (string-match "\\\\[0-9&]" (cdr elem)))
3580 (push (cons (car elem)
3581 (gnus-expand-group-parameter match (cdr elem) group))
3582 new)
3583 (push elem new)))
3584 new))
3585
3586 (defun gnus-group-fast-parameter (group symbol &optional allow-list)
3587 "For GROUP, return the value of SYMBOL.
3588
3589 You should call this in the `gnus-group-buffer' buffer.
3590 The function `gnus-group-find-parameter' will do that for you."
3591 ;; The speed trick: No cons'ing and quit early.
3592 (let* ((params (funcall gnus-group-get-parameter-function group))
3593 ;; Start easy, check the "real" group parameters.
3594 (simple-results
3595 (gnus-group-parameter-value params symbol allow-list t)))
3596 (if simple-results
3597 ;; Found results; return them.
3598 (car simple-results)
3599 ;; We didn't found it there, try `gnus-parameters'.
3600 (let ((result nil)
3601 (head nil)
3602 (tail gnus-parameters))
3603 ;; A good old-fashioned non-cl loop.
3604 (while tail
3605 (setq head (car tail)
3606 tail (cdr tail))
3607 ;; The car is regexp matching for matching the group name.
3608 (when (string-match (car head) group)
3609 ;; The cdr is the parameters.
3610 (setq result (gnus-group-parameter-value (cdr head)
3611 symbol allow-list))
3612 (when result
3613 ;; Expand if necessary.
3614 (if (and (stringp result) (string-match "\\\\[0-9&]" result))
3615 (setq result (gnus-expand-group-parameter (car head)
3616 result group)))
3617 ;; Exit the loop early.
3618 (setq tail nil))))
3619 ;; Done.
3620 result))))
3621
2572 (defun gnus-group-find-parameter (group &optional symbol allow-list) 3622 (defun gnus-group-find-parameter (group &optional symbol allow-list)
2573 "Return the group parameters for GROUP. 3623 "Return the group parameters for GROUP.
2574 If SYMBOL, return the value of that symbol in the group parameters." 3624 If SYMBOL, return the value of that symbol in the group parameters.
3625
3626 If you call this function inside a loop, consider using the faster
3627 `gnus-group-fast-parameter' instead."
2575 (save-excursion 3628 (save-excursion
2576 (set-buffer gnus-group-buffer) 3629 (set-buffer gnus-group-buffer)
2577 (let ((parameters (funcall gnus-group-get-parameter-function group))) 3630 (if symbol
2578 (if symbol 3631 (gnus-group-fast-parameter group symbol allow-list)
2579 (gnus-group-parameter-value parameters symbol allow-list) 3632 (nconc
2580 parameters)))) 3633 (copy-sequence
3634 (funcall gnus-group-get-parameter-function group))
3635 (gnus-parameters-get-parameter group)))))
2581 3636
2582 (defun gnus-group-get-parameter (group &optional symbol allow-list) 3637 (defun gnus-group-get-parameter (group &optional symbol allow-list)
2583 "Return the group parameters for GROUP. 3638 "Return the group parameters for GROUP.
2584 If SYMBOL, return the value of that symbol in the group parameters. 3639 If SYMBOL, return the value of that symbol in the group parameters.
2585 Most functions should use `gnus-group-find-parameter', which 3640 Most functions should use `gnus-group-find-parameter', which
2587 (let ((params (gnus-info-params (gnus-get-info group)))) 3642 (let ((params (gnus-info-params (gnus-get-info group))))
2588 (if symbol 3643 (if symbol
2589 (gnus-group-parameter-value params symbol allow-list) 3644 (gnus-group-parameter-value params symbol allow-list)
2590 params))) 3645 params)))
2591 3646
2592 (defun gnus-group-parameter-value (params symbol &optional allow-list) 3647 (defun gnus-group-parameter-value (params symbol &optional
3648 allow-list present-p)
2593 "Return the value of SYMBOL in group PARAMS." 3649 "Return the value of SYMBOL in group PARAMS."
2594 ;; We only wish to return group parameters (dotted lists) and 3650 ;; We only wish to return group parameters (dotted lists) and
2595 ;; not local variables, which may have the same names. 3651 ;; not local variables, which may have the same names.
2596 ;; But first we handle single elements... 3652 ;; But first we handle single elements...
2597 (or (car (memq symbol params)) 3653 (or (car (memq symbol params))
2601 (while (setq elem (pop params)) 3657 (while (setq elem (pop params))
2602 (when (and (consp elem) 3658 (when (and (consp elem)
2603 (eq (car elem) symbol) 3659 (eq (car elem) symbol)
2604 (or allow-list 3660 (or allow-list
2605 (atom (cdr elem)))) 3661 (atom (cdr elem))))
2606 (throw 'found (cdr elem)))))))) 3662 (throw 'found (if present-p (list (cdr elem))
3663 (cdr elem)))))))))
2607 3664
2608 (defun gnus-group-add-parameter (group param) 3665 (defun gnus-group-add-parameter (group param)
2609 "Add parameter PARAM to GROUP." 3666 "Add parameter PARAM to GROUP."
2610 (let ((info (gnus-get-info group))) 3667 (let ((info (gnus-get-info group)))
2611 (when info 3668 (when info
2660 (while (string-match "\\." group skip) 3717 (while (string-match "\\." group skip)
2661 (setq skip (match-end 0) 3718 (setq skip (match-end 0)
2662 depth (+ depth 1))) 3719 depth (+ depth 1)))
2663 depth)))) 3720 depth))))
2664 ;; Separate foreign select method from group name and collapse. 3721 ;; Separate foreign select method from group name and collapse.
2665 ;; If method contains a server, collapse to non-domain server name, 3722 ;; If method contains a server, collapse to non-domain server name,
2666 ;; otherwise collapse to select method. 3723 ;; otherwise collapse to select method.
2667 (let* ((colon (string-match ":" group)) 3724 (let* ((colon (string-match ":" group))
2668 (server (and colon (substring group 0 colon))) 3725 (server (and colon (substring group 0 colon)))
2669 (plus (and server (string-match "+" server)))) 3726 (plus (and server (string-match "+" server))))
2670 (when server 3727 (when server
2807 (list (intern (substring server 0 (match-beginning 0))) 3864 (list (intern (substring server 0 (match-beginning 0)))
2808 (substring server (match-end 0))) 3865 (substring server (match-end 0)))
2809 (list (intern server) ""))) 3866 (list (intern server) "")))
2810 gnus-select-method)) 3867 gnus-select-method))
2811 3868
3869 (defun gnus-server-string (server)
3870 "Return a readable string that describes SERVER."
3871 (let* ((server (gnus-server-to-method server))
3872 (address (nth 1 server)))
3873 (if (and address
3874 (not (zerop (length address))))
3875 (format "%s using %s" address (car server))
3876 (format "%s" (car server)))))
3877
2812 (defun gnus-find-method-for-group (group &optional info) 3878 (defun gnus-find-method-for-group (group &optional info)
2813 "Find the select method that GROUP uses." 3879 "Find the select method that GROUP uses."
2814 (or gnus-override-method 3880 (or gnus-override-method
2815 (and (not group) 3881 (and (not group)
2816 gnus-select-method) 3882 gnus-select-method)
2817 (and (not (gnus-group-entry group));; a new group 3883 (and (not (gnus-group-entry group)) ;; a new group
2818 (gnus-group-name-to-method group)) 3884 (gnus-group-name-to-method group))
2819 (let ((info (or info (gnus-get-info group))) 3885 (let ((info (or info (gnus-get-info group)))
2820 method) 3886 method)
2821 (if (or (not info) 3887 (if (or (not info)
2822 (not (setq method (gnus-info-method info))) 3888 (not (setq method (gnus-info-method info)))
2855 (when (string-match 3921 (when (string-match
2856 gnus-invalid-group-regexp 3922 gnus-invalid-group-regexp
2857 (setq group (read-string (concat prefix prompt) 3923 (setq group (read-string (concat prefix prompt)
2858 (cons (or default "") 0) 3924 (cons (or default "") 0)
2859 'gnus-group-history))) 3925 'gnus-group-history)))
2860 (setq prefix (format "Invalid group name: \"%s\". " group) 3926 (let ((match (match-string 0 group)))
2861 group nil))) 3927 ;; Might be okay (e.g. for nnimap), so ask the user:
3928 (unless (and (not (string-match "^$\\|:" match))
3929 (message-y-or-n-p
3930 "Proceed and create group anyway? " t
3931 "The group name \"" group "\" contains a forbidden character: \"" match "\".
3932
3933 Usually, it's dangerous to create a group with this name, because it's not
3934 supported by all back ends and servers. On IMAP servers it should work,
3935 though. If you are really sure, you can proceed anyway and create the group.
3936
3937 You may customize the variable `gnus-invalid-group-regexp', which currently is
3938 set to \"" gnus-invalid-group-regexp
3939 "\", if you want to get rid of this query permanently."))
3940 (setq prefix (format "Invalid group name: \"%s\". " group)
3941 group nil)))))
2862 group)) 3942 group))
2863 3943
2864 (defun gnus-read-method (prompt) 3944 (defun gnus-read-method (prompt)
2865 "Prompt the user for a method. 3945 "Prompt the user for a method.
2866 Allow completion over sensible values." 3946 Allow completion over sensible values."
2867 (let* ((servers 3947 (let* ((open-servers
2868 (append gnus-valid-select-methods 3948 (mapcar (lambda (i) (cons (format "%s:%s" (caar i) (cadar i)) i))
2869 (mapcar (lambda (i) (list (format "%s:%s" (caar i) 3949 gnus-opened-servers))
2870 (cadar i)))) 3950 (valid-methods
2871 gnus-opened-servers) 3951 (let (methods)
3952 (dolist (method gnus-valid-select-methods)
3953 (if (or (memq 'prompt-address method)
3954 (not (assoc (format "%s:" (car method)) open-servers)))
3955 (push method methods)))
3956 methods))
3957 (servers
3958 (append valid-methods
3959 open-servers
2872 gnus-predefined-server-alist 3960 gnus-predefined-server-alist
2873 gnus-server-alist)) 3961 gnus-server-alist))
2874 (method 3962 (method
2875 (completing-read 3963 (completing-read
2876 prompt servers 3964 prompt servers
2881 ((assoc method gnus-valid-select-methods) 3969 ((assoc method gnus-valid-select-methods)
2882 (let ((address (if (memq 'prompt-address 3970 (let ((address (if (memq 'prompt-address
2883 (assoc method gnus-valid-select-methods)) 3971 (assoc method gnus-valid-select-methods))
2884 (read-string "Address: ") 3972 (read-string "Address: ")
2885 ""))) 3973 "")))
2886 (or (let ((opened gnus-opened-servers)) 3974 (or (cadr (assoc (format "%s:%s" method address) open-servers))
2887 (while (and opened
2888 (not (equal (format "%s:%s" method address)
2889 (format "%s:%s" (caaar opened)
2890 (cadaar opened)))))
2891 (pop opened))
2892 (caar opened))
2893 (list (intern method) address)))) 3975 (list (intern method) address))))
2894 ((assoc method servers) 3976 ((assoc method servers)
2895 method) 3977 method)
2896 (t 3978 (t
2897 (list (intern method) ""))))) 3979 (list (intern method) "")))))
2898 3980
3981 ;;; Agent functions
3982
3983 (defun gnus-agent-method-p (method)
3984 "Say whether METHOD is covered by the agent."
3985 (or (eq (car gnus-agent-method-p-cache) method)
3986 (setq gnus-agent-method-p-cache
3987 (cons method
3988 (member (if (stringp method)
3989 method
3990 (gnus-method-to-server method)) gnus-agent-covered-methods))))
3991 (cdr gnus-agent-method-p-cache))
3992
3993 (defun gnus-online (method)
3994 (not
3995 (if gnus-plugged
3996 (eq (cadr (assoc method gnus-opened-servers)) 'offline)
3997 (gnus-agent-method-p method))))
3998
2899 ;;; User-level commands. 3999 ;;; User-level commands.
2900 4000
2901 ;;;###autoload 4001 ;;;###autoload
2902 (defun gnus-slave-no-server (&optional arg) 4002 (defun gnus-slave-no-server (&optional arg)
2903 "Read network news as a slave, without connecting to local server." 4003 "Read network news as a slave, without connecting to the local server."
2904 (interactive "P") 4004 (interactive "P")
2905 (gnus-no-server arg t)) 4005 (gnus-no-server arg t))
2906 4006
2907 ;;;###autoload 4007 ;;;###autoload
2908 (defun gnus-no-server (&optional arg slave) 4008 (defun gnus-no-server (&optional arg slave)
2909 "Read network news. 4009 "Read network news.
2910 If ARG is a positive number, Gnus will use that as the 4010 If ARG is a positive number, Gnus will use that as the startup
2911 startup level. If ARG is nil, Gnus will be started at level 2. 4011 level. If ARG is nil, Gnus will be started at level 2. If ARG is
2912 If ARG is non-nil and not a positive number, Gnus will 4012 non-nil and not a positive number, Gnus will prompt the user for the
2913 prompt the user for the name of an NNTP server to use. 4013 name of an NNTP server to use.
2914 As opposed to `gnus', this command will not connect to the local server." 4014 As opposed to `gnus', this command will not connect to the local
4015 server."
2915 (interactive "P") 4016 (interactive "P")
2916 (gnus-no-server-1 arg slave)) 4017 (gnus-no-server-1 arg slave))
2917 4018
2918 ;;;###autoload 4019 ;;;###autoload
2919 (defun gnus-slave (&optional arg) 4020 (defun gnus-slave (&optional arg)
2920 "Read news as a slave." 4021 "Read news as a slave."
2921 (interactive "P") 4022 (interactive "P")
2922 (gnus arg nil 'slave)) 4023 (gnus arg nil 'slave))
2923 4024
2924 ;;;###autoload 4025 ;;;###autoload
2925 (defun gnus-other-frame (&optional arg) 4026 (defun gnus-other-frame (&optional arg display)
2926 "Pop up a frame to read news." 4027 "Pop up a frame to read news.
4028 This will call one of the Gnus commands which is specified by the user
4029 option `gnus-other-frame-function' (default `gnus') with the argument
4030 ARG if Gnus is not running, otherwise just pop up a Gnus frame. The
4031 optional second argument DISPLAY should be a standard display string
4032 such as \"unix:0\" to specify where to pop up a frame. If DISPLAY is
4033 omitted or the function `make-frame-on-display' is not available, the
4034 current display is used."
2927 (interactive "P") 4035 (interactive "P")
2928 (let ((window (get-buffer-window gnus-group-buffer))) 4036 (if (fboundp 'make-frame-on-display)
2929 (cond (window 4037 (unless display
2930 (select-frame (window-frame window))) 4038 (setq display (gnus-frame-or-window-display-name (selected-frame))))
2931 (t 4039 (setq display nil))
2932 (select-frame (make-frame))))) 4040 (let ((alive (gnus-alive-p)))
2933 (gnus arg)) 4041 (unless (and alive
4042 (catch 'found
4043 (walk-windows
4044 (lambda (window)
4045 (when (and (or (not display)
4046 (equal display
4047 (gnus-frame-or-window-display-name
4048 window)))
4049 (with-current-buffer (window-buffer window)
4050 (string-match "\\`gnus-"
4051 (symbol-name major-mode))))
4052 (gnus-select-frame-set-input-focus
4053 (setq gnus-other-frame-object (window-frame window)))
4054 (select-window window)
4055 (throw 'found t)))
4056 'ignore t)))
4057 (gnus-select-frame-set-input-focus
4058 (setq gnus-other-frame-object
4059 (if display
4060 (make-frame-on-display display gnus-other-frame-parameters)
4061 (make-frame gnus-other-frame-parameters))))
4062 (if alive
4063 (switch-to-buffer gnus-group-buffer)
4064 (funcall gnus-other-frame-function arg)
4065 (add-hook 'gnus-exit-gnus-hook
4066 '(lambda nil
4067 (when (and (frame-live-p gnus-other-frame-object)
4068 (cdr (frame-list)))
4069 (delete-frame gnus-other-frame-object))
4070 (setq gnus-other-frame-object nil)))))))
2934 4071
2935 ;;(setq thing ? ; this is a comment 4072 ;;(setq thing ? ; this is a comment
2936 ;; more 'yes) 4073 ;; more 'yes)
2937 4074
2938 ;;;###autoload 4075 ;;;###autoload
2939 (defun gnus (&optional arg dont-connect slave) 4076 (defun gnus (&optional arg dont-connect slave)
2940 "Read network news. 4077 "Read network news.
2941 If ARG is non-nil and a positive number, Gnus will use that as the 4078 If ARG is non-nil and a positive number, Gnus will use that as the
2942 startup level. If ARG is non-nil and not a positive number, Gnus will 4079 startup level. If ARG is non-nil and not a positive number, Gnus will
2943 prompt the user for the name of an NNTP server to use." 4080 prompt the user for the name of an NNTP server to use."
2944 (interactive "P") 4081 (interactive "P")
4082 (unless (byte-code-function-p (symbol-function 'gnus))
4083 (message "You should byte-compile Gnus")
4084 (sit-for 2))
2945 (gnus-1 arg dont-connect slave)) 4085 (gnus-1 arg dont-connect slave))
2946 4086
2947 ;; Allow redefinition of Gnus functions. 4087 ;; Allow redefinition of Gnus functions.
2948 4088
2949 (gnus-ems-redefine) 4089 (gnus-ems-redefine)