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

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