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

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