git.chise.org Git - elisp/gnus.git-/blob - lisp/gnus.el

   1 ;;; gnus.el --- a newsreader for GNU Emacs
   2 ;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996,
   3 ;;        1997, 1998, 2000 Free Software Foundation, Inc.
   4
   5 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
   6 ;;      Lars Magne Ingebrigtsen <larsi@gnus.org>
   7 ;;      Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
   8 ;;      Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp>
   9 ;; Keywords: news, mail
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, USA.
  27
  28 ;;; Commentary:
  29
  30 ;;; Code:
  31
  32 (eval '(run-hooks 'gnus-load-hook))
  33
  34 (eval-when-compile (require 'cl))
  35 (eval-when-compile (require 'static))
  36
  37 (require 'gnus-vers)
  38 (require 'message)
  39
  40 (defgroup gnus nil
  41   "The coffee-brewing, all singing, all dancing, kitchen sink newsreader."
  42   :group 'news
  43   :group 'mail)
  44
  45 (defgroup gnus-charset nil
  46   "Group character set issues."
  47   :link '(custom-manual "(gnus)Charsets")
  48   :group 'gnus)
  49
  50 (defgroup gnus-cache nil
  51   "Cache interface."
  52   :group 'gnus)
  53
  54 (defgroup gnus-start nil
  55   "Starting your favorite newsreader."
  56   :group 'gnus)
  57
  58 (defgroup gnus-start-server nil
  59   "Server options at startup."
  60   :group 'gnus-start)
  61
  62 ;; These belong to gnus-group.el.
  63 (defgroup gnus-group nil
  64   "Group buffers."
  65   :link '(custom-manual "(gnus)The Group Buffer")
  66   :group 'gnus)
  67
  68 (defgroup gnus-group-foreign nil
  69   "Foreign groups."
  70   :link '(custom-manual "(gnus)Foreign Groups")
  71   :group 'gnus-group)
  72
  73 (defgroup gnus-group-new nil
  74   "Automatic subscription of new groups."
  75   :group 'gnus-group)
  76
  77 (defgroup gnus-group-levels nil
  78   "Group levels."
  79   :link '(custom-manual "(gnus)Group Levels")
  80   :group 'gnus-group)
  81
  82 (defgroup gnus-group-select nil
  83   "Selecting a Group."
  84   :link '(custom-manual "(gnus)Selecting a Group")
  85   :group 'gnus-group)
  86
  87 (defgroup gnus-group-listing nil
  88   "Showing slices of the group list."
  89   :link '(custom-manual "(gnus)Listing Groups")
  90   :group 'gnus-group)
  91
  92 (defgroup gnus-group-visual nil
  93   "Sorting the group buffer."
  94   :link '(custom-manual "(gnus)Group Buffer Format")
  95   :group 'gnus-group
  96   :group 'gnus-visual)
  97
  98 (defgroup gnus-group-various nil
  99   "Various group options."
 100   :link '(custom-manual "(gnus)Scanning New Messages")
 101   :group 'gnus-group)
 102
 103 ;; These belong to gnus-sum.el.
 104 (defgroup gnus-summary nil
 105   "Summary buffers."
 106   :link '(custom-manual "(gnus)The Summary Buffer")
 107   :group 'gnus)
 108
 109 (defgroup gnus-summary-exit nil
 110   "Leaving summary buffers."
 111   :link '(custom-manual "(gnus)Exiting the Summary Buffer")
 112   :group 'gnus-summary)
 113
 114 (defgroup gnus-summary-marks nil
 115   "Marks used in summary buffers."
 116   :link '(custom-manual "(gnus)Marking Articles")
 117   :group 'gnus-summary)
 118
 119 (defgroup gnus-thread nil
 120   "Ordering articles according to replies."
 121   :link '(custom-manual "(gnus)Threading")
 122   :group 'gnus-summary)
 123
 124 (defgroup gnus-summary-format nil
 125   "Formatting of the summary buffer."
 126   :link '(custom-manual "(gnus)Summary Buffer Format")
 127   :group 'gnus-summary)
 128
 129 (defgroup gnus-summary-choose nil
 130   "Choosing Articles."
 131   :link '(custom-manual "(gnus)Choosing Articles")
 132   :group 'gnus-summary)
 133
 134 (defgroup gnus-summary-maneuvering nil
 135   "Summary movement commands."
 136   :link '(custom-manual "(gnus)Summary Maneuvering")
 137   :group 'gnus-summary)
 138
 139 (defgroup gnus-summary-mail nil
 140   "Mail group commands."
 141   :link '(custom-manual "(gnus)Mail Group Commands")
 142   :group 'gnus-summary)
 143
 144 (defgroup gnus-summary-sort nil
 145   "Sorting the summary buffer."
 146   :link '(custom-manual "(gnus)Sorting")
 147   :group 'gnus-summary)
 148
 149 (defgroup gnus-summary-visual nil
 150   "Highlighting and menus in the summary buffer."
 151   :link '(custom-manual "(gnus)Summary Highlighting")
 152   :group 'gnus-visual
 153   :group 'gnus-summary)
 154
 155 (defgroup gnus-summary-various nil
 156   "Various summary buffer options."
 157   :link '(custom-manual "(gnus)Various Summary Stuff")
 158   :group 'gnus-summary)
 159
 160 (defgroup gnus-summary-pick nil
 161   "Pick mode in the summary buffer."
 162   :link '(custom-manual "(gnus)Pick and Read")
 163   :prefix "gnus-pick-"
 164   :group 'gnus-summary)
 165
 166 (defgroup gnus-summary-tree nil
 167   "Tree display of threads in the summary buffer."
 168   :link '(custom-manual "(gnus)Tree Display")
 169   :prefix "gnus-tree-"
 170   :group 'gnus-summary)
 171
 172 ;; Belongs to gnus-uu.el
 173 (defgroup gnus-extract-view nil
 174   "Viewing extracted files."
 175   :link '(custom-manual "(gnus)Viewing Files")
 176   :group 'gnus-extract)
 177
 178 ;; Belongs to gnus-score.el
 179 (defgroup gnus-score nil
 180   "Score and kill file handling."
 181   :group 'gnus)
 182
 183 (defgroup gnus-score-kill nil
 184   "Kill files."
 185   :group 'gnus-score)
 186
 187 (defgroup gnus-score-adapt nil
 188   "Adaptive score files."
 189   :group 'gnus-score)
 190
 191 (defgroup gnus-score-default nil
 192   "Default values for score files."
 193   :group 'gnus-score)
 194
 195 (defgroup gnus-score-expire nil
 196   "Expiring score rules."
 197   :group 'gnus-score)
 198
 199 (defgroup gnus-score-decay nil
 200   "Decaying score rules."
 201   :group 'gnus-score)
 202
 203 (defgroup gnus-score-files nil
 204   "Score and kill file names."
 205   :group 'gnus-score
 206   :group 'gnus-files)
 207
 208 (defgroup gnus-score-various nil
 209   "Various scoring and killing options."
 210   :group 'gnus-score)
 211
 212 ;; Other
 213 (defgroup gnus-visual nil
 214   "Options controling the visual fluff."
 215   :group 'gnus
 216   :group 'faces)
 217
 218 (defgroup gnus-agent nil
 219   "Offline support for Gnus."
 220   :group 'gnus)
 221
 222 (defgroup gnus-files nil
 223   "Files used by Gnus."
 224   :group 'gnus)
 225
 226 (defgroup gnus-dribble-file nil
 227   "Auto save file."
 228   :link '(custom-manual "(gnus)Auto Save")
 229   :group 'gnus-files)
 230
 231 (defgroup gnus-newsrc nil
 232   "Storing Gnus state."
 233   :group 'gnus-files)
 234
 235 (defgroup gnus-server nil
 236   "Options related to newsservers and other servers used by Gnus."
 237   :group 'gnus)
 238
 239 (defgroup gnus-message '((message custom-group))
 240   "Composing replies and followups in Gnus."
 241   :group 'gnus)
 242
 243 (defgroup gnus-meta nil
 244   "Meta variables controling major portions of Gnus.
 245 In general, modifying these variables does not take affect until Gnus
 246 is restarted, and sometimes reloaded."
 247   :group 'gnus)
 248
 249 (defgroup gnus-various nil
 250   "Other Gnus options."
 251   :link '(custom-manual "(gnus)Various Various")
 252   :group 'gnus)
 253
 254 (defgroup gnus-mime nil
 255   "Variables for controlling the Gnus MIME interface."
 256   :group 'gnus)
 257
 258 (defgroup gnus-exit nil
 259   "Exiting gnus."
 260   :link '(custom-manual "(gnus)Exiting Gnus")
 261   :group 'gnus)
 262
 263 (defcustom gnus-inhibit-startup-message nil
 264   "If non-nil, the startup message will not be displayed.
 265 This variable is used before `.gnus.el' is loaded, so it should
 266 be set in `.emacs' instead."
 267   :group 'gnus-start
 268   :type 'boolean)
 269
 270 (defcustom gnus-play-startup-jingle nil
 271   "If non-nil, play the Gnus jingle at startup."
 272   :group 'gnus-start
 273   :type 'boolean)
 274
 275 (unless (featurep 'gnus-xmas)
 276   (defalias 'gnus-make-overlay 'make-overlay)
 277   (defalias 'gnus-delete-overlay 'delete-overlay)
 278   (defalias 'gnus-overlay-put 'overlay-put)
 279   (defalias 'gnus-move-overlay 'move-overlay)
 280   (defalias 'gnus-overlay-end 'overlay-end)
 281   (defalias 'gnus-extent-detached-p 'ignore)
 282   (defalias 'gnus-extent-start-open 'ignore)
 283   (defalias 'gnus-set-text-properties 'set-text-properties)
 284   (defalias 'gnus-group-remove-excess-properties 'ignore)
 285   (defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window)
 286   (defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names)
 287   (defalias 'gnus-character-to-event 'identity)
 288   (defalias 'gnus-add-text-properties 'add-text-properties)
 289   (defalias 'gnus-put-text-property 'put-text-property)
 290   (defalias 'gnus-mode-line-buffer-identification 'identity)
 291   (defalias 'gnus-characterp 'numberp)
 292   (defalias 'gnus-deactivate-mark 'deactivate-mark)
 293   (defalias 'gnus-window-edges 'window-edges)
 294   (defalias 'gnus-key-press-event-p 'numberp)
 295   (defalias 'gnus-decode-rfc1522 'ignore))
 296
 297 ;; We define these group faces here to avoid the display
 298 ;; update forced when creating new faces.
 299
 300 (defface gnus-group-news-1-face
 301   '((((class color)
 302       (background dark))
 303      (:foreground "PaleTurquoise" :bold t))
 304     (((class color)
 305       (background light))
 306      (:foreground "ForestGreen" :bold t))
 307     (t
 308      ()))
 309   "Level 1 newsgroup face.")
 310
 311 (defface gnus-group-news-1-empty-face
 312   '((((class color)
 313       (background dark))
 314      (:foreground "PaleTurquoise"))
 315     (((class color)
 316       (background light))
 317      (:foreground "ForestGreen"))
 318     (t
 319      ()))
 320   "Level 1 empty newsgroup face.")
 321
 322 (defface gnus-group-news-2-face
 323   '((((class color)
 324       (background dark))
 325      (:foreground "turquoise" :bold t))
 326     (((class color)
 327       (background light))
 328      (:foreground "CadetBlue4" :bold t))
 329     (t
 330      ()))
 331   "Level 2 newsgroup face.")
 332
 333 (defface gnus-group-news-2-empty-face
 334   '((((class color)
 335       (background dark))
 336      (:foreground "turquoise"))
 337     (((class color)
 338       (background light))
 339      (:foreground "CadetBlue4"))
 340     (t
 341      ()))
 342   "Level 2 empty newsgroup face.")
 343
 344 (defface gnus-group-news-3-face
 345   '((((class color)
 346       (background dark))
 347      (:bold t))
 348     (((class color)
 349       (background light))
 350      (:bold t))
 351     (t
 352      ()))
 353   "Level 3 newsgroup face.")
 354
 355 (defface gnus-group-news-3-empty-face
 356   '((((class color)
 357       (background dark))
 358      ())
 359     (((class color)
 360       (background light))
 361      ())
 362     (t
 363      ()))
 364   "Level 3 empty newsgroup face.")
 365
 366 (defface gnus-group-news-4-face
 367   '((((class color)
 368       (background dark))
 369      (:bold t))
 370     (((class color)
 371       (background light))
 372      (:bold t))
 373     (t
 374      ()))
 375   "Level 4 newsgroup face.")
 376
 377 (defface gnus-group-news-4-empty-face
 378   '((((class color)
 379       (background dark))
 380      ())
 381     (((class color)
 382       (background light))
 383      ())
 384     (t
 385      ()))
 386   "Level 4 empty newsgroup face.")
 387
 388 (defface gnus-group-news-5-face
 389   '((((class color)
 390       (background dark))
 391      (:bold t))
 392     (((class color)
 393       (background light))
 394      (:bold t))
 395     (t
 396      ()))
 397   "Level 5 newsgroup face.")
 398
 399 (defface gnus-group-news-5-empty-face
 400   '((((class color)
 401       (background dark))
 402      ())
 403     (((class color)
 404       (background light))
 405      ())
 406     (t
 407      ()))
 408   "Level 5 empty newsgroup face.")
 409
 410 (defface gnus-group-news-6-face
 411   '((((class color)
 412       (background dark))
 413      (:bold t))
 414     (((class color)
 415       (background light))
 416      (:bold t))
 417     (t
 418      ()))
 419   "Level 6 newsgroup face.")
 420
 421 (defface gnus-group-news-6-empty-face
 422   '((((class color)
 423       (background dark))
 424      ())
 425     (((class color)
 426       (background light))
 427      ())
 428     (t
 429      ()))
 430   "Level 6 empty newsgroup face.")
 431
 432 (defface gnus-group-news-low-face
 433   '((((class color)
 434       (background dark))
 435      (:foreground "DarkTurquoise" :bold t))
 436     (((class color)
 437       (background light))
 438      (:foreground "DarkGreen" :bold t))
 439     (t
 440      ()))
 441   "Low level newsgroup face.")
 442
 443 (defface gnus-group-news-low-empty-face
 444   '((((class color)
 445       (background dark))
 446      (:foreground "DarkTurquoise"))
 447     (((class color)
 448       (background light))
 449      (:foreground "DarkGreen"))
 450     (t
 451      ()))
 452   "Low level empty newsgroup face.")
 453
 454 (defface gnus-group-mail-1-face
 455   '((((class color)
 456       (background dark))
 457      (:foreground "aquamarine1" :bold t))
 458     (((class color)
 459       (background light))
 460      (:foreground "DeepPink3" :bold t))
 461     (t
 462      (:bold t)))
 463   "Level 1 mailgroup face.")
 464
 465 (defface gnus-group-mail-1-empty-face
 466   '((((class color)
 467       (background dark))
 468      (:foreground "aquamarine1"))
 469     (((class color)
 470       (background light))
 471      (:foreground "DeepPink3"))
 472     (t
 473      (:italic t :bold t)))
 474   "Level 1 empty mailgroup face.")
 475
 476 (defface gnus-group-mail-2-face
 477   '((((class color)
 478       (background dark))
 479      (:foreground "aquamarine2" :bold t))
 480     (((class color)
 481       (background light))
 482      (:foreground "HotPink3" :bold t))
 483     (t
 484      (:bold t)))
 485   "Level 2 mailgroup face.")
 486
 487 (defface gnus-group-mail-2-empty-face
 488   '((((class color)
 489       (background dark))
 490      (:foreground "aquamarine2"))
 491     (((class color)
 492       (background light))
 493      (:foreground "HotPink3"))
 494     (t
 495      (:bold t)))
 496   "Level 2 empty mailgroup face.")
 497
 498 (defface gnus-group-mail-3-face
 499   '((((class color)
 500       (background dark))
 501      (:foreground "aquamarine3" :bold t))
 502     (((class color)
 503       (background light))
 504      (:foreground "magenta4" :bold t))
 505     (t
 506      (:bold t)))
 507   "Level 3 mailgroup face.")
 508
 509 (defface gnus-group-mail-3-empty-face
 510   '((((class color)
 511       (background dark))
 512      (:foreground "aquamarine3"))
 513     (((class color)
 514       (background light))
 515      (:foreground "magenta4"))
 516     (t
 517      ()))
 518   "Level 3 empty mailgroup face.")
 519
 520 (defface gnus-group-mail-low-face
 521   '((((class color)
 522       (background dark))
 523      (:foreground "aquamarine4" :bold t))
 524     (((class color)
 525       (background light))
 526      (:foreground "DeepPink4" :bold t))
 527     (t
 528      (:bold t)))
 529   "Low level mailgroup face.")
 530
 531 (defface gnus-group-mail-low-empty-face
 532   '((((class color)
 533       (background dark))
 534      (:foreground "aquamarine4"))
 535     (((class color)
 536       (background light))
 537      (:foreground "DeepPink4"))
 538     (t
 539      (:bold t)))
 540   "Low level empty mailgroup face.")
 541
 542 ;; Summary mode faces.
 543
 544 (defface gnus-summary-selected-face '((t
 545                                        (:underline t)))
 546   "Face used for selected articles.")
 547
 548 (defface gnus-summary-cancelled-face
 549   '((((class color))
 550      (:foreground "yellow" :background "black")))
 551   "Face used for cancelled articles.")
 552
 553 (defface gnus-summary-high-ticked-face
 554   '((((class color)
 555       (background dark))
 556      (:foreground "pink" :bold t))
 557     (((class color)
 558       (background light))
 559      (:foreground "firebrick" :bold t))
 560     (t
 561      (:bold t)))
 562   "Face used for high interest ticked articles.")
 563
 564 (defface gnus-summary-low-ticked-face
 565   '((((class color)
 566       (background dark))
 567      (:foreground "pink" :italic t))
 568     (((class color)
 569       (background light))
 570      (:foreground "firebrick" :italic t))
 571     (t
 572      (:italic t)))
 573   "Face used for low interest ticked articles.")
 574
 575 (defface gnus-summary-normal-ticked-face
 576   '((((class color)
 577       (background dark))
 578      (:foreground "pink"))
 579     (((class color)
 580       (background light))
 581      (:foreground "firebrick"))
 582     (t
 583      ()))
 584   "Face used for normal interest ticked articles.")
 585
 586 (defface gnus-summary-high-ancient-face
 587   '((((class color)
 588       (background dark))
 589      (:foreground "SkyBlue" :bold t))
 590     (((class color)
 591       (background light))
 592      (:foreground "RoyalBlue" :bold t))
 593     (t
 594      (:bold t)))
 595   "Face used for high interest ancient articles.")
 596
 597 (defface gnus-summary-low-ancient-face
 598   '((((class color)
 599       (background dark))
 600      (:foreground "SkyBlue" :italic t))
 601     (((class color)
 602       (background light))
 603      (:foreground "RoyalBlue" :italic t))
 604     (t
 605      (:italic t)))
 606   "Face used for low interest ancient articles.")
 607
 608 (defface gnus-summary-normal-ancient-face
 609   '((((class color)
 610       (background dark))
 611      (:foreground "SkyBlue"))
 612     (((class color)
 613       (background light))
 614      (:foreground "RoyalBlue"))
 615     (t
 616      ()))
 617   "Face used for normal interest ancient articles.")
 618
 619 (defface gnus-summary-high-unread-face
 620   '((t
 621      (:bold t)))
 622   "Face used for high interest unread articles.")
 623
 624 (defface gnus-summary-low-unread-face
 625   '((t
 626      (:italic t)))
 627   "Face used for low interest unread articles.")
 628
 629 (defface gnus-summary-normal-unread-face
 630   '((t
 631      ()))
 632   "Face used for normal interest unread articles.")
 633
 634 (defface gnus-summary-incorporated-face
 635   '((t
 636      ()))
 637   "Face used for incorporated articles.")
 638
 639 (defface gnus-summary-high-read-face
 640   '((((class color)
 641       (background dark))
 642      (:foreground "PaleGreen"
 643                   :bold t))
 644     (((class color)
 645       (background light))
 646      (:foreground "DarkGreen"
 647                   :bold t))
 648     (t
 649      (:bold t)))
 650   "Face used for high interest read articles.")
 651
 652 (defface gnus-summary-low-read-face
 653   '((((class color)
 654       (background dark))
 655      (:foreground "PaleGreen"
 656                   :italic t))
 657     (((class color)
 658       (background light))
 659      (:foreground "DarkGreen"
 660                   :italic t))
 661     (t
 662      (:italic t)))
 663   "Face used for low interest read articles.")
 664
 665 (defface gnus-summary-normal-read-face
 666   '((((class color)
 667       (background dark))
 668      (:foreground "PaleGreen"))
 669     (((class color)
 670       (background light))
 671      (:foreground "DarkGreen"))
 672     (t
 673      ()))
 674   "Face used for normal interest read articles.")
 675
 676
 677 ;;;
 678 ;;; Gnus buffers
 679 ;;;
 680
 681 (defvar gnus-buffers nil)
 682
 683 (defun gnus-get-buffer-create (name)
 684   "Do the same as `get-buffer-create', but store the created buffer."
 685   (or (get-buffer name)
 686       (car (push (get-buffer-create name) gnus-buffers))))
 687
 688 (defun gnus-add-buffer ()
 689   "Add the current buffer to the list of Gnus buffers."
 690   (push (current-buffer) gnus-buffers))
 691
 692 (defun gnus-buffers ()
 693   "Return a list of live Gnus buffers."
 694   (while (and gnus-buffers
 695               (not (buffer-name (car gnus-buffers))))
 696     (pop gnus-buffers))
 697   (let ((buffers gnus-buffers))
 698     (while (cdr buffers)
 699       (if (buffer-name (cadr buffers))
 700           (pop buffers)
 701         (setcdr buffers (cddr buffers)))))
 702   gnus-buffers)
 703
 704 ;;; Splash screen.
 705
 706 (defvar gnus-group-buffer "*Group*")
 707
 708 (eval-and-compile
 709   (autoload 'gnus-play-jingle "gnus-audio"))
 710
 711 (defface gnus-splash-face
 712   '((((class color)
 713       (background dark))
 714      (:foreground "Brown"))
 715     (((class color)
 716       (background light))
 717      (:foreground "Brown"))
 718     (t
 719      ()))
 720   "Face of the splash screen.")
 721
 722 (defun gnus-splash ()
 723   (save-excursion
 724     (switch-to-buffer (gnus-get-buffer-create gnus-group-buffer))
 725     (let ((buffer-read-only nil))
 726       (erase-buffer)
 727       (unless gnus-inhibit-startup-message
 728         (gnus-group-startup-message)
 729         (sit-for 0)
 730         (when gnus-play-startup-jingle
 731           (gnus-play-jingle))))))
 732
 733 (defun gnus-indent-rigidly (start end arg)
 734   "Indent rigidly using only spaces and no tabs."
 735   (save-excursion
 736     (save-restriction
 737       (narrow-to-region start end)
 738       (let ((tab-width 8))
 739         (indent-rigidly start end arg)
 740         ;; We translate tabs into spaces -- not everybody uses
 741         ;; an 8-character tab.
 742         (goto-char (point-min))
 743         (while (search-forward "\t" nil t)
 744           (replace-match "        " t t))))))
 745
 746 (defvar gnus-simple-splash nil)
 747
 748 (defun gnus-group-startup-message (&optional x y)
 749   "Insert startup message in current buffer."
 750   ;; Insert the message.
 751   (erase-buffer)
 752   (cond
 753    ((and (fboundp 'find-image)
 754          (display-graphic-p)
 755          (let ((image
 756                 (find-image
 757                  `((:type xpm :file "gnus.xpm"
 758                           :color-symbols
 759                           (("thing" . "#724214")
 760                            ("shadow" . "#1e3f03")
 761                            ("background" . ,(face-background 'default))))
 762                    (:type xbm :file "gnus.xbm"
 763                           :foreground ,(face-foreground 'gnus-splash-face)
 764                           :background ,(face-background 'default))))))
 765            (when image
 766              (insert-image image)
 767              (goto-char (point-min))
 768              (insert-char
 769               ?\ ;; space
 770               (max 0 (let ((cw (frame-char-width)))
 771                        (/ (+ (- (* (window-width) cw) 271) cw) 2 cw))))
 772              (goto-char (point-min))
 773              (insert gnus-product-name " " gnus-version-number
 774                      (if (zerop (string-to-number gnus-revision-number))
 775                          ""
 776                        (concat " (r" gnus-revision-number ")"))
 777                      " based on " gnus-original-product-name " v"
 778                      gnus-original-version-number "\n")
 779              (goto-char (point-min))
 780              (put-text-property (point) (gnus-point-at-eol)
 781                                 'face 'gnus-splash-face)
 782              (insert-char ?\ ;; space
 783                           (max 0 (/ (- (window-width) (gnus-point-at-eol)) 2)))
 784              (forward-line 1)
 785              (insert-char
 786               ?\n (max 0
 787                        (let ((ch (frame-char-height)))
 788                          (/ (+ (- (* (1- (window-height)) ch) 273) ch) 2 ch))))
 789              (setq gnus-simple-splash nil)
 790              t))))
 791    (t
 792     (insert "
 793           _    ___ _             _
 794           _ ___ __ ___  __    _ ___
 795           __   _     ___    __  ___
 796               _           ___     _
 797              _  _ __             _
 798              ___   __            _
 799                    __           _
 800                     _      _   _
 801                    _      _    _
 802                       _  _    _
 803                   __  ___
 804                  _   _ _     _
 805                 _   _
 806               _    _
 807              _    _
 808             _
 809           __
 810
 811 "
 812             )
 813     (goto-char (point-min))
 814     (insert gnus-product-name " " gnus-version-number
 815             (if (zerop (string-to-number gnus-revision-number))
 816                 ""
 817               (concat " (r" gnus-revision-number ")"))
 818             " based on " gnus-original-product-name " v"
 819             gnus-original-version-number)
 820     (goto-char (point-min))
 821     (insert-char ?\ ; space
 822                  (max 0 (/ (- (window-width) (gnus-point-at-eol)) 2)))
 823     (forward-line 1)
 824     ;; And then hack it.
 825     (gnus-indent-rigidly (point) (point-max)
 826                          (/ (max (- (window-width) (or x 46)) 0) 2))
 827     (goto-char (point-min))
 828     (forward-line 1)
 829     (let* ((pheight (count-lines (point-min) (point-max)))
 830            (wheight (window-height))
 831            (rest (- wheight pheight)))
 832       (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
 833     ;; Fontify some.
 834     (put-text-property (point-min) (point-max) 'face 'gnus-splash-face)
 835     (setq gnus-simple-splash t)))
 836   (goto-char (point-min))
 837   (setq mode-line-buffer-identification (concat " " gnus-version))
 838   (set-buffer-modified-p t))
 839
 840 (eval-when (load)
 841   (let ((command (format "%s" this-command)))
 842     (if (and (string-match "gnus" command)
 843              (not (string-match "gnus-other-frame" command)))
 844         (gnus-splash)
 845       (gnus-get-buffer-create gnus-group-buffer))))
 846
 847 ;;; Do the rest.
 848
 849 (require 'custom)
 850 (require 'gnus-util)
 851 (require 'nnheader)
 852
 853 (defcustom gnus-home-directory "~/"
 854   "Directory variable that specifies the \"home\" directory.
 855 All other Gnus path variables are initialized from this variable."
 856   :group 'gnus-files
 857   :type 'directory)
 858
 859 (defcustom gnus-directory (or (getenv "SAVEDIR")
 860                               (nnheader-concat gnus-home-directory "News/"))
 861   "*Directory variable from which all other Gnus file variables are derived.
 862
 863 Note that Gnus is mostly loaded when the `.gnus.el' file is read.
 864 This means that other directory variables that are initialized from
 865 this variable won't be set properly if you set this variable in `.gnus.el'.
 866 Set this variable in `.emacs' instead."
 867   :group 'gnus-files
 868   :type 'directory)
 869
 870 (defcustom gnus-default-directory nil
 871   "*Default directory for all Gnus buffers."
 872   :group 'gnus-files
 873   :type '(choice (const :tag "current" nil)
 874                  directory))
 875
 876 ;; Site dependent variables.  These variables should be defined in
 877 ;; paths.el.
 878
 879 (defvar gnus-default-nntp-server nil
 880   "Specify a default NNTP server.
 881 This variable should be defined in paths.el, and should never be set
 882 by the user.
 883 If you want to change servers, you should use `gnus-select-method'.
 884 See the documentation to that variable.")
 885
 886 ;; Don't touch this variable.
 887 (defvar gnus-nntp-service "nntp"
 888   "NNTP service name (\"nntp\" or 119).
 889 This is an obsolete variable, which is scarcely used.  If you use an
 890 nntp server for your newsgroup and want to change the port number
 891 used to 899, you would say something along these lines:
 892
 893  (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))")
 894
 895 (defcustom gnus-nntpserver-file "/etc/nntpserver"
 896   "A file with only the name of the nntp server in it."
 897   :group 'gnus-files
 898   :group 'gnus-server
 899   :type 'file)
 900
 901 ;; This function is used to check both the environment variable
 902 ;; NNTPSERVER and the /etc/nntpserver file to see whether one can find
 903 ;; an nntp server name default.
 904 (defun gnus-getenv-nntpserver ()
 905   (or (getenv "NNTPSERVER")
 906       (and (file-readable-p gnus-nntpserver-file)
 907            (save-excursion
 908              (set-buffer (gnus-get-buffer-create " *gnus nntp*"))
 909              (insert-file-contents gnus-nntpserver-file)
 910              (let ((name (buffer-string)))
 911                (prog1
 912                    (if (string-match "\\'[ \t\n]*$" name)
 913                        nil
 914                      name)
 915                  (kill-buffer (current-buffer))))))))
 916
 917 (defcustom gnus-select-method
 918   (condition-case nil
 919       (nconc
 920        (list 'nntp (or (condition-case nil
 921                            (gnus-getenv-nntpserver)
 922                          (error nil))
 923                        (when (and gnus-default-nntp-server
 924                                   (not (string= gnus-default-nntp-server "")))
 925                          gnus-default-nntp-server)
 926                        "news"))
 927        (if (or (null gnus-nntp-service)
 928                (equal gnus-nntp-service "nntp"))
 929            nil
 930          (list gnus-nntp-service)))
 931     (error nil))
 932   "Default method for selecting a newsgroup.
 933 This variable should be a list, where the first element is how the
 934 news is to be fetched, the second is the address.
 935
 936 For instance, if you want to get your news via NNTP from
 937 \"flab.flab.edu\", you could say:
 938
 939 \(setq gnus-select-method '(nntp \"flab.flab.edu\"))
 940
 941 If you want to use your local spool, say:
 942
 943 \(setq gnus-select-method (list 'nnspool (system-name)))
 944
 945 If you use this variable, you must set `gnus-nntp-server' to nil.
 946
 947 There is a lot more to know about select methods and virtual servers -
 948 see the manual for details."
 949   :group 'gnus-server
 950   :type 'gnus-select-method)
 951
 952 (defcustom gnus-message-archive-method
 953   `(nnfolder
 954     "archive"
 955     (nnfolder-directory ,(nnheader-concat message-directory "archive"))
 956     (nnfolder-active-file
 957      ,(nnheader-concat message-directory "archive/active"))
 958     (nnfolder-get-new-mail nil)
 959     (nnfolder-inhibit-expiry t))
 960   "*Method used for archiving messages you've sent.
 961 This should be a mail method.
 962
 963 It's probably not very effective to change this variable once you've
 964 run Gnus once.  After doing that, you must edit this server from the
 965 server buffer."
 966   :group 'gnus-server
 967   :group 'gnus-message
 968   :type 'gnus-select-method)
 969
 970 (defcustom gnus-message-archive-group nil
 971   "*Name of the group in which to save the messages you've written.
 972 This can either be a string; a list of strings; or an alist
 973 of regexps/functions/forms to be evaluated to return a string (or a list
 974 of strings).  The functions are called with the name of the current
 975 group (or nil) as a parameter.
 976
 977 If you want to save your mail in one group and the news articles you
 978 write in another group, you could say something like:
 979
 980  \(setq gnus-message-archive-group
 981         '((if (message-news-p)
 982               \"misc-news\"
 983             \"misc-mail\")))
 984
 985 Normally the group names returned by this variable should be
 986 unprefixed -- which implicitly means \"store on the archive server\".
 987 However, you may wish to store the message on some other server.  In
 988 that case, just return a fully prefixed name of the group --
 989 \"nnml+private:mail.misc\", for instance."
 990   :group 'gnus-message
 991   :type '(choice (const :tag "none" nil)
 992                  function
 993                  sexp
 994                  string))
 995
 996 (defcustom gnus-secondary-servers nil
 997   "List of NNTP servers that the user can choose between interactively.
 998 To make Gnus query you for a server, you have to give `gnus' a
 999 non-numeric prefix - `C-u M-x gnus', in short."
1000   :group 'gnus-server
1001   :type '(repeat string))
1002
1003 (defcustom gnus-nntp-server nil
1004   "*The name of the host running the NNTP server.
1005 This variable is semi-obsolete.  Use the `gnus-select-method'
1006 variable instead."
1007   :group 'gnus-server
1008   :type '(choice (const :tag "disable" nil)
1009                  string))
1010
1011 (defcustom gnus-secondary-select-methods nil
1012   "A list of secondary methods that will be used for reading news.
1013 This is a list where each element is a complete select method (see
1014 `gnus-select-method').
1015
1016 If, for instance, you want to read your mail with the nnml backend,
1017 you could set this variable:
1018
1019 \(setq gnus-secondary-select-methods '((nnml \"\")))"
1020   :group 'gnus-server
1021   :type '(repeat gnus-select-method))
1022
1023 (defvar gnus-backup-default-subscribed-newsgroups
1024   '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus")
1025   "Default default new newsgroups the first time Gnus is run.
1026 Should be set in paths.el, and shouldn't be touched by the user.")
1027
1028 (defcustom gnus-local-domain nil
1029   "Local domain name without a host name.
1030 The DOMAINNAME environment variable is used instead if it is defined.
1031 If the `system-name' function returns the full Internet name, there is
1032 no need to set this variable."
1033   :group 'gnus-message
1034   :type '(choice (const :tag "default" nil)
1035                  string))
1036
1037 (defvar gnus-local-organization nil
1038   "String with a description of what organization (if any) the user belongs to.
1039 Obsolete variable; use `message-user-organization' instead.")
1040
1041 ;; Customization variables
1042
1043 (defcustom gnus-refer-article-method nil
1044   "Preferred method for fetching an article by Message-ID.
1045 If you are reading news from the local spool (with nnspool), fetching
1046 articles by Message-ID is painfully slow.  By setting this method to an
1047 nntp method, you might get acceptable results.
1048
1049 The value of this variable must be a valid select method as discussed
1050 in the documentation of `gnus-select-method'.
1051
1052 It can also be a list of select methods, as well as the special symbol
1053 `current', which means to use the current select method.  If it is a
1054 list, Gnus will try all the methods in the list until it finds a match."
1055   :group 'gnus-server
1056   :type '(choice (const :tag "default" nil)
1057                  (const :tag "DejaNews" (nnweb "refer" (nnweb-type dejanews)))
1058                  gnus-select-method
1059                  (repeat :menu-tag "Try multiple"
1060                          :tag "Multiple"
1061                          :value (current (nnweb "refer" (nnweb-type dejanews)))
1062                          (choice :tag "Method"
1063                                  (const current)
1064                                  (const :tag "DejaNews"
1065                                         (nnweb "refer" (nnweb-type dejanews)))
1066                                  gnus-select-method))))
1067
1068 (defcustom gnus-group-faq-directory
1069   '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/"
1070     "/ftp@sunsite.auc.dk:/pub/usenet/"
1071     "/ftp@sunsite.doc.ic.ac.uk:/pub/usenet/news-faqs/"
1072     "/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/"
1073     "/ftp@ftp.seas.gwu.edu:/pub/rtfm/"
1074     "/ftp@rtfm.mit.edu:/pub/usenet/"
1075     "/ftp@ftp.uni-paderborn.de:/pub/FAQ/"
1076     "/ftp@ftp.sunet.se:/pub/usenet/"
1077     "/ftp@nctuccca.edu.tw:/USENET/FAQ/"
1078     "/ftp@hwarang.postech.ac.kr:/pub/usenet/"
1079     "/ftp@ftp.hk.super.net:/mirror/faqs/")
1080   "*Directory where the group FAQs are stored.
1081 This will most commonly be on a remote machine, and the file will be
1082 fetched by ange-ftp.
1083
1084 This variable can also be a list of directories.  In that case, the
1085 first element in the list will be used by default.  The others can
1086 be used when being prompted for a site.
1087
1088 Note that Gnus uses an aol machine as the default directory.  If this
1089 feels fundamentally unclean, just think of it as a way to finally get
1090 something of value back from them.
1091
1092 If the default site is too slow, try one of these:
1093
1094    North America: mirrors.aol.com                /pub/rtfm/usenet
1095                   ftp.seas.gwu.edu               /pub/rtfm
1096                   rtfm.mit.edu                   /pub/usenet
1097    Europe:        ftp.uni-paderborn.de           /pub/FAQ
1098                   src.doc.ic.ac.uk               /usenet/news-FAQS
1099                   ftp.sunet.se                   /pub/usenet
1100                   sunsite.auc.dk                 /pub/usenet
1101    Asia:          nctuccca.edu.tw                /USENET/FAQ
1102                   hwarang.postech.ac.kr          /pub/usenet
1103                   ftp.hk.super.net               /mirror/faqs"
1104   :group 'gnus-group-various
1105   :type '(choice directory
1106                  (repeat directory)))
1107
1108 (defcustom gnus-use-cross-reference t
1109   "*Non-nil means that cross referenced articles will be marked as read.
1110 If nil, ignore cross references.  If t, mark articles as read in
1111 subscribed newsgroups.  If neither t nor nil, mark as read in all
1112 newsgroups."
1113   :group 'gnus-server
1114   :type '(choice (const :tag "off" nil)
1115                  (const :tag "subscribed" t)
1116                  (sexp :format "all"
1117                        :value always)))
1118
1119 (defcustom gnus-process-mark ?#
1120   "*Process mark."
1121   :group 'gnus-group-visual
1122   :group 'gnus-summary-marks
1123   :type 'character)
1124
1125 (defcustom gnus-asynchronous nil
1126   "*If non-nil, Gnus will supply backends with data needed for async article fetching."
1127   :group 'gnus-asynchronous
1128   :type 'boolean)
1129
1130 (defcustom gnus-large-newsgroup 200
1131   "*The number of articles which indicates a large newsgroup.
1132 If the number of articles in a newsgroup is greater than this value,
1133 confirmation is required for selecting the newsgroup."
1134   :group 'gnus-group-select
1135   :type 'integer)
1136
1137 (defcustom gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix)))
1138   "*Non-nil means that the default name of a file to save articles in is the group name.
1139 If it's nil, the directory form of the group name is used instead.
1140
1141 If this variable is a list, and the list contains the element
1142 `not-score', long file names will not be used for score files; if it
1143 contains the element `not-save', long file names will not be used for
1144 saving; and if it contains the element `not-kill', long file names
1145 will not be used for kill files.
1146
1147 Note that the default for this variable varies according to what system
1148 type you're using.  On `usg-unix-v' and `xenix' this variable defaults
1149 to nil while on all other systems it defaults to t."
1150   :group 'gnus-start
1151   :type 'boolean)
1152
1153 (defcustom gnus-kill-files-directory gnus-directory
1154   "*Name of the directory where kill files will be stored (default \"~/News\")."
1155   :group 'gnus-score-files
1156   :group 'gnus-score-kill
1157   :type 'directory)
1158
1159 (defcustom gnus-save-score nil
1160   "*If non-nil, save group scoring info."
1161   :group 'gnus-score-various
1162   :group 'gnus-start
1163   :type 'boolean)
1164
1165 (defcustom gnus-use-undo t
1166   "*If non-nil, allow undoing in Gnus group mode buffers."
1167   :group 'gnus-meta
1168   :type 'boolean)
1169
1170 (defcustom gnus-use-adaptive-scoring nil
1171   "*If non-nil, use some adaptive scoring scheme.
1172 If a list, then the values `word' and `line' are meaningful.  The
1173 former will perform adaption on individual words in the subject
1174 header while `line' will perform adaption on several headers."
1175   :group 'gnus-meta
1176   :group 'gnus-score-adapt
1177   :type '(set (const word) (const line)))
1178
1179 (defcustom gnus-use-cache 'passive
1180   "*If nil, Gnus will ignore the article cache.
1181 If `passive', it will allow entering (and reading) articles
1182 explicitly entered into the cache.  If anything else, use the
1183 cache to the full extent of the law."
1184   :group 'gnus-meta
1185   :group 'gnus-cache
1186   :type '(choice (const :tag "off" nil)
1187                  (const :tag "passive" passive)
1188                  (const :tag "active" t)))
1189
1190 (defcustom gnus-use-trees nil
1191   "*If non-nil, display a thread tree buffer."
1192   :group 'gnus-meta
1193   :type 'boolean)
1194
1195 (defcustom gnus-use-grouplens nil
1196   "*If non-nil, use GroupLens ratings."
1197   :group 'gnus-meta
1198   :type 'boolean)
1199
1200 (defcustom gnus-keep-backlog nil
1201   "*If non-nil, Gnus will keep read articles for later re-retrieval.
1202 If it is a number N, then Gnus will only keep the last N articles
1203 read.  If it is neither nil nor a number, Gnus will keep all read
1204 articles.  This is not a good idea."
1205   :group 'gnus-meta
1206   :type '(choice (const :tag "off" nil)
1207                  integer
1208                  (sexp :format "all"
1209                        :value t)))
1210
1211 (defcustom gnus-use-nocem nil
1212   "*If non-nil, Gnus will read NoCeM cancel messages."
1213   :group 'gnus-meta
1214   :type 'boolean)
1215
1216 (defcustom gnus-suppress-duplicates nil
1217   "*If non-nil, Gnus will mark duplicate copies of the same article as read."
1218   :group 'gnus-meta
1219   :type 'boolean)
1220
1221 (defcustom gnus-use-scoring t
1222   "*If non-nil, enable scoring."
1223   :group 'gnus-meta
1224   :type 'boolean)
1225
1226 (defcustom gnus-use-picons nil
1227   "*If non-nil, display picons in a frame of their own."
1228   :group 'gnus-meta
1229   :type 'boolean)
1230
1231 (defcustom gnus-summary-prepare-exit-hook
1232   '(gnus-summary-expire-articles)
1233   "*A hook called when preparing to exit from the summary buffer.
1234 It calls `gnus-summary-expire-articles' by default."
1235   :group 'gnus-summary-exit
1236   :type 'hook)
1237
1238 (defcustom gnus-novice-user t
1239   "*Non-nil means that you are a usenet novice.
1240 If non-nil, verbose messages may be displayed and confirmations may be
1241 required."
1242   :group 'gnus-meta
1243   :type 'boolean)
1244
1245 (defcustom gnus-expert-user nil
1246   "*Non-nil means that you will never be asked for confirmation about anything.
1247 That doesn't mean *anything* anything; particularly destructive
1248 commands will still require prompting."
1249   :group 'gnus-meta
1250   :type 'boolean)
1251
1252 (defcustom gnus-interactive-catchup t
1253   "*If non-nil, require your confirmation when catching up a group."
1254   :group 'gnus-group-select
1255   :type 'boolean)
1256
1257 (defcustom gnus-interactive-exit t
1258   "*If non-nil, require your confirmation when exiting Gnus."
1259   :group 'gnus-exit
1260   :type 'boolean)
1261
1262 (defcustom gnus-extract-address-components 'gnus-extract-address-components
1263   "*Function for extracting address components from a From header.
1264 Two pre-defined function exist: `gnus-extract-address-components',
1265 which is the default, quite fast, and too simplistic solution, and
1266 `mail-extract-address-components', which works much better, but is
1267 slower."
1268   :group 'gnus-summary-format
1269   :type '(radio (function-item gnus-extract-address-components)
1270                 (function-item mail-extract-address-components)
1271                 (function-item std11-extract-address-components)
1272                 (function :tag "Other")))
1273
1274 (defcustom gnus-carpal nil
1275   "*If non-nil, display clickable icons."
1276   :group 'gnus-meta
1277   :type 'boolean)
1278
1279 (defcustom gnus-shell-command-separator ";"
1280   "String used to separate to shell commands."
1281   :group 'gnus-files
1282   :type 'string)
1283
1284 (defcustom gnus-valid-select-methods
1285   '(("nntp" post address prompt-address physical-address)
1286     ("nnspool" post address)
1287     ("nnvirtual" post-mail virtual prompt-address)
1288     ("nnmbox" mail respool address)
1289     ("nnml" mail respool address)
1290     ("nnmh" mail respool address)
1291     ("nndir" post-mail prompt-address physical-address)
1292     ("nneething" none address prompt-address physical-address)
1293     ("nndoc" none address prompt-address)
1294     ("nnbabyl" mail address respool)
1295     ("nnkiboze" post virtual)
1296     ("nnsoup" post-mail address)
1297     ("nndraft" post-mail)
1298     ("nnfolder" mail respool address)
1299     ("nngateway" post-mail address prompt-address physical-address)
1300     ("nnweb" none)
1301     ("nnslashdot" post)
1302     ("nnultimate" none)
1303     ("nnwarchive" none)
1304     ("nnlistserv" none)
1305     ("nnagent" post-mail)
1306     ("nnimap" post-mail address prompt-address physical-address))
1307   "*An alist of valid select methods.
1308 The first element of each list lists should be a string with the name
1309 of the select method.  The other elements may be the category of
1310 this method (i. e., `post', `mail', `none' or whatever) or other
1311 properties that this method has (like being respoolable).
1312 If you implement a new select method, all you should have to change is
1313 this variable.  I think."
1314   :group 'gnus-server
1315   :type '(repeat (group (string :tag "Name")
1316                         (radio-button-choice (const :format "%v " post)
1317                                              (const :format "%v " mail)
1318                                              (const :format "%v " none)
1319                                              (const post-mail))
1320                         (checklist :inline t
1321                                    (const :format "%v " address)
1322                                    (const :format "%v " prompt-address)
1323                                    (const :format "%v " physical-address)
1324                                    (const :format "%v " virtual)
1325                                    (const respool)))))
1326
1327 (defun gnus-redefine-select-method-widget ()
1328   "Recomputes the select-method widget based on the value of
1329 `gnus-valid-select-methods'."
1330   (define-widget 'gnus-select-method 'list
1331     "Widget for entering a select method."
1332     :value '(nntp "")
1333     :tag "Select Method"
1334     :args `((choice :tag "Method"
1335                     ,@(mapcar (lambda (entry)
1336                                 (list 'const :format "%v\n"
1337                                       (intern (car entry))))
1338                               gnus-valid-select-methods)
1339                     (symbol :tag "other"))
1340             (string :tag "Address")
1341             (repeat :tag "Options"
1342                     :inline t
1343                     (list :format "%v"
1344                           variable
1345                           (sexp :tag "Value"))))
1346     ))
1347
1348 (gnus-redefine-select-method-widget)
1349
1350 (defcustom gnus-updated-mode-lines '(group article summary tree)
1351   "List of buffers that should update their mode lines.
1352 The list may contain the symbols `group', `article', `tree' and
1353 `summary'.  If the corresponding symbol is present, Gnus will keep
1354 that mode line updated with information that may be pertinent.
1355 If this variable is nil, screen refresh may be quicker."
1356   :group 'gnus-various
1357   :type '(set (const group)
1358               (const article)
1359               (const summary)
1360               (const tree)))
1361
1362 ;; Added by Keinonen Kari <kk85613@cs.tut.fi>.
1363 (defcustom gnus-mode-non-string-length nil
1364   "*Max length of mode-line non-string contents.
1365 If this is nil, Gnus will take space as is needed, leaving the rest
1366 of the modeline intact.  Note that the default of nil is unlikely
1367 to be desirable; see the manual for further details."
1368   :group 'gnus-various
1369   :type '(choice (const nil)
1370                  integer))
1371
1372 (defcustom gnus-auto-expirable-newsgroups nil
1373   "*Groups in which to automatically mark read articles as expirable.
1374 If non-nil, this should be a regexp that should match all groups in
1375 which to perform auto-expiry.  This only makes sense for mail groups."
1376   :group 'nnmail-expire
1377   :type '(choice (const nil)
1378                  regexp))
1379
1380 (defcustom gnus-total-expirable-newsgroups nil
1381   "*Groups in which to perform expiry of all read articles.
1382 Use with extreme caution.  All groups that match this regexp will be
1383 expiring - which means that all read articles will be deleted after
1384 \(say) one week.         (This only goes for mail groups and the like, of
1385 course.)"
1386   :group 'nnmail-expire
1387   :type '(choice (const nil)
1388                  regexp))
1389
1390 (defcustom gnus-group-uncollapsed-levels 1
1391   "Number of group name elements to leave alone when making a short group name."
1392   :group 'gnus-group-visual
1393   :type 'integer)
1394
1395 (defcustom gnus-group-use-permanent-levels nil
1396   "*If non-nil, once you set a level, Gnus will use this level."
1397   :group 'gnus-group-levels
1398   :type 'boolean)
1399
1400 ;; Hooks.
1401
1402 (defcustom gnus-load-hook nil
1403   "A hook run while Gnus is loaded."
1404   :group 'gnus-start
1405   :type 'hook)
1406
1407 (defcustom gnus-apply-kill-hook '(gnus-apply-kill-file)
1408   "A hook called to apply kill files to a group.
1409 This hook is intended to apply a kill file to the selected newsgroup.
1410 The function `gnus-apply-kill-file' is called by default.
1411
1412 Since a general kill file is too heavy to use only for a few
1413 newsgroups, I recommend you to use a lighter hook function.  For
1414 example, if you'd like to apply a kill file to articles which contains
1415 a string `rmgroup' in subject in newsgroup `control', you can use the
1416 following hook:
1417
1418  (setq gnus-apply-kill-hook
1419       (list
1420         (lambda ()
1421           (cond ((string-match \"control\" gnus-newsgroup-name)
1422                  (gnus-kill \"Subject\" \"rmgroup\")
1423                  (gnus-expunge \"X\"))))))"
1424   :group 'gnus-score-kill
1425   :options '(gnus-apply-kill-file)
1426   :type 'hook)
1427
1428 (defcustom gnus-group-change-level-function nil
1429   "Function run when a group level is changed.
1430 It is called with three parameters -- GROUP, LEVEL and OLDLEVEL."
1431   :group 'gnus-group-levels
1432   :type 'function)
1433
1434 ;;; Face thingies.
1435
1436 (defcustom gnus-visual
1437   '(summary-highlight group-highlight article-highlight
1438                       mouse-face
1439                       summary-menu group-menu article-menu
1440                       tree-highlight menu highlight
1441                       browse-menu server-menu
1442                       page-marker tree-menu binary-menu pick-menu
1443                       grouplens-menu)
1444   "*Enable visual features.
1445 If `visual' is disabled, there will be no menus and few faces.  Most of
1446 the visual customization options below will be ignored.  Gnus will use
1447 less space and be faster as a result.
1448
1449 This variable can also be a list of visual elements to switch on.  For
1450 instance, to switch off all visual things except menus, you can say:
1451
1452    (setq gnus-visual '(menu))
1453
1454 Valid elements include `summary-highlight', `group-highlight',
1455 `article-highlight', `mouse-face', `summary-menu', `group-menu',
1456 `article-menu', `tree-highlight', `menu', `highlight', `browse-menu',
1457 `server-menu', `page-marker', `tree-menu', `binary-menu', `pick-menu',
1458 and `grouplens-menu'."
1459   :group 'gnus-meta
1460   :group 'gnus-visual
1461   :type '(set (const summary-highlight)
1462               (const group-highlight)
1463               (const article-highlight)
1464               (const mouse-face)
1465               (const summary-menu)
1466               (const group-menu)
1467               (const article-menu)
1468               (const tree-highlight)
1469               (const menu)
1470               (const highlight)
1471               (const browse-menu)
1472               (const server-menu)
1473               (const page-marker)
1474               (const tree-menu)
1475               (const binary-menu)
1476               (const pick-menu)
1477               (const grouplens-menu)))
1478
1479 (defcustom gnus-mouse-face
1480   (condition-case ()
1481       (if (gnus-visual-p 'mouse-face 'highlight)
1482           (if (boundp 'gnus-mouse-face)
1483               (or gnus-mouse-face 'highlight)
1484             'highlight)
1485         'default)
1486     (error 'highlight))
1487   "*Face used for group or summary buffer mouse highlighting.
1488 The line beneath the mouse pointer will be highlighted with this
1489 face."
1490   :group 'gnus-visual
1491   :type 'face)
1492
1493 (defcustom gnus-article-save-directory gnus-directory
1494   "*Name of the directory articles will be saved in (default \"~/News\")."
1495   :group 'gnus-article-saving
1496   :type 'directory)
1497
1498 (defvar gnus-plugged t
1499   "Whether Gnus is plugged or not.")
1500
1501 (defcustom gnus-default-charset 'iso-8859-1
1502   "Default charset assumed to be used when viewing non-ASCII characters.
1503 This variable is overridden on a group-to-group basis by the
1504 gnus-group-charset-alist variable and is only used on groups not
1505 covered by that variable."
1506   :type 'symbol
1507   :group 'gnus-charset)
1508
1509 (defcustom gnus-default-posting-charset nil
1510   "Default charset assumed to be used when posting non-ASCII characters.
1511 This variable is overridden on a group-to-group basis by the
1512 gnus-group-posting-charset-alist variable and is only used on groups not
1513 covered by that variable.
1514 If nil, no default charset is assumed when posting."
1515   :type 'symbol
1516   :group 'gnus-charset)
1517
1518 \f
1519 ;;; Internal variables
1520
1521 (defvar gnus-agent-meta-information-header "X-Gnus-Agent-Meta-Information")
1522 (defvar gnus-group-get-parameter-function 'gnus-group-get-parameter)
1523 (defvar gnus-original-article-buffer " *Original Article*")
1524 (defvar gnus-newsgroup-name nil)
1525 (defvar gnus-ephemeral-servers nil)
1526
1527 (defvar gnus-agent nil
1528   "Whether we want to use the Gnus agent or not.")
1529
1530 (defvar gnus-command-method nil
1531   "Dynamically bound variable that says what the current backend is.")
1532
1533 (defvar gnus-current-select-method nil
1534   "The current method for selecting a newsgroup.")
1535
1536 (defvar gnus-tree-buffer "*Tree*"
1537   "Buffer where Gnus thread trees are displayed.")
1538
1539 ;; Dummy variable.
1540 (defvar gnus-use-generic-from nil)
1541
1542 ;; Variable holding the user answers to all method prompts.
1543 (defvar gnus-method-history nil)
1544
1545 ;; Variable holding the user answers to all mail method prompts.
1546 (defvar gnus-mail-method-history nil)
1547
1548 ;; Variable holding the user answers to all group prompts.
1549 (defvar gnus-group-history nil)
1550
1551 (defvar gnus-server-alist nil
1552   "List of available servers.")
1553
1554 (defcustom gnus-cache-directory
1555   (nnheader-concat gnus-directory "cache/")
1556   "*The directory where cached articles will be stored."
1557   :group 'gnus-cache
1558   :type 'directory)
1559
1560 (defvar gnus-predefined-server-alist
1561   `(("cache"
1562      nnspool "cache"
1563      (nnspool-spool-directory ,gnus-cache-directory)
1564      (nnspool-nov-directory ,gnus-cache-directory)
1565      (nnspool-active-file
1566       ,(nnheader-concat gnus-cache-directory "active"))))
1567   "List of predefined (convenience) servers.")
1568
1569 (defvar gnus-topic-indentation "");; Obsolete variable.
1570
1571 (defconst gnus-article-mark-lists
1572   '((marked . tick) (replied . reply)
1573     (expirable . expire) (killed . killed)
1574     (bookmarks . bookmark) (dormant . dormant)
1575     (scored . score) (saved . save)
1576     (cached . cache) (downloadable . download)
1577     (unsendable . unsend)))
1578
1579 (defvar gnus-headers-retrieved-by nil)
1580 (defvar gnus-article-reply nil)
1581 (defvar gnus-override-method nil)
1582 (defvar gnus-article-check-size nil)
1583 (defvar gnus-opened-servers nil)
1584
1585 (defvar gnus-current-kill-article nil)
1586
1587 (defvar gnus-have-read-active-file nil)
1588
1589 (defconst gnus-maintainer
1590   "semi-gnus-ja@meadow.scphys.kyoto-u.ac.jp (T-gnus Bugfixing Girls + Boys)"
1591   "The mail address of the T-gnus maintainers.")
1592
1593 (defcustom gnus-info-filename nil
1594   "*Controls language of gnus Info.
1595 If nil and current-language-environment is Japanese, go to gnus-ja.
1596 Otherwise go to corresponding Info.
1597 This variable can be nil, gnus or gnus-ja."
1598   :group 'gnus-start
1599   :type '(choice (const nil)
1600                  (const :tag "English" gnus)
1601                  (const :tag "Japanese" gnus-ja)))
1602
1603 (defvar gnus-info-nodes
1604   '((gnus-group-mode "The Group Buffer")
1605     (gnus-summary-mode "The Summary Buffer")
1606     (gnus-article-mode "The Article Buffer")
1607     (gnus-server-mode "The Server Buffer")
1608     (gnus-browse-mode "Browse Foreign Server")
1609     (gnus-tree-mode "Tree Display"))
1610   "Alist of major modes and related Info nodes.")
1611
1612 (defvar gnus-group-buffer "*Group*")
1613 (defvar gnus-summary-buffer "*Summary*")
1614 (defvar gnus-article-buffer "*Article*")
1615 (defvar gnus-server-buffer "*Server*")
1616
1617 (defvar gnus-slave nil
1618   "Whether this Gnus is a slave or not.")
1619
1620 (defvar gnus-batch-mode nil
1621   "Whether this Gnus is running in batch mode or not.")
1622
1623 (defvar gnus-variable-list
1624   '(gnus-newsrc-options gnus-newsrc-options-n
1625                         gnus-newsrc-last-checked-date
1626                         gnus-newsrc-alist gnus-server-alist
1627                         gnus-killed-list gnus-zombie-list
1628                         gnus-topic-topology gnus-topic-alist)
1629   "Gnus variables saved in the quick startup file.")
1630
1631 (defvar gnus-product-variable-file-list
1632   (let ((version (product-version (product-find 'gnus-vers)))
1633         (codesys (static-if (boundp 'MULE) '*ctext* 'ctext)))
1634     `(("strict-cache" ((product-version ,version) (emacs-version))
1635        binary
1636        gnus-format-specs-compiled)
1637       ("cache" ((product-version ,version))
1638        ,codesys
1639        gnus-format-specs)))
1640   "Gnus variables are saved in the produce depend quick startup files.")
1641
1642 (defcustom gnus-compile-user-specs t
1643   "If non-nil, the user-defined format specs will be byte-compiled
1644 automatically.
1645 It has an effect on the values of `gnus-*-line-format-spec'."
1646   :group 'gnus
1647   :type 'boolean)
1648
1649 (defvar gnus-newsrc-alist nil
1650   "Assoc list of read articles.
1651 gnus-newsrc-hashtb should be kept so that both hold the same information.")
1652
1653 (defvar gnus-newsrc-hashtb nil
1654   "Hashtable of gnus-newsrc-alist.")
1655
1656 (defvar gnus-killed-list nil
1657   "List of killed newsgroups.")
1658
1659 (defvar gnus-killed-hashtb nil
1660   "Hash table equivalent of gnus-killed-list.")
1661
1662 (defvar gnus-zombie-list nil
1663   "List of almost dead newsgroups.")
1664
1665 (defvar gnus-description-hashtb nil
1666   "Descriptions of newsgroups.")
1667
1668 (defvar gnus-list-of-killed-groups nil
1669   "List of newsgroups that have recently been killed by the user.")
1670
1671 (defvar gnus-active-hashtb nil
1672   "Hashtable of active articles.")
1673
1674 (defvar gnus-moderated-hashtb nil
1675   "Hashtable of moderated newsgroups.")
1676
1677 ;; Save window configuration.
1678 (defvar gnus-prev-winconf nil)
1679
1680 (defvar gnus-reffed-article-number nil)
1681
1682 ;;; Let the byte-compiler know that we know about this variable.
1683 (defvar rmail-default-rmail-file)
1684
1685 (defvar gnus-dead-summary nil)
1686
1687 (defvar gnus-article-display-hook nil
1688   "Controls how the article buffer will look.  This is an obsolete variable;
1689 use the article treating faculties instead.  Is is described in Info node
1690 `Customizing Articles'.")
1691
1692 ;;; End of variables.
1693
1694 ;; Define some autoload functions Gnus might use.
1695 (eval-and-compile
1696
1697   ;; This little mapcar goes through the list below and marks the
1698   ;; symbols in question as autoloaded functions.
1699   (mapcar
1700    (lambda (package)
1701      (let ((interactive (nth 1 (memq ':interactive package))))
1702        (mapcar
1703         (lambda (function)
1704           (let (keymap)
1705             (when (consp function)
1706               (setq keymap (car (memq 'keymap function)))
1707               (setq function (car function)))
1708             (unless (fboundp function)
1709               (autoload function (car package) nil interactive keymap))))
1710         (if (eq (nth 1 package) ':interactive)
1711             (nthcdr 3 package)
1712           (cdr package)))))
1713    '(("info" :interactive t Info-goto-node)
1714      ("pp" pp pp-to-string pp-eval-expression)
1715      ("ps-print" ps-print-preprint)
1716      ("browse-url" :interactive t browse-url)
1717      ("message" :interactive t
1718       message-send-and-exit message-yank-original)
1719      ("babel" babel-as-string)
1720      ("nnmail" nnmail-split-fancy nnmail-article-group)
1721      ("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers)
1722      ("rmailout" rmail-output rmail-output-to-rmail-file)
1723      ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages
1724       rmail-show-message rmail-summary-exists
1725       rmail-select-summary rmail-update-summary)
1726      ("gnus-audio" :interactive t gnus-audio-play)
1727      ("gnus-xmas" gnus-xmas-splash)
1728      ("gnus-soup" :interactive t
1729       gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article
1730       gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet)
1731      ("nnsoup" nnsoup-pack-replies)
1732      ("score-mode" :interactive t gnus-score-mode)
1733      ("gnus-mh" gnus-summary-save-article-folder
1734       gnus-Folder-save-name gnus-folder-save-name)
1735      ("gnus-mh" :interactive t gnus-summary-save-in-folder)
1736      ("gnus-demon" gnus-demon-add-nocem gnus-demon-add-scanmail
1737       gnus-demon-add-rescan gnus-demon-add-scan-timestamps
1738       gnus-demon-add-disconnection gnus-demon-add-handler
1739       gnus-demon-remove-handler)
1740      ("gnus-demon" :interactive t
1741       gnus-demon-init gnus-demon-cancel)
1742      ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree
1743       gnus-tree-open gnus-tree-close gnus-carpal-setup-buffer)
1744      ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close
1745       gnus-nocem-unwanted-article-p)
1746      ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info
1747       gnus-server-server-name)
1748      ("gnus-srvr" gnus-browse-foreign-server)
1749      ("gnus-cite" :interactive t
1750       gnus-article-highlight-citation gnus-article-hide-citation-maybe
1751       gnus-article-hide-citation gnus-article-fill-cited-article
1752       gnus-article-hide-citation-in-followups)
1753      ("gnus-kill" gnus-kill gnus-apply-kill-file-internal
1754       gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author
1755       gnus-execute gnus-expunge gnus-batch-kill gnus-batch-score)
1756      ("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers
1757       gnus-cache-possibly-remove-articles gnus-cache-request-article
1758       gnus-cache-retrieve-headers gnus-cache-possibly-alter-active
1759       gnus-cache-enter-remove-article gnus-cached-article-p
1760       gnus-cache-open gnus-cache-close gnus-cache-update-article
1761       gnus-cache-articles-in-group)
1762      ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article
1763       gnus-cache-remove-article gnus-summary-insert-cached-articles)
1764      ("gnus-score" :interactive t
1765       gnus-summary-increase-score gnus-summary-set-score
1766       gnus-summary-raise-thread gnus-summary-raise-same-subject
1767       gnus-summary-raise-score gnus-summary-raise-same-subject-and-select
1768       gnus-summary-lower-thread gnus-summary-lower-same-subject
1769       gnus-summary-lower-score gnus-summary-lower-same-subject-and-select
1770       gnus-summary-current-score gnus-score-delta-default
1771       gnus-score-flush-cache gnus-score-close
1772       gnus-possibly-score-headers gnus-score-followup-article
1773       gnus-score-followup-thread)
1774      ("gnus-score"
1775       (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers
1776       gnus-current-score-file-nondirectory gnus-score-adaptive
1777       gnus-score-find-trace gnus-score-file-name)
1778      ("gnus-cus" :interactive t gnus-custom-mode gnus-group-customize
1779       gnus-score-customize)
1780      ("gnus-topic" :interactive t gnus-topic-mode)
1781      ("gnus-topic" gnus-topic-remove-group gnus-topic-set-parameters
1782       gnus-subscribe-topics)
1783      ("gnus-salt" :interactive t gnus-pick-mode gnus-binary-mode)
1784      ("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap))
1785      ("gnus-uu" :interactive t
1786       gnus-uu-digest-mail-forward gnus-uu-digest-post-forward
1787       gnus-uu-mark-series gnus-uu-mark-region gnus-uu-mark-buffer
1788       gnus-uu-mark-by-regexp gnus-uu-mark-all
1789       gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu
1790       gnus-uu-decode-uu-and-save gnus-uu-decode-unshar
1791       gnus-uu-decode-unshar-and-save gnus-uu-decode-save
1792       gnus-uu-decode-binhex gnus-uu-decode-uu-view
1793       gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view
1794       gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view
1795       gnus-uu-decode-binhex-view gnus-uu-unmark-thread
1796       gnus-uu-mark-over gnus-uu-post-news)
1797      ("gnus-uu" gnus-uu-delete-work-dir gnus-quote-arg-for-sh-or-csh
1798       gnus-uu-unmark-thread)
1799      ("gnus-msg" (gnus-summary-send-map keymap)
1800       gnus-article-mail gnus-copy-article-buffer gnus-following-method)
1801      ("gnus-msg" :interactive t
1802       gnus-group-post-news gnus-group-mail gnus-summary-post-news
1803       gnus-summary-followup gnus-summary-followup-with-original
1804       gnus-summary-cancel-article gnus-summary-supersede-article
1805       gnus-post-news gnus-summary-reply gnus-summary-reply-with-original
1806       gnus-summary-mail-forward gnus-summary-mail-other-window
1807       gnus-summary-resend-message gnus-summary-resend-bounced-mail
1808       gnus-summary-wide-reply gnus-summary-followup-to-mail
1809       gnus-summary-followup-to-mail-with-original gnus-bug
1810       gnus-summary-wide-reply-with-original
1811       gnus-summary-post-forward gnus-summary-wide-reply-with-original
1812       gnus-summary-post-forward)
1813      ("gnus-picon" :interactive t gnus-article-display-picons
1814       gnus-group-display-picons)
1815      ("gnus-picon" gnus-picons-buffer-name)
1816      ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p
1817       gnus-grouplens-mode)
1818      ("smiley" :interactive t gnus-smiley-display)
1819      ("smiley" smiley-toggle-buffer)
1820      ("gnus-win" gnus-configure-windows gnus-add-configuration)
1821      ("gnus-sum" gnus-summary-insert-line gnus-summary-read-group
1822       gnus-list-of-unread-articles gnus-list-of-read-articles
1823       gnus-offer-save-summaries gnus-make-thread-indent-array
1824       gnus-summary-exit gnus-update-read-articles gnus-summary-last-subject
1825       gnus-summary-skip-intangible gnus-summary-article-number
1826       gnus-data-header gnus-data-find gnus-summary-jump-to-other-group)
1827      ("gnus-group" gnus-group-insert-group-line gnus-group-quit
1828       gnus-group-list-groups gnus-group-first-unread-group
1829       gnus-group-set-mode-line gnus-group-set-info gnus-group-save-newsrc
1830       gnus-group-setup-buffer gnus-group-get-new-news
1831       gnus-group-make-help-group gnus-group-update-group
1832       gnus-group-iterate gnus-group-group-name)
1833      ("gnus-bcklg" gnus-backlog-request-article gnus-backlog-enter-article
1834       gnus-backlog-remove-article)
1835      ("gnus-art" gnus-article-read-summary-keys gnus-article-save
1836       gnus-article-prepare gnus-article-set-window-start
1837       gnus-article-next-page gnus-article-prev-page
1838       gnus-request-article-this-buffer gnus-article-mode
1839       gnus-article-setup-buffer gnus-narrow-to-page
1840       gnus-article-delete-invisible-text gnus-treat-article)
1841      ("gnus-art" :interactive t
1842       gnus-article-hide-headers gnus-article-hide-boring-headers
1843       gnus-article-treat-overstrike
1844       gnus-article-remove-cr gnus-article-remove-trailing-blank-lines
1845       gnus-article-display-x-face
1846       gnus-article-decode-HZ
1847       gnus-article-wash-html
1848       gnus-article-hide-pgp
1849       gnus-article-hide-pem gnus-article-hide-signature
1850       gnus-article-strip-leading-blank-lines gnus-article-date-local
1851       gnus-article-date-original gnus-article-date-lapsed
1852       gnus-article-show-all-headers gnus-article-show-all
1853       gnus-article-edit-mode gnus-article-edit-article
1854       gnus-article-edit-done article-decode-encoded-words
1855       gnus-start-date-timer gnus-stop-date-timer
1856       gnus-article-toggle-headers)
1857      ("gnus-int" gnus-request-type)
1858      ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1
1859       gnus-dribble-enter gnus-read-init-file gnus-dribble-touch)
1860      ("gnus-dup" gnus-dup-suppress-articles gnus-dup-unsuppress-article
1861       gnus-dup-enter-articles)
1862      ("gnus-range" gnus-copy-sequence)
1863      ("gnus-eform" gnus-edit-form)
1864      ("gnus-move" :interactive t
1865       gnus-group-move-group-to-server gnus-change-server)
1866      ("gnus-logic" gnus-score-advanced)
1867      ("gnus-undo" gnus-undo-mode gnus-undo-register)
1868      ("gnus-async" gnus-async-request-fetched-article gnus-async-prefetch-next
1869       gnus-async-prefetch-article gnus-async-prefetch-remove-group
1870       gnus-async-halt-prefetch)
1871      ("gnus-offline"
1872       gnus-offline-setup)
1873      ("gnus-offline" :interactive t
1874       gnus-offline-toggle-plugged
1875       gnus-offline-set-unplugged-state
1876       gnus-offline-toggle-auto-hangup
1877       gnus-offline-toggle-on/off-send-mail
1878       gnus-offline-toggle-articles-to-fetch
1879       gnus-offline-set-interval-time
1880       gnus-offline-agent-expire)
1881      ("miee" :interactive t gnspool-get-news
1882       mail-spool-send news-spool-post)
1883      ("international/mw32misc" define-process-argument-editing
1884       general-process-argument-editing-function)
1885      ("gnus-agent" gnus-open-agent gnus-agent-get-function
1886       gnus-agent-save-groups gnus-agent-save-active gnus-agent-method-p
1887       gnus-agent-get-undownloaded-list gnus-agent-fetch-session
1888       gnus-summary-set-agent-mark gnus-agent-save-group-info)
1889      ("gnus-agent" :interactive t
1890       gnus-unplugged gnus-agentize gnus-agent-batch)
1891      ("gnus-vm" :interactive t gnus-summary-save-in-vm
1892       gnus-summary-save-article-vm)
1893      ("gnus-draft" :interactive t gnus-draft-mode gnus-group-send-drafts)
1894      ("gnus-mlspl" gnus-group-split gnus-group-split-fancy)
1895      ("gnus-mlspl" :interactive t gnus-group-split-setup
1896       gnus-group-split-update))))
1897
1898 (eval-and-compile
1899   (unless (featurep 'xemacs)
1900     (autoload 'gnus-smiley-display "gnus-bitmap" nil t)
1901     (autoload 'smiley-toggle-buffer "gnus-bitmap")
1902     (autoload 'x-face-mule-gnus-article-display-x-face "x-face-mule")))
1903
1904 ;;; gnus-sum.el thingies
1905
1906
1907 (defcustom gnus-summary-line-format "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n"
1908   "*The format specification of the lines in the summary buffer.
1909
1910 It works along the same lines as a normal formatting string,
1911 with some simple extensions.
1912
1913 %N   Article number, left padded with spaces (string)
1914 %S   Subject (string)
1915 %s   Subject if it is at the root of a thread, and \"\" otherwise (string)
1916 %n   Name of the poster (string)
1917 %a   Extracted name of the poster (string)
1918 %A   Extracted address of the poster (string)
1919 %F   Contents of the From: header (string)
1920 %f   Contents of the From: or To: headers (string)
1921 %x   Contents of the Xref: header (string)
1922 %D   Date of the article (string)
1923 %d   Date of the article (string) in DD-MMM format
1924 %M   Message-id of the article (string)
1925 %r   References of the article (string)
1926 %c   Number of characters in the article (integer)
1927 %L   Number of lines in the article (integer)
1928 %I   Indentation based on thread level (a string of spaces)
1929 %T   A string with two possible values: 80 spaces if the article
1930      is on thread level two or larger and 0 spaces on level one
1931 %R   \"A\" if this article has been replied to, \" \" otherwise (character)
1932 %U   Status of this article (character, \"R\", \"K\", \"-\" or \" \")
1933 %[   Opening bracket (character, \"[\" or \"<\")
1934 %]   Closing bracket (character, \"]\" or \">\")
1935 %>   Spaces of length thread-level (string)
1936 %<   Spaces of length (- 20 thread-level) (string)
1937 %i   Article score (number)
1938 %z   Article zcore (character)
1939 %t   Number of articles under the current thread (number).
1940 %e   Whether the thread is empty or not (character).
1941 %l   GroupLens score (string).
1942 %V   Total thread score (number).
1943 %P   The line number (number).
1944 %O   Download mark (character).
1945 %u   User defined specifier.  The next character in the format string should
1946      be a letter.  Gnus will call the function gnus-user-format-function-X,
1947      where X is the letter following %u.  The function will be passed the
1948      current header as argument.  The function should return a string, which
1949      will be inserted into the summary just like information from any other
1950      summary specifier.
1951
1952 Text between %( and %) will be highlighted with `gnus-mouse-face'
1953 when the mouse point is placed inside the area.  There can only be one
1954 such area.
1955
1956 The %U (status), %R (replied) and %z (zcore) specs have to be handled
1957 with care.  For reasons of efficiency, Gnus will compute what column
1958 these characters will end up in, and \"hard-code\" that.  This means that
1959 it is invalid to have these specs after a variable-length spec.  Well,
1960 you might not be arrested, but your summary buffer will look strange,
1961 which is bad enough.
1962
1963 The smart choice is to have these specs as for to the left as
1964 possible.
1965
1966 This restriction may disappear in later versions of Gnus."
1967   :type 'string
1968   :group 'gnus-summary-format)
1969
1970 ;;;
1971 ;;; Skeleton keymaps
1972 ;;;
1973
1974 (defun gnus-suppress-keymap (keymap)
1975   (suppress-keymap keymap)
1976   (let ((keys `([backspace] [delete] "\177" "\M-u"))) ;gnus-mouse-2
1977     (while keys
1978       (define-key keymap (pop keys) 'undefined))))
1979
1980 (defvar gnus-article-mode-map
1981   (let ((keymap (make-sparse-keymap)))
1982     (gnus-suppress-keymap keymap)
1983     keymap))
1984 (defvar gnus-summary-mode-map
1985   (let ((keymap (make-keymap)))
1986     (gnus-suppress-keymap keymap)
1987     keymap))
1988 (defvar gnus-group-mode-map
1989   (let ((keymap (make-keymap)))
1990     (gnus-suppress-keymap keymap)
1991     keymap))
1992
1993 \f
1994
1995 ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
1996 ;; If you want the cursor to go somewhere else, set these two
1997 ;; functions in some startup hook to whatever you want.
1998 (defalias 'gnus-summary-position-point 'gnus-goto-colon)
1999 (defalias 'gnus-group-position-point 'gnus-goto-colon)
2000
2001 ;;; Various macros and substs.
2002
2003 (defun gnus-header-from (header)
2004   (mail-header-from header))
2005
2006 (defmacro gnus-gethash (string hashtable)
2007   "Get hash value of STRING in HASHTABLE."
2008   `(symbol-value (intern-soft ,string ,hashtable)))
2009
2010 (defmacro gnus-sethash (string value hashtable)
2011   "Set hash value.  Arguments are STRING, VALUE, and HASHTABLE."
2012   `(set (intern ,string ,hashtable) ,value))
2013 (put 'gnus-sethash 'edebug-form-spec '(form form form))
2014
2015 (defmacro gnus-group-unread (group)
2016   "Get the currently computed number of unread articles in GROUP."
2017   `(car (gnus-gethash ,group gnus-newsrc-hashtb)))
2018
2019 (defmacro gnus-group-entry (group)
2020   "Get the newsrc entry for GROUP."
2021   `(gnus-gethash ,group gnus-newsrc-hashtb))
2022
2023 (defmacro gnus-active (group)
2024   "Get active info on GROUP."
2025   `(gnus-gethash ,group gnus-active-hashtb))
2026
2027 (defmacro gnus-set-active (group active)
2028   "Set GROUP's active info."
2029   `(gnus-sethash ,group ,active gnus-active-hashtb))
2030
2031 ;; Info access macros.
2032
2033 (defmacro gnus-info-group (info)
2034   `(nth 0 ,info))
2035 (defmacro gnus-info-rank (info)
2036   `(nth 1 ,info))
2037 (defmacro gnus-info-read (info)
2038   `(nth 2 ,info))
2039 (defmacro gnus-info-marks (info)
2040   `(nth 3 ,info))
2041 (defmacro gnus-info-method (info)
2042   `(nth 4 ,info))
2043 (defmacro gnus-info-params (info)
2044   `(nth 5 ,info))
2045
2046 (defmacro gnus-info-level (info)
2047   `(let ((rank (gnus-info-rank ,info)))
2048      (if (consp rank)
2049          (car rank)
2050        rank)))
2051 (defmacro gnus-info-score (info)
2052   `(let ((rank (gnus-info-rank ,info)))
2053      (or (and (consp rank) (cdr rank)) 0)))
2054
2055 (defmacro gnus-info-set-group (info group)
2056   `(setcar ,info ,group))
2057 (defmacro gnus-info-set-rank (info rank)
2058   `(setcar (nthcdr 1 ,info) ,rank))
2059 (defmacro gnus-info-set-read (info read)
2060   `(setcar (nthcdr 2 ,info) ,read))
2061 (defmacro gnus-info-set-marks (info marks &optional extend)
2062   (if extend
2063       `(gnus-info-set-entry ,info ,marks 3)
2064     `(setcar (nthcdr 3 ,info) ,marks)))
2065 (defmacro gnus-info-set-method (info method &optional extend)
2066   (if extend
2067       `(gnus-info-set-entry ,info ,method 4)
2068     `(setcar (nthcdr 4 ,info) ,method)))
2069 (defmacro gnus-info-set-params (info params &optional extend)
2070   (if extend
2071       `(gnus-info-set-entry ,info ,params 5)
2072     `(setcar (nthcdr 5 ,info) ,params)))
2073
2074 (defun gnus-info-set-entry (info entry number)
2075   ;; Extend the info until we have enough elements.
2076   (while (<= (length info) number)
2077     (nconc info (list nil)))
2078   ;; Set the entry.
2079   (setcar (nthcdr number info) entry))
2080
2081 (defmacro gnus-info-set-level (info level)
2082   `(let ((rank (cdr ,info)))
2083      (if (consp (car rank))
2084          (setcar (car rank) ,level)
2085        (setcar rank ,level))))
2086 (defmacro gnus-info-set-score (info score)
2087   `(let ((rank (cdr ,info)))
2088      (if (consp (car rank))
2089          (setcdr (car rank) ,score)
2090        (setcar rank (cons (car rank) ,score)))))
2091
2092 (defmacro gnus-get-info (group)
2093   `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb)))
2094
2095 ;; Byte-compiler warning.
2096 (defvar gnus-visual)
2097 ;; Find out whether the gnus-visual TYPE is wanted.
2098 (defun gnus-visual-p (&optional type class)
2099   (and gnus-visual                      ; Has to be non-nil, at least.
2100        (if (not type)                   ; We don't care about type.
2101            gnus-visual
2102          (if (listp gnus-visual)        ; It's a list, so we check it.
2103              (or (memq type gnus-visual)
2104                  (memq class gnus-visual))
2105            t))))
2106
2107 ;;; Load the compatability functions.
2108
2109 (require 'gnus-ems)
2110
2111 \f
2112 ;;;
2113 ;;; Shutdown
2114 ;;;
2115
2116 (defvar gnus-shutdown-alist nil)
2117
2118 (defun gnus-add-shutdown (function &rest symbols)
2119   "Run FUNCTION whenever one of SYMBOLS is shut down."
2120   (push (cons function symbols) gnus-shutdown-alist))
2121
2122 (defun gnus-shutdown (symbol)
2123   "Shut down everything that waits for SYMBOL."
2124   (let ((alist gnus-shutdown-alist)
2125         entry)
2126     (while (setq entry (pop alist))
2127       (when (memq symbol (cdr entry))
2128         (funcall (car entry))))))
2129
2130 \f
2131 ;;;
2132 ;;; Gnus Utility Functions
2133 ;;;
2134
2135
2136 (defmacro gnus-string-or (&rest strings)
2137   "Return the first element of STRINGS that is a non-blank string.
2138 STRINGS will be evaluated in normal `or' order."
2139   `(gnus-string-or-1 ',strings))
2140
2141 (defun gnus-string-or-1 (strings)
2142   (let (string)
2143     (while strings
2144       (setq string (eval (pop strings)))
2145       (if (string-match "^[ \t]*$" string)
2146           (setq string nil)
2147         (setq strings nil)))
2148     string))
2149
2150 (defun gnus-info-find-node ()
2151   "Find Info documentation of Gnus."
2152   (interactive)
2153   ;; Enlarge info window if needed.
2154   (let (gnus-info-buffer)
2155     (Info-goto-node
2156      (format "(%s)%s"
2157              (or gnus-info-filename
2158                  (get-language-info current-language-environment 'gnus-info)
2159                  "gnus")
2160              (cadr (assq major-mode gnus-info-nodes))))
2161     (setq gnus-info-buffer (current-buffer))
2162     (gnus-configure-windows 'info)))
2163
2164 ;;;
2165 ;;; gnus-interactive
2166 ;;;
2167
2168 (defvar gnus-current-prefix-symbol nil
2169   "Current prefix symbol.")
2170
2171 (defvar gnus-current-prefix-symbols nil
2172   "List of current prefix symbols.")
2173
2174 (defun gnus-interactive (string &optional params)
2175   "Return a list that can be fed to `interactive'.
2176 See `interactive' for full documentation.
2177
2178 Adds the following specs:
2179
2180 y -- The current symbolic prefix.
2181 Y -- A list of the current symbolic prefix(es).
2182 A -- Article number.
2183 H -- Article header.
2184 g -- Group name."
2185   (let ((i 0)
2186         out c prompt)
2187     (while (< i (length string))
2188       (string-match ".\\([^\n]*\\)\n?" string i)
2189       (setq c (aref string i))
2190       (when (match-end 1)
2191         (setq prompt (match-string 1 string)))
2192       (setq i (match-end 0))
2193       ;; We basically emulate just about everything that
2194       ;; `interactive' does, but add the specs listed above.
2195       (push
2196        (cond
2197         ((= c ?a)
2198          (completing-read prompt obarray 'fboundp t))
2199         ((= c ?b)
2200          (read-buffer prompt (current-buffer) t))
2201         ((= c ?B)
2202          (read-buffer prompt (other-buffer (current-buffer))))
2203         ((= c ?c)
2204          (read-char))
2205         ((= c ?C)
2206          (completing-read prompt obarray 'commandp t))
2207         ((= c ?d)
2208          (point))
2209         ((= c ?D)
2210          (read-file-name prompt nil default-directory 'lambda))
2211         ((= c ?f)
2212          (read-file-name prompt nil nil 'lambda))
2213         ((= c ?F)
2214          (read-file-name prompt))
2215         ((= c ?k)
2216          (read-key-sequence prompt))
2217         ((= c ?K)
2218          (error "Not implemented spec"))
2219         ((= c ?e)
2220          (error "Not implemented spec"))
2221         ((= c ?m)
2222          (mark))
2223         ((= c ?N)
2224          (error "Not implemented spec"))
2225         ((= c ?n)
2226          (string-to-number (read-from-minibuffer prompt)))
2227         ((= c ?p)
2228          (prefix-numeric-value current-prefix-arg))
2229         ((= c ?P)
2230          current-prefix-arg)
2231         ((= c ?r)
2232          'gnus-prefix-nil)
2233         ((= c ?s)
2234          (read-string prompt))
2235         ((= c ?S)
2236          (intern (read-string prompt)))
2237         ((= c ?v)
2238          (read-variable prompt))
2239         ((= c ?x)
2240          (read-minibuffer prompt))
2241         ((= c ?x)
2242          (eval-minibuffer prompt))
2243         ;; And here the new specs come.
2244         ((= c ?y)
2245          gnus-current-prefix-symbol)
2246         ((= c ?Y)
2247          gnus-current-prefix-symbols)
2248         ((= c ?g)
2249          (gnus-group-group-name))
2250         ((= c ?A)
2251          (gnus-summary-skip-intangible)
2252          (or (get-text-property (point) 'gnus-number)
2253              (gnus-summary-last-subject)))
2254         ((= c ?H)
2255          (gnus-data-header (gnus-data-find (gnus-summary-article-number))))
2256         (t
2257          (error "Non-implemented spec")))
2258        out)
2259       (cond
2260        ((= c ?r)
2261         (push (if (< (point) (mark) (point) (mark))) out)
2262         (push (if (> (point) (mark) (point) (mark))) out))))
2263     (setq out (delq 'gnus-prefix-nil out))
2264     (nreverse out)))
2265
2266 (defun gnus-symbolic-argument (&optional arg)
2267   "Read a symbolic argument and a command, and then execute command."
2268   (interactive "P")
2269   (let* ((in-command (this-command-keys))
2270          (command in-command)
2271          gnus-current-prefix-symbols
2272          gnus-current-prefix-symbol
2273          syms)
2274     (while (equal in-command command)
2275       (message "%s-" (key-description (this-command-keys)))
2276       (push (intern (char-to-string (read-char))) syms)
2277       (setq command (read-key-sequence nil t)))
2278     (setq gnus-current-prefix-symbols (nreverse syms)
2279           gnus-current-prefix-symbol (car gnus-current-prefix-symbols))
2280     (call-interactively (key-binding command t))))
2281
2282 ;;; More various functions.
2283
2284 (defsubst gnus-check-backend-function (func group)
2285   "Check whether GROUP supports function FUNC.
2286 GROUP can either be a string (a group name) or a select method."
2287   (ignore-errors
2288     (let ((method (if (stringp group)
2289                       (car (gnus-find-method-for-group group))
2290                     group)))
2291       (unless (featurep method)
2292         (require method))
2293       (fboundp (intern (format "%s-%s" method func))))))
2294
2295 (defun gnus-group-read-only-p (&optional group)
2296   "Check whether GROUP supports editing or not.
2297 If GROUP is nil, `gnus-newsgroup-name' will be checked instead.  Note
2298 that that variable is buffer-local to the summary buffers."
2299   (let ((group (or group gnus-newsgroup-name)))
2300     (not (gnus-check-backend-function 'request-replace-article group))))
2301
2302 (defun gnus-group-total-expirable-p (group)
2303   "Check whether GROUP is total-expirable or not."
2304   (let ((params (gnus-group-find-parameter group))
2305         val)
2306     (cond
2307      ((memq 'total-expire params)
2308       t)
2309      ((setq val (assq 'total-expire params)) ; (auto-expire . t)
2310       (cdr val))
2311      (gnus-total-expirable-newsgroups   ; Check var.
2312       (string-match gnus-total-expirable-newsgroups group)))))
2313
2314 (defun gnus-group-auto-expirable-p (group)
2315   "Check whether GROUP is auto-expirable or not."
2316   (let ((params (gnus-group-find-parameter group))
2317         val)
2318     (cond
2319      ((memq 'auto-expire params)
2320       t)
2321      ((setq val (assq 'auto-expire params)) ; (auto-expire . t)
2322       (cdr val))
2323      (gnus-auto-expirable-newsgroups    ; Check var.
2324       (string-match gnus-auto-expirable-newsgroups group)))))
2325
2326 (defun gnus-virtual-group-p (group)
2327   "Say whether GROUP is virtual or not."
2328   (memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group)))
2329                         gnus-valid-select-methods)))
2330
2331 (defun gnus-news-group-p (group &optional article)
2332   "Return non-nil if GROUP (and ARTICLE) come from a news server."
2333   (or (gnus-member-of-valid 'post group) ; Ordinary news group.
2334       (and (gnus-member-of-valid 'post-mail group) ; Combined group.
2335            (if (or (null article)
2336                    (not (< article 0)))
2337                (eq (gnus-request-type group article) 'news)
2338              (if (not (vectorp article))
2339                  nil
2340                ;; It's a real article.
2341                (eq (gnus-request-type group (mail-header-id article))
2342                    'news))))))
2343
2344 ;; Returns a list of writable groups.
2345 (defun gnus-writable-groups ()
2346   (let ((alist gnus-newsrc-alist)
2347         groups group)
2348     (while (setq group (car (pop alist)))
2349       (unless (gnus-group-read-only-p group)
2350         (push group groups)))
2351     (nreverse groups)))
2352
2353 ;; Check whether to use long file names.
2354 (defun gnus-use-long-file-name (symbol)
2355   ;; The variable has to be set...
2356   (and gnus-use-long-file-name
2357        ;; If it isn't a list, then we return t.
2358        (or (not (listp gnus-use-long-file-name))
2359            ;; If it is a list, and the list contains `symbol', we
2360            ;; return nil.
2361            (not (memq symbol gnus-use-long-file-name)))))
2362
2363 ;; Generate a unique new group name.
2364 (defun gnus-generate-new-group-name (leaf)
2365   (let ((name leaf)
2366         (num 0))
2367     (while (gnus-gethash name gnus-newsrc-hashtb)
2368       (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">")))
2369     name))
2370
2371 (defun gnus-ephemeral-group-p (group)
2372   "Say whether GROUP is ephemeral or not."
2373   (gnus-group-get-parameter group 'quit-config t))
2374
2375 (defun gnus-group-quit-config (group)
2376   "Return the quit-config of GROUP."
2377   (gnus-group-get-parameter group 'quit-config t))
2378
2379 (defun gnus-kill-ephemeral-group (group)
2380   "Remove ephemeral GROUP from relevant structures."
2381   (gnus-sethash group nil gnus-newsrc-hashtb))
2382
2383 (defun gnus-simplify-mode-line ()
2384   "Make mode lines a bit simpler."
2385   (setq mode-line-modified (cdr gnus-mode-line-modified))
2386   (when (listp mode-line-format)
2387     (make-local-variable 'mode-line-format)
2388     (setq mode-line-format (copy-sequence mode-line-format))
2389     (when (equal (nth 3 mode-line-format) "   ")
2390       (setcar (nthcdr 3 mode-line-format) " "))))
2391
2392 ;;; Servers and groups.
2393
2394 (defsubst gnus-server-add-address (method)
2395   (let ((method-name (symbol-name (car method))))
2396     (if (and (memq 'address (assoc method-name gnus-valid-select-methods))
2397              (not (assq (intern (concat method-name "-address")) method))
2398              (memq 'physical-address (assq (car method)
2399                                            gnus-valid-select-methods)))
2400         (append method (list (list (intern (concat method-name "-address"))
2401                                    (nth 1 method))))
2402       method)))
2403
2404 (defsubst gnus-server-get-method (group method)
2405   ;; Input either a server name, and extended server name, or a
2406   ;; select method, and return a select method.
2407   (cond ((stringp method)
2408          (gnus-server-to-method method))
2409         ((equal method gnus-select-method)
2410          gnus-select-method)
2411         ((and (stringp (car method))
2412               group)
2413          (gnus-server-extend-method group method))
2414         ((and method
2415               (not group)
2416               (equal (cadr method) ""))
2417          method)
2418         (t
2419          (gnus-server-add-address method))))
2420
2421 (defun gnus-server-to-method (server)
2422   "Map virtual server names to select methods."
2423   (or
2424    ;; Is this a method, perhaps?
2425    (and server (listp server) server)
2426    ;; Perhaps this is the native server?
2427    (and (equal server "native") gnus-select-method)
2428    ;; It should be in the server alist.
2429    (cdr (assoc server gnus-server-alist))
2430    ;; It could be in the predefined server alist.
2431    (cdr (assoc server gnus-predefined-server-alist))
2432    ;; If not, we look through all the opened server
2433    ;; to see whether we can find it there.
2434    (let ((opened gnus-opened-servers))
2435      (while (and opened
2436                  (not (equal server (format "%s:%s" (caaar opened)
2437                                             (cadaar opened)))))
2438        (pop opened))
2439      (caar opened))
2440    ;; It could be a named method, search all servers
2441    (let ((servers gnus-secondary-select-methods))
2442      (while (and servers
2443                  (not (equal server (format "%s:%s" (caar servers)
2444                                             (cadar servers)))))
2445        (pop servers))
2446      (car servers))))
2447
2448 (defmacro gnus-method-equal (ss1 ss2)
2449   "Say whether two servers are equal."
2450   `(let ((s1 ,ss1)
2451          (s2 ,ss2))
2452      (or (equal s1 s2)
2453          (and (= (length s1) (length s2))
2454               (progn
2455                 (while (and s1 (member (car s1) s2))
2456                   (setq s1 (cdr s1)))
2457                 (null s1))))))
2458
2459 (defun gnus-methods-equal-p (m1 m2)
2460   (let ((m1 (or m1 gnus-select-method))
2461         (m2 (or m2 gnus-select-method)))
2462     (or (equal m1 m2)
2463         (and (eq (car m1) (car m2))
2464              (or (not (memq 'address (assoc (symbol-name (car m1))
2465                                             gnus-valid-select-methods)))
2466                  (equal (nth 1 m1) (nth 1 m2)))))))
2467
2468 (defun gnus-server-equal (m1 m2)
2469   "Say whether two methods are equal."
2470   (let ((m1 (cond ((null m1) gnus-select-method)
2471                   ((stringp m1) (gnus-server-to-method m1))
2472                   (t m1)))
2473         (m2 (cond ((null m2) gnus-select-method)
2474                   ((stringp m2) (gnus-server-to-method m2))
2475                   (t m2))))
2476     (gnus-method-equal m1 m2)))
2477
2478 (defun gnus-servers-using-backend (backend)
2479   "Return a list of known servers using BACKEND."
2480   (let ((opened gnus-opened-servers)
2481         out)
2482     (while opened
2483       (when (eq backend (caaar opened))
2484         (push (caar opened) out))
2485       (pop opened))
2486     out))
2487
2488 (defun gnus-archive-server-wanted-p ()
2489   "Say whether the user wants to use the archive server."
2490   (cond
2491    ((or (not gnus-message-archive-method)
2492         (not gnus-message-archive-group))
2493     nil)
2494    ((and gnus-message-archive-method gnus-message-archive-group)
2495     t)
2496    (t
2497     (let ((active (cadr (assq 'nnfolder-active-file
2498                               gnus-message-archive-method))))
2499       (and active
2500            (file-exists-p active))))))
2501
2502 (defun gnus-group-prefixed-name (group method)
2503   "Return the whole name from GROUP and METHOD."
2504   (and (stringp method) (setq method (gnus-server-to-method method)))
2505   (if (or (not method)
2506           (gnus-server-equal method "native"))
2507       group
2508     (concat (format "%s" (car method))
2509             (when (and
2510                    (or (assoc (format "%s" (car method))
2511                               (gnus-methods-using 'address))
2512                        (gnus-server-equal method gnus-message-archive-method))
2513                    (nth 1 method)
2514                    (not (string= (nth 1 method) "")))
2515               (concat "+" (nth 1 method)))
2516             ":" group)))
2517
2518 (defun gnus-group-real-prefix (group)
2519   "Return the prefix of the current group name."
2520   (if (string-match "^[^:]+:" group)
2521       (substring group 0 (match-end 0))
2522     ""))
2523
2524 (defun gnus-group-method (group)
2525   "Return the server or method used for selecting GROUP.
2526 You should probably use `gnus-find-method-for-group' instead."
2527   (let ((prefix (gnus-group-real-prefix group)))
2528     (if (equal prefix "")
2529         gnus-select-method
2530       (let ((servers gnus-opened-servers)
2531             (server "")
2532             backend possible found)
2533         (if (string-match "^[^\\+]+\\+" prefix)
2534             (setq backend (intern (substring prefix 0 (1- (match-end 0))))
2535                   server (substring prefix (match-end 0) (1- (length prefix))))
2536           (setq backend (intern (substring prefix 0 (1- (length prefix))))))
2537         (while servers
2538           (when (eq (caaar servers) backend)
2539             (setq possible (caar servers))
2540             (when (equal (cadaar servers) server)
2541               (setq found (caar servers))))
2542           (pop servers))
2543         (or (car (rassoc found gnus-server-alist))
2544             found
2545             (car (rassoc possible gnus-server-alist))
2546             possible
2547             (list backend server))))))
2548
2549 (defsubst gnus-native-method-p (method)
2550   "Return whether METHOD is the native select method."
2551   (gnus-method-equal method gnus-select-method))
2552
2553 (defsubst gnus-secondary-method-p (method)
2554   "Return whether METHOD is a secondary select method."
2555   (let ((methods gnus-secondary-select-methods)
2556         (gmethod (gnus-server-get-method nil method)))
2557     (while (and methods
2558                 (not (gnus-method-equal
2559                       (gnus-server-get-method nil (car methods))
2560                       gmethod)))
2561       (setq methods (cdr methods)))
2562     methods))
2563
2564 (defun gnus-method-simplify (method)
2565   "Return the shortest uniquely identifying string or method for METHOD."
2566   (cond ((stringp method)
2567          method)
2568         ((gnus-native-method-p method)
2569          nil)
2570         ((gnus-secondary-method-p method)
2571          (format "%s:%s" (nth 0 method) (nth 1 method)))
2572         (t
2573          method)))
2574
2575 (defun gnus-groups-from-server (server)
2576   "Return a list of all groups that are fetched from SERVER."
2577   (let ((alist (cdr gnus-newsrc-alist))
2578         info groups)
2579     (while (setq info (pop alist))
2580       (when (gnus-server-equal (gnus-info-method info) server)
2581         (push (gnus-info-group info) groups)))
2582     (sort groups 'string<)))
2583
2584 (defun gnus-group-foreign-p (group)
2585   "Say whether a group is foreign or not."
2586   (and (not (gnus-group-native-p group))
2587        (not (gnus-group-secondary-p group))))
2588
2589 (defun gnus-group-native-p (group)
2590   "Say whether the group is native or not."
2591   (not (string-match ":" group)))
2592
2593 (defun gnus-group-secondary-p (group)
2594   "Say whether the group is secondary or not."
2595   (gnus-secondary-method-p (gnus-find-method-for-group group)))
2596
2597 (defun gnus-group-find-parameter (group &optional symbol allow-list)
2598   "Return the group parameters for GROUP.
2599 If SYMBOL, return the value of that symbol in the group parameters."
2600   (save-excursion
2601     (set-buffer gnus-group-buffer)
2602     (let ((parameters (funcall gnus-group-get-parameter-function group)))
2603       (if symbol
2604           (gnus-group-parameter-value parameters symbol allow-list)
2605         parameters))))
2606
2607 (defun gnus-group-get-parameter (group &optional symbol allow-list)
2608   "Return the group parameters for GROUP.
2609 If SYMBOL, return the value of that symbol in the group parameters.
2610 Most functions should use `gnus-group-find-parameter', which
2611 also examines the topic parameters."
2612   (let ((params (gnus-info-params (gnus-get-info group))))
2613     (if symbol
2614         (gnus-group-parameter-value params symbol allow-list)
2615       params)))
2616
2617 (defun gnus-group-parameter-value (params symbol &optional allow-list)
2618   "Return the value of SYMBOL in group PARAMS."
2619   ;; We only wish to return group parameters (dotted lists) and
2620   ;; not local variables, which may have the same names.
2621   ;; But first we handle single elements...
2622   (or (car (memq symbol params))
2623       ;; Handle alist.
2624       (let (elem)
2625         (catch 'found
2626           (while (setq elem (pop params))
2627             (when (and (consp elem)
2628                        (eq (car elem) symbol)
2629                        (or allow-list
2630                            (atom (cdr elem))))
2631               (throw 'found (cdr elem))))))))
2632
2633 (defun gnus-group-add-parameter (group param)
2634   "Add parameter PARAM to GROUP."
2635   (let ((info (gnus-get-info group)))
2636     (when info
2637       (gnus-group-remove-parameter group (if (consp param) (car param) param))
2638       ;; Cons the new param to the old one and update.
2639       (gnus-group-set-info (cons param (gnus-info-params info))
2640                            group 'params))))
2641
2642 (defun gnus-group-set-parameter (group name value)
2643   "Set parameter NAME to VALUE in GROUP."
2644   (let ((info (gnus-get-info group)))
2645     (when info
2646       (gnus-group-remove-parameter group name)
2647       (let ((old-params (gnus-info-params info))
2648             (new-params (list (cons name value))))
2649         (while old-params
2650           (when (or (not (listp (car old-params)))
2651                     (not (eq (caar old-params) name)))
2652             (setq new-params (append new-params (list (car old-params)))))
2653           (setq old-params (cdr old-params)))
2654         (gnus-group-set-info new-params group 'params)))))
2655
2656 (defun gnus-group-remove-parameter (group name)
2657   "Remove parameter NAME from GROUP."
2658   (let ((info (gnus-get-info group)))
2659     (when info
2660       (let ((params (gnus-info-params info)))
2661         (when params
2662           (setq params (delq name params))
2663           (while (assq name params)
2664             (gnus-pull name params))
2665           (gnus-info-set-params info params))))))
2666
2667 (defun gnus-group-add-score (group &optional score)
2668   "Add SCORE to the GROUP score.
2669 If SCORE is nil, add 1 to the score of GROUP."
2670   (let ((info (gnus-get-info group)))
2671     (when info
2672       (gnus-info-set-score info (+ (gnus-info-score info) (or score 1))))))
2673
2674 (defun gnus-short-group-name (group &optional levels)
2675   "Collapse GROUP name LEVELS.
2676 Select methods are stripped and any remote host name is stripped down to
2677 just the host name."
2678   (let* ((name "")
2679          (foreign "")
2680          (depth 0)
2681          (skip 1)
2682          (levels (or levels
2683                      gnus-group-uncollapsed-levels
2684                      (progn
2685                        (while (string-match "\\." group skip)
2686                          (setq skip (match-end 0)
2687                                depth (+ depth 1)))
2688                        depth))))
2689     ;; Separate foreign select method from group name and collapse.
2690     ;; If method contains a server, collapse to non-domain server name,
2691     ;; otherwise collapse to select method.
2692     (let* ((colon (string-match ":" group))
2693            (server (and colon (substring group 0 colon)))
2694            (plus (and server (string-match "+" server))))
2695       (when server
2696         (if plus
2697             (setq foreign (substring server (+ 1 plus)
2698                                      (string-match "\\." server))
2699                   group (substring group (+ 1 colon)))
2700           (setq foreign server
2701                 group (substring group (+ 1 colon))))
2702         (setq foreign (concat foreign ":")))
2703       ;; Collapse group name leaving LEVELS uncollapsed elements
2704       (let* ((glist (split-string group "\\."))
2705              (glen (length glist))
2706              res)
2707         (setq levels (- glen levels))
2708         (dolist (g glist)
2709           (push (if (>= (decf levels) 0)
2710                     (if (zerop (length g))
2711                         ""
2712                       (substring g 0 1))
2713                   g)
2714                 res))
2715         (concat foreign (mapconcat 'identity (nreverse res) "."))))))
2716
2717 (defun gnus-narrow-to-body ()
2718   "Narrow to the body of an article."
2719   (narrow-to-region
2720    (progn
2721      (goto-char (point-min))
2722      (or (search-forward "\n\n" nil t)
2723          (point-max)))
2724    (point-max)))
2725
2726 \f
2727 ;;;
2728 ;;; Kill file handling.
2729 ;;;
2730
2731 (defun gnus-apply-kill-file ()
2732   "Apply a kill file to the current newsgroup.
2733 Returns the number of articles marked as read."
2734   (if (or (file-exists-p (gnus-newsgroup-kill-file nil))
2735           (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)))
2736       (gnus-apply-kill-file-internal)
2737     0))
2738
2739 (defun gnus-kill-save-kill-buffer ()
2740   (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name)))
2741     (when (get-file-buffer file)
2742       (save-excursion
2743         (set-buffer (get-file-buffer file))
2744         (when (buffer-modified-p)
2745           (save-buffer))
2746         (kill-buffer (current-buffer))))))
2747
2748 (defcustom gnus-kill-file-name "KILL"
2749   "Suffix of the kill files."
2750   :group 'gnus-score-kill
2751   :group 'gnus-score-files
2752   :type 'string)
2753
2754 (defun gnus-newsgroup-kill-file (newsgroup)
2755   "Return the name of a kill file name for NEWSGROUP.
2756 If NEWSGROUP is nil, return the global kill file name instead."
2757   (cond
2758    ;; The global KILL file is placed at top of the directory.
2759    ((or (null newsgroup)
2760         (string-equal newsgroup ""))
2761     (expand-file-name gnus-kill-file-name
2762                       gnus-kill-files-directory))
2763    ;; Append ".KILL" to newsgroup name.
2764    ((gnus-use-long-file-name 'not-kill)
2765     (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup)
2766                               "." gnus-kill-file-name)
2767                       gnus-kill-files-directory))
2768    ;; Place "KILL" under the hierarchical directory.
2769    (t
2770     (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
2771                               "/" gnus-kill-file-name)
2772                       gnus-kill-files-directory))))
2773
2774 ;;; Server things.
2775
2776 (defun gnus-member-of-valid (symbol group)
2777   "Find out if GROUP has SYMBOL as part of its \"valid\" spec."
2778   (memq symbol (assoc
2779                 (symbol-name (car (gnus-find-method-for-group group)))
2780                 gnus-valid-select-methods)))
2781
2782 (defun gnus-method-option-p (method option)
2783   "Return non-nil if select METHOD has OPTION as a parameter."
2784   (when (stringp method)
2785     (setq method (gnus-server-to-method method)))
2786   (memq option (assoc (format "%s" (car method))
2787                       gnus-valid-select-methods)))
2788
2789 (defun gnus-similar-server-opened (method)
2790   (let ((opened gnus-opened-servers))
2791     (while (and method opened)
2792       (when (and (equal (cadr method) (cadaar opened))
2793                  (equal (car method) (caaar opened))
2794                  (not (equal method (caar opened))))
2795         (setq method nil))
2796       (pop opened))
2797     (not method)))
2798
2799 (defun gnus-server-extend-method (group method)
2800   ;; This function "extends" a virtual server.  If the server is
2801   ;; "hello", and the select method is ("hello" (my-var "something"))
2802   ;; in the group "alt.alt", this will result in a new virtual server
2803   ;; called "hello+alt.alt".
2804   (if (or (not (inline (gnus-similar-server-opened method)))
2805           (not (cddr method)))
2806       method
2807     `(,(car method) ,(concat (cadr method) "+" group)
2808       (,(intern (format "%s-address" (car method))) ,(cadr method))
2809       ,@(cddr method))))
2810
2811 (defun gnus-server-status (method)
2812   "Return the status of METHOD."
2813   (nth 1 (assoc method gnus-opened-servers)))
2814
2815 (defun gnus-group-name-to-method (group)
2816   "Guess a select method based on GROUP."
2817   (if (string-match ":" group)
2818       (let ((server (substring group 0 (match-beginning 0))))
2819         (if (string-match "\\+" server)
2820             (list (intern (substring server 0 (match-beginning 0)))
2821                   (substring server (match-end 0)))
2822           (list (intern server) "")))
2823     gnus-select-method))
2824
2825 (defun gnus-find-method-for-group (group &optional info)
2826   "Find the select method that GROUP uses."
2827   (or gnus-override-method
2828       (and (not group)
2829            gnus-select-method)
2830       (and (not (gnus-group-entry group));; a new group
2831            (gnus-group-name-to-method group))
2832       (let ((info (or info (gnus-get-info group)))
2833             method)
2834         (if (or (not info)
2835                 (not (setq method (gnus-info-method info)))
2836                 (equal method "native"))
2837             gnus-select-method
2838           (setq method
2839                 (cond ((stringp method)
2840                        (inline (gnus-server-to-method method)))
2841                       ((stringp (cadr method))
2842                        (inline (gnus-server-extend-method group method)))
2843                       (t
2844                        method)))
2845           (cond ((equal (cadr method) "")
2846                  method)
2847                 ((null (cadr method))
2848                  (list (car method) ""))
2849                 (t
2850                  (gnus-server-add-address method)))))))
2851
2852 (defun gnus-methods-using (feature)
2853   "Find all methods that have FEATURE."
2854   (let ((valids gnus-valid-select-methods)
2855         outs)
2856     (while valids
2857       (when (memq feature (car valids))
2858         (push (car valids) outs))
2859       (setq valids (cdr valids)))
2860     outs))
2861
2862 (defun gnus-read-group (prompt &optional default)
2863   "Prompt the user for a group name.
2864 Disallow invalid group names."
2865   (let ((prefix "")
2866         group)
2867     (while (not group)
2868       (when (string-match
2869              "[: `'\"/]\\|^$"
2870              (setq group (read-string (concat prefix prompt)
2871                                       (cons (or default "") 0)
2872                                       'gnus-group-history)))
2873         (setq prefix (format "Invalid group name: \"%s\".  " group)
2874               group nil)))
2875     group))
2876
2877 (defun gnus-read-method (prompt)
2878   "Prompt the user for a method.
2879 Allow completion over sensible values."
2880   (let* ((servers
2881           (append gnus-valid-select-methods
2882                   (mapcar (lambda (i) (list (format "%s:%s" (caar i)
2883                                                     (cadar i))))
2884                           gnus-opened-servers)
2885                   gnus-predefined-server-alist
2886                   gnus-server-alist))
2887          (method
2888           (completing-read
2889            prompt servers
2890            nil t nil 'gnus-method-history)))
2891     (cond
2892      ((equal method "")
2893       (setq method gnus-select-method))
2894      ((assoc method gnus-valid-select-methods)
2895       (let ((address (if (memq 'prompt-address
2896                                (assoc method gnus-valid-select-methods))
2897                          (read-string "Address: ")
2898                        "")))
2899         (or (let ((opened gnus-opened-servers))
2900               (while (and opened
2901                           (not (equal (format "%s:%s" method address)
2902                                       (format "%s:%s" (caaar opened)
2903                                               (cadaar opened)))))
2904                 (pop opened))
2905               (caar opened))
2906             (list (intern method) address))))
2907      ((assoc method servers)
2908       method)
2909      (t
2910       (list (intern method) "")))))
2911
2912 ;;; User-level commands.
2913
2914 ;;;###autoload
2915 (defun gnus-slave-no-server (&optional arg)
2916   "Read network news as a slave, without connecting to local server."
2917   (interactive "P")
2918   (gnus-no-server arg t))
2919
2920 ;;;###autoload
2921 (defun gnus-no-server (&optional arg slave)
2922   "Read network news.
2923 If ARG is a positive number, Gnus will use that as the
2924 startup level.  If ARG is nil, Gnus will be started at level 2.
2925 If ARG is non-nil and not a positive number, Gnus will
2926 prompt the user for the name of an NNTP server to use.
2927 As opposed to `gnus', this command will not connect to the local server."
2928   (interactive "P")
2929   (gnus-no-server-1 arg slave))
2930
2931 ;;;###autoload
2932 (defun gnus-slave (&optional arg)
2933   "Read news as a slave."
2934   (interactive "P")
2935   (gnus arg nil 'slave))
2936
2937 (defcustom gnus-frame-properties nil
2938   "The properties of the frame in which gnus is displayed. Under XEmacs,
2939 the variable `toolbar-news-frame-plist' will be refered instead."
2940   :type '(repeat (cons :format "%v"
2941                        (symbol :tag "Parameter")
2942                        (sexp :tag "Value")))
2943   :group 'gnus)
2944
2945 (defvar gnus-frame nil
2946   "The frame in which gnus is displayed. It is not used under XEmacs.")
2947
2948 ;;;###autoload
2949 (defun gnus-other-frame (&optional arg)
2950   "Pop up a frame to read news."
2951   (interactive "P")
2952   (static-if (featurep 'xemacs)
2953       (let ((toolbar-news-use-separate-frame t))
2954         (toolbar-gnus))
2955     (if (frame-live-p gnus-frame)
2956         (raise-frame gnus-frame)
2957       (setq gnus-frame (make-frame gnus-frame-properties))
2958       (if (and (gnus-buffer-live-p gnus-group-buffer)
2959                (save-current-buffer
2960                  (set-buffer gnus-group-buffer)
2961                  (eq 'gnus-group-mode major-mode)))
2962           (progn
2963             (select-frame gnus-frame)
2964             (switch-to-buffer gnus-group-buffer))
2965         (add-hook 'gnus-exit-gnus-hook
2966                   (lambda ()
2967                     (when (and (frame-live-p gnus-frame)
2968                                (cdr (frame-list)))
2969                       (delete-frame gnus-frame))
2970                     (setq gnus-frame nil)))
2971         (select-frame gnus-frame)
2972         (gnus arg)))))
2973
2974 ;;;###autoload
2975 (defun gnus (&optional arg dont-connect slave)
2976   "Read network news.
2977 If ARG is non-nil and a positive number, Gnus will use that as the
2978 startup level.  If ARG is non-nil and not a positive number, Gnus will
2979 prompt the user for the name of an NNTP server to use."
2980   (interactive "P")
2981   (gnus-1 arg dont-connect slave))
2982
2983 ;; Allow redefinition of Gnus functions.
2984
2985 (gnus-ems-redefine)
2986
2987 (product-provide (provide 'gnus) 'gnus-vers)
2988
2989 ;;; gnus.el ends here