cgit.sxemacs.org Git - gnus/blob - lisp/gnus.el

   1 ;;; gnus.el --- a newsreader for GNU Emacs
   2 ;; Copyright (C) 1987,88,89,90,93,94,95,96 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
   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 (require 'custom)
  32
  33 (defgroup gnus nil
  34   "The coffee-brewing, all singing, all dancing, kitchen sink newsreader."
  35   :group 'emacs)
  36
  37 (defgroup gnus-start nil
  38   "Starting your favorite newsreader."
  39   :group 'gnus)
  40
  41 (defgroup gnus-score nil
  42   "Score and kill file handling."
  43   :group 'gnus )
  44
  45 (defconst gnus-version-number "0.69"
  46   "Version number for this version of Gnus.")
  47
  48 (defconst gnus-version (format "Red Gnus v%s" gnus-version-number)
  49   "Version string for this version of Gnus.")
  50
  51 (defcustom gnus-inhibit-startup-message nil
  52   "If non-nil, the startup message will not be displayed.
  53 This variable is used before `.gnus.el' is loaded, so it should
  54 be set in `.emacs' instead."
  55   :group 'gnus-start
  56   :type 'boolean)
  57
  58 (defcustom gnus-play-startup-jingle nil
  59   "If non-nil, play the Gnus jingle at startup."
  60   :group 'gnus-start
  61   :type 'boolean)
  62
  63 ;;; Kludges to help the transition from the old `custom.el'.
  64
  65 ;; XEmacs and Emacs 19.29 facep does different things.
  66 (defalias 'custom-facep
  67   (cond ((fboundp 'find-face)
  68          'find-face)
  69         ((fboundp 'facep)
  70          'facep)
  71         (t
  72          'ignore)))
  73
  74 (unless (featurep 'gnus-xmas)
  75   (defalias 'gnus-make-overlay 'make-overlay)
  76   (defalias 'gnus-overlay-put 'overlay-put)
  77   (defalias 'gnus-move-overlay 'move-overlay)
  78   (defalias 'gnus-overlay-end 'overlay-end)
  79   (defalias 'gnus-extent-detached-p 'ignore)
  80   (defalias 'gnus-extent-start-open 'ignore)
  81   (defalias 'gnus-set-text-properties 'set-text-properties)
  82   (defalias 'gnus-group-remove-excess-properties 'ignore)
  83   (defalias 'gnus-topic-remove-excess-properties 'ignore)
  84   (defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window)
  85   (defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names)
  86   (defalias 'gnus-make-local-hook 'make-local-hook)
  87   (defalias 'gnus-add-hook 'add-hook)
  88   (defalias 'gnus-character-to-event 'identity)
  89   (defalias 'gnus-add-text-properties 'add-text-properties)
  90   (defalias 'gnus-put-text-property 'put-text-property)
  91   (defalias 'gnus-mode-line-buffer-identification 'identity)
  92   (defalias 'gnus-key-press-event-p 'numberp))
  93
  94 ;; The XEmacs people think this is evil, so it must go.
  95 (defun custom-face-lookup (&optional fg bg stipple bold italic underline)
  96   "Lookup or create a face with specified attributes."
  97   (let ((name (intern (format "custom-face-%s-%s-%s-%S-%S-%S"
  98                               (or fg "default")
  99                               (or bg "default")
 100                               (or stipple "default")
 101                               bold italic underline))))
 102     (if (and (custom-facep name)
 103              (fboundp 'make-face))
 104         ()
 105       (copy-face 'default name)
 106       (when (and fg
 107                  (not (string-equal fg "default")))
 108         (ignore-errors
 109           (set-face-foreground name fg)))
 110       (when (and bg
 111                  (not (string-equal bg "default")))
 112         (ignore-errors
 113           (set-face-background name bg)))
 114       (when (and stipple
 115                  (not (string-equal stipple "default"))
 116                  (not (eq stipple 'custom:asis))
 117                  (fboundp 'set-face-stipple))
 118         (set-face-stipple name stipple))
 119       (when (and bold
 120                  (not (eq bold 'custom:asis)))
 121         (ignore-errors
 122           (make-face-bold name)))
 123       (when (and italic
 124                  (not (eq italic 'custom:asis)))
 125         (ignore-errors
 126           (make-face-italic name)))
 127       (when (and underline
 128                  (not (eq underline 'custom:asis)))
 129         (ignore-errors
 130           (set-face-underline-p name t))))
 131     name))
 132
 133 ;;; Internal variables
 134
 135 (defvar gnus-group-buffer "*Group*")
 136
 137 (eval-and-compile
 138   (autoload 'gnus-play-jingle "gnus-audio"))
 139
 140 ;;; Splash screen.
 141
 142 (defface gnus-splash-face
 143   '((((class color)
 144       (background dark))
 145      (:foreground "red"))
 146     (((class color)
 147       (background light))
 148      (:foreground "red"))
 149     (t
 150      ()))
 151   "Level 1 newsgroup face.")
 152
 153 (defun gnus-splash ()
 154   (save-excursion
 155     (switch-to-buffer gnus-group-buffer)
 156     (let ((buffer-read-only nil))
 157       (erase-buffer)
 158       (unless gnus-inhibit-startup-message
 159         (gnus-group-startup-message)
 160         (sit-for 0)
 161         (when gnus-play-startup-jingle
 162           (gnus-play-jingle))))))
 163
 164 (defun gnus-indent-rigidly (start end arg)
 165   "Indent rigidly using only spaces and no tabs."
 166   (save-excursion
 167     (save-restriction
 168       (narrow-to-region start end)
 169       (indent-rigidly start end arg)
 170       ;; We translate tabs into spaces -- not everybody uses
 171       ;; an 8-character tab.
 172       (goto-char (point-min))
 173       (while (search-forward "\t" nil t)
 174         (replace-match "        " t t)))))
 175
 176 (defvar gnus-simple-splash nil)
 177
 178 (defun gnus-group-startup-message (&optional x y)
 179   "Insert startup message in current buffer."
 180   ;; Insert the message.
 181   (erase-buffer)
 182   (insert
 183    (format "              %s
 184           _    ___ _             _
 185           _ ___ __ ___  __    _ ___
 186           __   _     ___    __  ___
 187               _           ___     _
 188              _  _ __             _
 189              ___   __            _
 190                    __           _
 191                     _      _   _
 192                    _      _    _
 193                       _  _    _
 194                   __  ___
 195                  _   _ _     _
 196                 _   _
 197               _    _
 198              _    _
 199             _
 200           __
 201
 202 "
 203            ""))
 204   ;; And then hack it.
 205   (gnus-indent-rigidly (point-min) (point-max)
 206                        (/ (max (- (window-width) (or x 46)) 0) 2))
 207   (goto-char (point-min))
 208   (forward-line 1)
 209   (let* ((pheight (count-lines (point-min) (point-max)))
 210          (wheight (window-height))
 211          (rest (- wheight pheight)))
 212     (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
 213   ;; Fontify some.
 214   (put-text-property (point-min) (point-max) 'face 'gnus-splash-face)
 215   (goto-char (point-min))
 216   (setq mode-line-buffer-identification gnus-version)
 217   (setq gnus-simple-splash t)
 218   (set-buffer-modified-p t))
 219
 220 (eval-when (load)
 221   (let ((command (format "%s" this-command)))
 222     (when (and (string-match "gnus" command)
 223                (not (string-match "gnus-other-frame" command)))
 224       (gnus-splash))))
 225
 226 ;;; Do the rest.
 227
 228 (require 'custom)
 229 (require 'gnus-util)
 230 (require 'nnheader)
 231
 232 (defgroup gnus-meta nil
 233   "Meta variables controling major portions of Gnus.
 234 In general, modifying these variables does not take affect until Gnus
 235 is restarted, and sometimes reloaded."
 236   :group 'gnus)
 237
 238 (defcustom gnus-directory (or (getenv "SAVEDIR") "~/News/")
 239   "Directory variable from which all other Gnus file variables are derived."
 240   :group 'gnus-meta
 241   :type 'directory)
 242
 243 (defcustom gnus-default-directory nil
 244   "*Default directory for all Gnus buffers."
 245   :group 'gnus-start
 246   :type '(choice (const :tag "current" nil)
 247                  directory))
 248
 249 ;; Site dependent variables.  These variables should be defined in
 250 ;; paths.el.
 251
 252 (defvar gnus-default-nntp-server nil
 253   "Specify a default NNTP server.
 254 This variable should be defined in paths.el, and should never be set
 255 by the user.
 256 If you want to change servers, you should use `gnus-select-method'.
 257 See the documentation to that variable.")
 258
 259 ;; Don't touch this variable.
 260 (defvar gnus-nntp-service "nntp"
 261   "NNTP service name (\"nntp\" or 119).
 262 This is an obsolete variable, which is scarcely used.  If you use an
 263 nntp server for your newsgroup and want to change the port number
 264 used to 899, you would say something along these lines:
 265
 266  (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))")
 267
 268 (defcustom gnus-nntpserver-file "/etc/nntpserver"
 269   "A file with only the name of the nntp server in it."
 270   :group 'gnus-start
 271   :type 'file)
 272
 273 ;; This function is used to check both the environment variable
 274 ;; NNTPSERVER and the /etc/nntpserver file to see whether one can find
 275 ;; an nntp server name default.
 276 (defun gnus-getenv-nntpserver ()
 277   (or (getenv "NNTPSERVER")
 278       (and (file-readable-p gnus-nntpserver-file)
 279            (save-excursion
 280              (set-buffer (get-buffer-create " *gnus nntp*"))
 281              (buffer-disable-undo (current-buffer))
 282              (insert-file-contents gnus-nntpserver-file)
 283              (let ((name (buffer-string)))
 284                (prog1
 285                    (if (string-match "^[ \t\n]*$" name)
 286                        nil
 287                      name)
 288                  (kill-buffer (current-buffer))))))))
 289
 290 (defcustom gnus-select-method
 291   (ignore-errors
 292     (nconc
 293      (list 'nntp (or (ignore-errors
 294                        (gnus-getenv-nntpserver))
 295                      (when (and gnus-default-nntp-server
 296                                 (not (string= gnus-default-nntp-server "")))
 297                        gnus-default-nntp-server)
 298                      (system-name)))
 299      (if (or (null gnus-nntp-service)
 300              (equal gnus-nntp-service "nntp"))
 301          nil
 302        (list gnus-nntp-service))))
 303   "Default method for selecting a newsgroup.
 304 This variable should be a list, where the first element is how the
 305 news is to be fetched, the second is the address.
 306
 307 For instance, if you want to get your news via NNTP from
 308 \"flab.flab.edu\", you could say:
 309
 310 \(setq gnus-select-method '(nntp \"flab.flab.edu\"))
 311
 312 If you want to use your local spool, say:
 313
 314 \(setq gnus-select-method (list 'nnspool (system-name)))
 315
 316 If you use this variable, you must set `gnus-nntp-server' to nil.
 317
 318 There is a lot more to know about select methods and virtual servers -
 319 see the manual for details."
 320   :group 'gnus-start
 321   :type 'gnus-select-method)
 322
 323 (defcustom gnus-message-archive-method
 324   `(nnfolder
 325     "archive"
 326     (nnfolder-directory ,(nnheader-concat message-directory "archive"))
 327     (nnfolder-active-file
 328      ,(nnheader-concat message-directory "archive/active"))
 329     (nnfolder-get-new-mail nil)
 330     (nnfolder-inhibit-expiry t))
 331   "Method used for archiving messages you've sent.
 332 This should be a mail method.
 333
 334 It's probably not a very effective to change this variable once you've
 335 run Gnus once.  After doing that, you must edit this server from the
 336 server buffer."
 337   :group 'gnus-start
 338   :type 'gnus-select-method)
 339
 340 (defgroup gnus-message '((message custom-group))
 341   "Interface from gnus to message mode."
 342   :group 'gnus)
 343
 344 (defcustom gnus-message-archive-group nil
 345   "*Name of the group in which to save the messages you've written.
 346 This can either be a string, a list of strings; or an alist
 347 of regexps/functions/forms to be evaluated to return a string (or a list
 348 of strings).  The functions are called with the name of the current
 349 group (or nil) as a parameter.
 350
 351 If you want to save your mail in one group and the news articles you
 352 write in another group, you could say something like:
 353
 354  \(setq gnus-message-archive-group
 355         '((if (message-news-p)
 356               \"misc-news\"
 357             \"misc-mail\")))
 358
 359 Normally the group names returned by this variable should be
 360 unprefixed -- which implicitly means \"store on the archive server\".
 361 However, you may wish to store the message on some other server.  In
 362 that case, just return a fully prefixed name of the group --
 363 \"nnml+private:mail.misc\", for instance."
 364   :group 'gnus-message
 365   :type '(choice (const :tag "none" nil)
 366                  string))
 367
 368 (defcustom gnus-secondary-servers nil
 369   "List of NNTP servers that the user can choose between interactively.
 370 To make Gnus query you for a server, you have to give `gnus' a
 371 non-numeric prefix - `C-u M-x gnus', in short."
 372   :group 'gnus-start
 373   :type '(repeat string))
 374
 375 (defcustom gnus-nntp-server nil
 376   "*The name of the host running the NNTP server.
 377 This variable is semi-obsolete.  Use the `gnus-select-method'
 378 variable instead."
 379   :group 'gnus-start
 380   :type '(choice (const :tag "disable" nil)
 381                  string))
 382
 383 (defcustom gnus-secondary-select-methods nil
 384   "A list of secondary methods that will be used for reading news.
 385 This is a list where each element is a complete select method (see
 386 `gnus-select-method').
 387
 388 If, for instance, you want to read your mail with the nnml backend,
 389 you could set this variable:
 390
 391 \(setq gnus-secondary-select-methods '((nnml \"\")))"
 392 :group 'gnus-start
 393 :type '(repeat gnus-select-method))
 394
 395 (defvar gnus-backup-default-subscribed-newsgroups
 396   '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus")
 397   "Default default new newsgroups the first time Gnus is run.
 398 Should be set in paths.el, and shouldn't be touched by the user.")
 399
 400 (defcustom gnus-local-domain nil
 401   "Local domain name without a host name.
 402 The DOMAINNAME environment variable is used instead if it is defined.
 403 If the `system-name' function returns the full Internet name, there is
 404 no need to set this variable."
 405   :group 'gnus-start
 406   :type '(choice (const :tag "default" nil)
 407                  string))
 408
 409 (defcustom gnus-local-organization nil
 410   "String with a description of what organization (if any) the user belongs to.
 411 The ORGANIZATION environment variable is used instead if it is defined.
 412 If this variable contains a function, this function will be called
 413 with the current newsgroup name as the argument.  The function should
 414 return a string.
 415
 416 In any case, if the string (either in the variable, in the environment
 417 variable, or returned by the function) is a file name, the contents of
 418 this file will be used as the organization."
 419   :group 'gnus-start
 420   :type '(choice (const :tag "default" nil)
 421                  string))
 422
 423 ;; Customization variables
 424
 425 (defcustom gnus-refer-article-method nil
 426   "Preferred method for fetching an article by Message-ID.
 427 If you are reading news from the local spool (with nnspool), fetching
 428 articles by Message-ID is painfully slow.  By setting this method to an
 429 nntp method, you might get acceptable results.
 430
 431 The value of this variable must be a valid select method as discussed
 432 in the documentation of `gnus-select-method'."
 433   :group 'gnus-start
 434   :type '(choice (const :tag "default" nil)
 435                  gnus-select-method))
 436
 437 (defcustom gnus-group-faq-directory
 438   '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/"
 439     "/ftp@sunsite.auc.dk:/pub/usenet/"
 440     "/ftp@sunsite.doc.ic.ac.uk:/pub/usenet/news-faqs/"
 441     "/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/"
 442     "/ftp@ftp.seas.gwu.edu:/pub/rtfm/"
 443     "/ftp@rtfm.mit.edu:/pub/usenet/"
 444     "/ftp@ftp.uni-paderborn.de:/pub/FAQ/"
 445     "/ftp@ftp.sunet.se:/pub/usenet/"
 446     "/ftp@nctuccca.edu.tw:/USENET/FAQ/"
 447     "/ftp@hwarang.postech.ac.kr:/pub/usenet/"
 448     "/ftp@ftp.hk.super.net:/mirror/faqs/")
 449   "Directory where the group FAQs are stored.
 450 This will most commonly be on a remote machine, and the file will be
 451 fetched by ange-ftp.
 452
 453 This variable can also be a list of directories.  In that case, the
 454 first element in the list will be used by default.  The others can
 455 be used when being prompted for a site.
 456
 457 Note that Gnus uses an aol machine as the default directory.  If this
 458 feels fundamentally unclean, just think of it as a way to finally get
 459 something of value back from them.
 460
 461 If the default site is too slow, try one of these:
 462
 463    North America: mirrors.aol.com                /pub/rtfm/usenet
 464                   ftp.seas.gwu.edu               /pub/rtfm
 465                   rtfm.mit.edu                   /pub/usenet
 466    Europe:        ftp.uni-paderborn.de           /pub/FAQ
 467                   src.doc.ic.ac.uk               /usenet/news-FAQS
 468                   ftp.sunet.se                   /pub/usenet
 469                   sunsite.auc.dk                 /pub/usenet
 470    Asia:          nctuccca.edu.tw                /USENET/FAQ
 471                   hwarang.postech.ac.kr          /pub/usenet
 472                   ftp.hk.super.net               /mirror/faqs"
 473   :group 'gnus-group
 474   :type '(choice directory
 475                  (repeat directory)))
 476
 477 (defcustom gnus-use-cross-reference t
 478   "*Non-nil means that cross referenced articles will be marked as read.
 479 If nil, ignore cross references.  If t, mark articles as read in
 480 subscribed newsgroups.  If neither t nor nil, mark as read in all
 481 newsgroups."
 482   :group 'gnus-start
 483   :type '(choice (const :tag "off" nil)
 484                  (const :tag "subscribed" t)
 485                  (sexp :format "all"
 486                        :value always)))
 487
 488 (defcustom gnus-process-mark ?#
 489   "*Process mark."
 490   :group 'gnus-start
 491   :type 'character)
 492
 493 (defcustom gnus-asynchronous nil
 494   "*If non-nil, Gnus will supply backends with data needed for async article fetching."
 495   :group 'gnus-start
 496   :type 'boolean)
 497
 498 (defcustom gnus-large-newsgroup 200
 499   "*The number of articles which indicates a large newsgroup.
 500 If the number of articles in a newsgroup is greater than this value,
 501 confirmation is required for selecting the newsgroup."
 502   :group 'gnus-group
 503   :type 'integer)
 504
 505 (defcustom gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix)))
 506   "*Non-nil means that the default name of a file to save articles in is the group name.
 507 If it's nil, the directory form of the group name is used instead.
 508
 509 If this variable is a list, and the list contains the element
 510 `not-score', long file names will not be used for score files; if it
 511 contains the element `not-save', long file names will not be used for
 512 saving; and if it contains the element `not-kill', long file names
 513 will not be used for kill files.
 514
 515 Note that the default for this variable varies according to what system
 516 type you're using.  On `usg-unix-v' and `xenix' this variable defaults
 517 to nil while on all other systems it defaults to t."
 518   :group 'gnus-start
 519   :type 'boolean)
 520
 521 (defcustom gnus-kill-files-directory gnus-directory
 522   "*Name of the directory where kill files will be stored (default \"~/News\")."
 523   :group 'gnus-score
 524   :type 'directory)
 525
 526 (defcustom gnus-save-score nil
 527   "*If non-nil, save group scoring info."
 528   :group 'gnus-score
 529   :group 'gnus-start
 530   :type 'boolean)
 531
 532 (defcustom gnus-use-undo t
 533   "*If non-nil, allow undoing in Gnus group mode buffers."
 534   :group 'gnus-meta
 535   :type 'boolean)
 536
 537 (defcustom gnus-use-adaptive-scoring nil
 538   "*If non-nil, use some adaptive scoring scheme.
 539 If a list, then the values `word' and `line' are meaningful.  The
 540 former will perform adaption on individual words in the subject
 541 header while `line' will perform adaption on several headers."
 542   :group 'gnus-meta
 543   :type '(set (const word) (const line)))
 544
 545 (defcustom gnus-use-cache 'passive
 546   "*If nil, Gnus will ignore the article cache.
 547 If `passive', it will allow entering (and reading) articles
 548 explicitly entered into the cache.  If anything else, use the
 549 cache to the full extent of the law."
 550   :group 'gnus-meta
 551   :group 'gnus-cache
 552   :type '(choice (const :tag "off" nil)
 553                  (const :tag "passive" passive)
 554                  (const :tag "active" t)))
 555
 556 (defcustom gnus-use-trees nil
 557   "*If non-nil, display a thread tree buffer."
 558   :group 'gnus-meta
 559   :type 'boolean)
 560
 561 (defcustom gnus-use-grouplens nil
 562   "*If non-nil, use GroupLens ratings."
 563   :group 'gnus-meta
 564   :type 'boolean)
 565
 566 (defcustom gnus-keep-backlog nil
 567   "*If non-nil, Gnus will keep read articles for later re-retrieval.
 568 If it is a number N, then Gnus will only keep the last N articles
 569 read.  If it is neither nil nor a number, Gnus will keep all read
 570 articles.  This is not a good idea."
 571   :group 'gnus-meta
 572   :type '(choice (const :tag "off" nil)
 573                  integer
 574                  (sexp :format "all"
 575                        :value t)))
 576
 577 (defcustom gnus-use-nocem nil
 578   "*If non-nil, Gnus will read NoCeM cancel messages."
 579   :group 'gnus-meta
 580   :type 'boolean)
 581
 582 (defcustom gnus-suppress-duplicates nil
 583   "*If non-nil, Gnus will mark duplicate copies of the same article as read."
 584   :group 'gnus-meta
 585   :type 'boolean)
 586
 587 (defcustom gnus-use-demon nil
 588   "If non-nil, Gnus might use some demons."
 589   :group 'gnus-meta
 590   :type 'boolean)
 591
 592 (defcustom gnus-use-scoring t
 593   "*If non-nil, enable scoring."
 594   :group 'gnus-meta
 595   :type 'boolean)
 596
 597 (defcustom gnus-use-picons nil
 598   "*If non-nil, display picons."
 599   :group 'gnus-meta
 600   :type 'boolean)
 601
 602 (defcustom gnus-summary-prepare-exit-hook
 603   '(gnus-summary-expire-articles)
 604   "A hook called when preparing to exit from the summary buffer.
 605 It calls `gnus-summary-expire-articles' by default."
 606   :group 'gnus-summary
 607   :type 'hook)
 608
 609 (defcustom gnus-novice-user t
 610   "*Non-nil means that you are a usenet novice.
 611 If non-nil, verbose messages may be displayed and confirmations may be
 612 required."
 613   :group 'gnus-meta
 614   :type 'boolean)
 615
 616 (defcustom gnus-expert-user nil
 617   "*Non-nil means that you will never be asked for confirmation about anything.
 618 And that means *anything*."
 619   :group 'gnus-meta
 620   :type 'boolean)
 621
 622 (defcustom gnus-interactive-catchup t
 623   "*If non-nil, require your confirmation when catching up a group."
 624   :group 'gnus-group
 625   :type 'boolean)
 626
 627 (defcustom gnus-interactive-exit t
 628   "*If non-nil, require your confirmation when exiting Gnus."
 629   :group 'gnus-group
 630   :type 'boolean)
 631
 632 (defcustom gnus-extract-address-components 'gnus-extract-address-components
 633   "*Function for extracting address components from a From header.
 634 Two pre-defined function exist: `gnus-extract-address-components',
 635 which is the default, quite fast, and too simplistic solution, and
 636 `mail-extract-address-components', which works much better, but is
 637 slower."
 638   :group 'gnus-start
 639   :type '(radio (function-item gnus-extract-address-components)
 640                 (function-item mail-extract-address-components)
 641                 (function :tag "Other")))
 642
 643 (defcustom gnus-carpal nil
 644   "*If non-nil, display clickable icons."
 645   :group 'gnus-meta
 646   :type 'boolean)
 647
 648 (defcustom gnus-shell-command-separator ";"
 649   "String used to separate to shell commands."
 650   :group 'gnus-start
 651   :type 'string)
 652
 653 (defcustom gnus-valid-select-methods
 654   '(("nntp" post address prompt-address)
 655     ("nnspool" post address)
 656     ("nnvirtual" post-mail virtual prompt-address)
 657     ("nnmbox" mail respool address)
 658     ("nnml" mail respool address)
 659     ("nnmh" mail respool address)
 660     ("nndir" post-mail prompt-address)
 661     ("nneething" none address prompt-address)
 662     ("nndoc" none address prompt-address)
 663     ("nnbabyl" mail address respool)
 664     ("nnkiboze" post virtual)
 665     ("nnsoup" post-mail address)
 666     ("nndraft" post-mail)
 667     ("nnfolder" mail respool address)
 668     ("nngateway" none address prompt-address)
 669     ("nnweb" none))
 670   "An alist of valid select methods.
 671 The first element of each list lists should be a string with the name
 672 of the select method.  The other elements may be the category of
 673 this method (i. e., `post', `mail', `none' or whatever) or other
 674 properties that this method has (like being respoolable).
 675 If you implement a new select method, all you should have to change is
 676 this variable.  I think."
 677   :group 'gnus-start
 678   :type '(repeat (group (string :tag "Name")
 679                         (radio-button-choice (const :format "%v " post)
 680                                              (const :format "%v " mail)
 681                                              (const :format "%v " none)
 682                                              (const post-mail))
 683                         (checklist :inline t
 684                                    (const :format "%v " address)
 685                                    (const :format "%v " prompt-address)
 686                                    (const :format "%v " virtual)
 687                                    (const respool)))))
 688
 689 (define-widget 'gnus-select-method 'list
 690   "Widget for entering a select method."
 691   :args `((choice :tag "Method"
 692                   ,@(mapcar (lambda (entry)
 693                               (list 'const :format "%v\n"
 694                                     (intern (car entry))))
 695                             gnus-valid-select-methods))
 696           (string :tag "Address")
 697           (editable-list  :inline t
 698                           (list :format "%v"
 699                                 variable
 700                                 (sexp :tag "Value")))))
 701
 702 (defcustom gnus-updated-mode-lines '(group article summary tree)
 703   "List of buffers that should update their mode lines.
 704 The list may contain the symbols `group', `article', `tree' and
 705 `summary'.  If the corresponding symbol is present, Gnus will keep
 706 that mode line updated with information that may be pertinent.
 707 If this variable is nil, screen refresh may be quicker."
 708   :group 'gnus-start
 709   :type '(set (const group)
 710               (const article)
 711               (const summary)
 712               (const tree)))
 713
 714 ;; Added by Keinonen Kari <kk85613@cs.tut.fi>.
 715 (defcustom gnus-mode-non-string-length nil
 716   "*Max length of mode-line non-string contents.
 717 If this is nil, Gnus will take space as is needed, leaving the rest
 718 of the modeline intact."
 719   :group 'gnus-start
 720   :type '(choice (const nil)
 721                  integer))
 722
 723 (defcustom gnus-auto-expirable-newsgroups nil
 724   "*Groups in which to automatically mark read articles as expirable.
 725 If non-nil, this should be a regexp that should match all groups in
 726 which to perform auto-expiry.  This only makes sense for mail groups."
 727   :group 'gnus-group
 728   :type '(choice (const nil)
 729                  regexp))
 730
 731 (defcustom gnus-total-expirable-newsgroups nil
 732   "*Groups in which to perform expiry of all read articles.
 733 Use with extreme caution.  All groups that match this regexp will be
 734 expiring - which means that all read articles will be deleted after
 735 \(say) one week.         (This only goes for mail groups and the like, of
 736 course.)"
 737   :group 'gnus-group
 738   :type '(choice (const nil)
 739                  regexp))
 740
 741 (defcustom gnus-group-uncollapsed-levels 1
 742   "Number of group name elements to leave alone when making a short group name."
 743   :group 'gnus-group
 744   :type 'integer)
 745
 746 (defcustom gnus-group-use-permanent-levels nil
 747   "*If non-nil, once you set a level, Gnus will use this level."
 748   :group 'gnus-group
 749   :type 'boolean)
 750
 751 ;; Hooks.
 752
 753 (defcustom gnus-load-hook nil
 754   "A hook run while Gnus is loaded."
 755   :group 'gnus-start
 756   :type 'hook)
 757
 758 (defcustom gnus-apply-kill-hook '(gnus-apply-kill-file)
 759   "A hook called to apply kill files to a group.
 760 This hook is intended to apply a kill file to the selected newsgroup.
 761 The function `gnus-apply-kill-file' is called by default.
 762
 763 Since a general kill file is too heavy to use only for a few
 764 newsgroups, I recommend you to use a lighter hook function.  For
 765 example, if you'd like to apply a kill file to articles which contains
 766 a string `rmgroup' in subject in newsgroup `control', you can use the
 767 following hook:
 768
 769  (setq gnus-apply-kill-hook
 770       (list
 771         (lambda ()
 772           (cond ((string-match \"control\" gnus-newsgroup-name)
 773                  (gnus-kill \"Subject\" \"rmgroup\")
 774                  (gnus-expunge \"X\"))))))"
 775   :group 'gnus-score
 776   :options '(gnus-apply-kill-file)
 777   :type 'hook)
 778
 779 (defcustom gnus-group-change-level-function nil
 780   "Function run when a group level is changed.
 781 It is called with three parameters -- GROUP, LEVEL and OLDLEVEL."
 782   :group 'gnus-start
 783   :type 'function)
 784
 785 ;;; Face thingies.
 786
 787 (defgroup gnus-visual nil
 788   "Options controling the visual fluff."
 789   :group 'gnus)
 790
 791 (defcustom gnus-visual
 792   '(summary-highlight group-highlight article-highlight
 793                       mouse-face
 794                       summary-menu group-menu article-menu
 795                       tree-highlight menu highlight
 796                       browse-menu server-menu
 797                       page-marker tree-menu binary-menu pick-menu
 798                       grouplens-menu)
 799   "Enable visual features.
 800 If `visual' is disabled, there will be no menus and few faces.  Most of
 801 the visual customization options below will be ignored.  Gnus will use
 802 less space and be faster as a result."
 803   :group 'gnus-meta
 804   :group 'gnus-visual
 805   :type '(set (const summary-highlight)
 806               (const group-highlight)
 807               (const article-highlight)
 808               (const mouse-face)
 809               (const summary-menu)
 810               (const group-menu)
 811               (const article-menu)
 812               (const tree-highlight)
 813               (const menu)
 814               (const highlight)
 815               (const browse-menu)
 816               (const server-menu)
 817               (const page-marker)
 818               (const tree-menu)
 819               (const binary-menu)
 820               (const pick-menu)
 821               (const grouplens-menu)))
 822
 823 (defcustom gnus-mouse-face
 824   (condition-case ()
 825       (if (gnus-visual-p 'mouse-face 'highlight)
 826           (if (boundp 'gnus-mouse-face)
 827               (or gnus-mouse-face 'highlight)
 828             'highlight)
 829         'default)
 830     (error 'highlight))
 831   "Face used for group or summary buffer mouse highlighting.
 832 The line beneath the mouse pointer will be highlighted with this
 833 face."
 834   :group 'gnus-visual
 835   :type 'face)
 836
 837 (defcustom gnus-article-display-hook
 838   (if (and (string-match "XEmacs" emacs-version)
 839            (featurep 'xface))
 840       '(gnus-article-hide-headers-if-wanted
 841         gnus-article-hide-boring-headers
 842         gnus-article-treat-overstrike
 843         gnus-article-maybe-highlight
 844         gnus-article-display-x-face)
 845     '(gnus-article-hide-headers-if-wanted
 846       gnus-article-hide-boring-headers
 847       gnus-article-treat-overstrike
 848       gnus-article-maybe-highlight))
 849   "Controls how the article buffer will look.
 850
 851 If you leave the list empty, the article will appear exactly as it is
 852 stored on the disk.  The list entries will hide or highlight various
 853 parts of the article, making it easier to find the information you
 854 want."
 855   :group 'article
 856   :group 'gnus-visual
 857   :type 'hook
 858   :options '(gnus-article-add-buttons
 859              gnus-article-add-buttons-to-head
 860              gnus-article-treat-overstrike
 861              gnus-article-emphasize
 862              gnus-article-fill-cited-article
 863              gnus-article-remove-cr
 864              gnus-article-de-quoted-unreadable
 865              gnus-article-display-x-face
 866              gnus-summary-stop-page-breaking
 867              ;; gnus-summary-caesar-message
 868              ;; gnus-summary-verbose-headers
 869              gnus-summary-toggle-mime
 870              gnus-article-hide
 871              gnus-article-hide-headers
 872              gnus-article-hide-boring-headers
 873              gnus-article-hide-signature
 874              gnus-article-hide-citation
 875              gnus-article-hide-pgp
 876              gnus-article-hide-pem
 877              gnus-article-highlight
 878              gnus-article-highlight-headers
 879              gnus-article-highlight-citation
 880              gnus-article-highlight-signature
 881              gnus-article-date-ut
 882              gnus-article-date-local
 883              gnus-article-date-lapsed
 884              gnus-article-date-original
 885              gnus-article-remove-trailing-blank-lines
 886              gnus-article-strip-leading-blank-lines
 887              gnus-article-strip-multiple-blank-lines
 888              gnus-article-strip-blank-lines))
 889
 890 \f
 891 ;;; Internal variables
 892
 893 (defvar gnus-group-get-parameter-function 'gnus-group-get-parameter)
 894 (defvar gnus-original-article-buffer " *Original Article*")
 895 (defvar gnus-newsgroup-name nil)
 896
 897 (defvar gnus-current-select-method nil
 898   "The current method for selecting a newsgroup.")
 899
 900 (defvar gnus-tree-buffer "*Tree*"
 901   "Buffer where Gnus thread trees are displayed.")
 902
 903 ;; Dummy variable.
 904 (defvar gnus-use-generic-from nil)
 905
 906 ;; Variable holding the user answers to all method prompts.
 907 (defvar gnus-method-history nil)
 908 (defvar gnus-group-history nil)
 909
 910 ;; Variable holding the user answers to all mail method prompts.
 911 (defvar gnus-mail-method-history nil)
 912
 913 ;; Variable holding the user answers to all group prompts.
 914 (defvar gnus-group-history nil)
 915
 916 (defvar gnus-server-alist nil
 917   "List of available servers.")
 918
 919 (defvar gnus-predefined-server-alist
 920   `(("cache"
 921      (nnspool "cache"
 922               (nnspool-spool-directory "~/News/cache/")
 923               (nnspool-nov-directory "~/News/cache/")
 924               (nnspool-active-file "~/News/cache/active"))))
 925   "List of predefined (convenience) servers.")
 926
 927 (defvar gnus-topic-indentation "") ;; Obsolete variable.
 928
 929 (defconst gnus-article-mark-lists
 930   '((marked . tick) (replied . reply)
 931     (expirable . expire) (killed . killed)
 932     (bookmarks . bookmark) (dormant . dormant)
 933     (scored . score) (saved . save)
 934     (cached . cache)))
 935
 936 (defvar gnus-headers-retrieved-by nil)
 937 (defvar gnus-article-reply nil)
 938 (defvar gnus-override-method nil)
 939 (defvar gnus-article-check-size nil)
 940 (defvar gnus-opened-servers nil)
 941
 942 (defvar gnus-current-kill-article nil)
 943
 944 (defvar gnus-have-read-active-file nil)
 945
 946 (defconst gnus-maintainer
 947   "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
 948   "The mail address of the Gnus maintainers.")
 949
 950 (defvar gnus-info-nodes
 951   '((gnus-group-mode "(gnus)The Group Buffer")
 952     (gnus-summary-mode "(gnus)The Summary Buffer")
 953     (gnus-article-mode "(gnus)The Article Buffer")
 954     (mime/viewer-mode "(gnus)The Article Buffer")
 955     (gnus-server-mode "(gnus)The Server Buffer")
 956     (gnus-browse-mode "(gnus)Browse Foreign Server")
 957     (gnus-tree-mode "(gnus)Tree Display"))
 958   "Alist of major modes and related Info nodes.")
 959
 960 (defvar gnus-group-buffer "*Group*")
 961 (defvar gnus-summary-buffer "*Summary*")
 962 (defvar gnus-article-buffer "*Article*")
 963 (defvar gnus-server-buffer "*Server*")
 964
 965 (defvar gnus-buffer-list nil
 966   "Gnus buffers that should be killed on exit.")
 967
 968 (defvar gnus-slave nil
 969   "Whether this Gnus is a slave or not.")
 970
 971 (defvar gnus-batch-mode nil
 972   "Whether this Gnus is running in batch mode or not.")
 973
 974 (defvar gnus-variable-list
 975   '(gnus-newsrc-options gnus-newsrc-options-n
 976     gnus-newsrc-last-checked-date
 977     gnus-newsrc-alist gnus-server-alist
 978     gnus-killed-list gnus-zombie-list
 979     gnus-topic-topology gnus-topic-alist
 980     gnus-format-specs)
 981   "Gnus variables saved in the quick startup file.")
 982
 983 (defvar gnus-newsrc-alist nil
 984   "Assoc list of read articles.
 985 gnus-newsrc-hashtb should be kept so that both hold the same information.")
 986
 987 (defvar gnus-newsrc-hashtb nil
 988   "Hashtable of gnus-newsrc-alist.")
 989
 990 (defvar gnus-killed-list nil
 991   "List of killed newsgroups.")
 992
 993 (defvar gnus-killed-hashtb nil
 994   "Hash table equivalent of gnus-killed-list.")
 995
 996 (defvar gnus-zombie-list nil
 997   "List of almost dead newsgroups.")
 998
 999 (defvar gnus-description-hashtb nil
1000   "Descriptions of newsgroups.")
1001
1002 (defvar gnus-list-of-killed-groups nil
1003   "List of newsgroups that have recently been killed by the user.")
1004
1005 (defvar gnus-active-hashtb nil
1006   "Hashtable of active articles.")
1007
1008 (defvar gnus-moderated-hashtb nil
1009   "Hashtable of moderated newsgroups.")
1010
1011 ;; Save window configuration.
1012 (defvar gnus-prev-winconf nil)
1013
1014 (defvar gnus-reffed-article-number nil)
1015
1016 ;;; Let the byte-compiler know that we know about this variable.
1017 (defvar rmail-default-rmail-file)
1018
1019 (defvar gnus-dead-summary nil)
1020
1021 ;;; End of variables.
1022
1023 ;; Define some autoload functions Gnus might use.
1024 (eval-and-compile
1025
1026   ;; This little mapcar goes through the list below and marks the
1027   ;; symbols in question as autoloaded functions.
1028   (mapcar
1029    (lambda (package)
1030      (let ((interactive (nth 1 (memq ':interactive package))))
1031        (mapcar
1032         (lambda (function)
1033           (let (keymap)
1034             (when (consp function)
1035               (setq keymap (car (memq 'keymap function)))
1036               (setq function (car function)))
1037             (autoload function (car package) nil interactive keymap)))
1038         (if (eq (nth 1 package) ':interactive)
1039             (cdddr package)
1040           (cdr package)))))
1041    '(("metamail" metamail-buffer)
1042      ("info" Info-goto-node)
1043      ("hexl" hexl-hex-string-to-integer)
1044      ("pp" pp pp-to-string pp-eval-expression)
1045      ("mail-extr" mail-extract-address-components)
1046      ("message" :interactive t
1047       message-send-and-exit message-yank-original)
1048      ("nnmail" nnmail-split-fancy nnmail-article-group nnmail-date-to-time)
1049      ("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers)
1050      ("timezone" timezone-make-date-arpa-standard timezone-fix-time
1051       timezone-make-sortable-date timezone-make-time-string)
1052      ("rmailout" rmail-output)
1053      ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages
1054       rmail-show-message)
1055      ("gnus-audio" :interactive t gnus-audio-play)
1056      ("gnus-xmas" gnus-xmas-splash)
1057      ("gnus-soup" :interactive t
1058       gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article
1059       gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet)
1060      ("nnsoup" nnsoup-pack-replies)
1061      ("score-mode" :interactive t gnus-score-mode)
1062      ("gnus-mh" gnus-summary-save-article-folder
1063       gnus-Folder-save-name gnus-folder-save-name)
1064      ("gnus-mh" :interactive t gnus-summary-save-in-folder)
1065      ("gnus-demon" gnus-demon-add-nocem gnus-demon-add-scanmail
1066       gnus-demon-add-rescan gnus-demon-add-scan-timestamps
1067       gnus-demon-add-disconnection gnus-demon-add-handler
1068       gnus-demon-remove-handler)
1069      ("gnus-demon" :interactive t
1070       gnus-demon-init gnus-demon-cancel)
1071      ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree
1072       gnus-tree-open gnus-tree-close gnus-carpal-setup-buffer)
1073      ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close
1074       gnus-nocem-unwanted-article-p)
1075      ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info)
1076      ("gnus-srvr" gnus-browse-foreign-server)
1077      ("gnus-cite" :interactive t
1078       gnus-article-highlight-citation gnus-article-hide-citation-maybe
1079       gnus-article-hide-citation gnus-article-fill-cited-article
1080       gnus-article-hide-citation-in-followups)
1081      ("gnus-kill" gnus-kill gnus-apply-kill-file-internal
1082       gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author
1083       gnus-execute gnus-expunge)
1084      ("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers
1085       gnus-cache-possibly-remove-articles gnus-cache-request-article
1086       gnus-cache-retrieve-headers gnus-cache-possibly-alter-active
1087       gnus-cache-enter-remove-article gnus-cached-article-p
1088       gnus-cache-open gnus-cache-close gnus-cache-update-article)
1089       ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article
1090        gnus-cache-remove-article gnus-summary-insert-cached-articles)
1091       ("gnus-score" :interactive t
1092        gnus-summary-increase-score gnus-summary-set-score
1093        gnus-summary-raise-thread gnus-summary-raise-same-subject
1094        gnus-summary-raise-score gnus-summary-raise-same-subject-and-select
1095        gnus-summary-lower-thread gnus-summary-lower-same-subject
1096        gnus-summary-lower-score gnus-summary-lower-same-subject-and-select
1097        gnus-summary-current-score gnus-score-default
1098        gnus-score-flush-cache gnus-score-close
1099        gnus-possibly-score-headers gnus-score-followup-article
1100        gnus-score-followup-thread)
1101       ("gnus-score"
1102        (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers
1103       gnus-current-score-file-nondirectory gnus-score-adaptive
1104       gnus-score-find-trace gnus-score-file-name)
1105      ("gnus-cus" :interactive t gnus-group-customize gnus-score-customize)
1106      ("gnus-topic" :interactive t gnus-topic-mode)
1107      ("gnus-topic" gnus-topic-remove-group)
1108      ("gnus-salt" :interactive t gnus-pick-mode gnus-binary-mode)
1109      ("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap))
1110      ("gnus-uu" :interactive t
1111       gnus-uu-digest-mail-forward gnus-uu-digest-post-forward
1112       gnus-uu-mark-series gnus-uu-mark-region gnus-uu-mark-buffer
1113       gnus-uu-mark-by-regexp gnus-uu-mark-all
1114       gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu
1115       gnus-uu-decode-uu-and-save gnus-uu-decode-unshar
1116       gnus-uu-decode-unshar-and-save gnus-uu-decode-save
1117       gnus-uu-decode-binhex gnus-uu-decode-uu-view
1118       gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view
1119       gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view
1120       gnus-uu-decode-binhex-view)
1121      ("gnus-msg" (gnus-summary-send-map keymap)
1122       gnus-article-mail gnus-copy-article-buffer gnus-extended-version)
1123      ("gnus-msg" :interactive t
1124       gnus-group-post-news gnus-group-mail gnus-summary-post-news
1125       gnus-summary-followup gnus-summary-followup-with-original
1126       gnus-summary-cancel-article gnus-summary-supersede-article
1127       gnus-post-news gnus-summary-reply gnus-summary-reply-with-original
1128       gnus-summary-mail-forward gnus-summary-mail-other-window
1129       gnus-summary-resend-message gnus-summary-resend-bounced-mail
1130       gnus-bug)
1131      ("gnus-picon" :interactive t gnus-article-display-picons
1132       gnus-group-display-picons gnus-picons-article-display-x-face
1133       gnus-picons-display-x-face)
1134      ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p
1135       gnus-grouplens-mode)
1136      ("smiley" :interactive t gnus-smiley-display)
1137      ("gnus-win" gnus-configure-windows)
1138      ("gnus-sum" gnus-summary-insert-line gnus-summary-read-group
1139       gnus-list-of-unread-articles gnus-list-of-read-articles
1140       gnus-offer-save-summaries gnus-make-thread-indent-array
1141       gnus-summary-exit gnus-update-read-articles)
1142      ("gnus-group" gnus-group-insert-group-line gnus-group-quit
1143       gnus-group-list-groups gnus-group-first-unread-group
1144       gnus-group-set-mode-line gnus-group-set-info gnus-group-save-newsrc
1145       gnus-group-setup-buffer gnus-group-get-new-news
1146       gnus-group-make-help-group gnus-group-update-group)
1147      ("gnus-bcklg" gnus-backlog-request-article gnus-backlog-enter-article
1148       gnus-backlog-remove-article)
1149      ("gnus-art" gnus-article-read-summary-keys gnus-article-save
1150       gnus-article-prepare gnus-article-set-window-start
1151       gnus-article-next-page gnus-article-prev-page
1152       gnus-request-article-this-buffer gnus-article-mode
1153       gnus-article-setup-buffer gnus-narrow-to-page)
1154      ("gnus-art" :interactive t
1155       gnus-article-hide-headers gnus-article-hide-boring-headers
1156       gnus-article-treat-overstrike gnus-article-word-wrap
1157       gnus-article-remove-cr gnus-article-remove-trailing-blank-lines
1158       gnus-article-display-x-face gnus-article-de-quoted-unreadable
1159       gnus-article-mime-decode-quoted-printable gnus-article-hide-pgp
1160       gnus-article-hide-pem gnus-article-hide-signature
1161       gnus-article-strip-leading-blank-lines gnus-article-date-local
1162       gnus-article-date-original gnus-article-date-lapsed
1163       gnus-decode-rfc1522 gnus-article-show-all-headers
1164       gnus-article-edit-mode gnus-article-edit-article
1165       gnus-article-edit-done)
1166      ("gnus-int" gnus-request-type)
1167      ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1
1168       gnus-dribble-enter)
1169      ("gnus-dup" gnus-dup-suppress-articles gnus-dup-unsuppress-article
1170       gnus-dup-enter-articles)
1171      ("gnus-range" gnus-copy-sequence)
1172      ("gnus-eform" gnus-edit-form)
1173      ("gnus-move" :interactive t
1174       gnus-group-move-group-to-server gnus-change-server)
1175      ("gnus-logic" gnus-score-advanced)
1176      ("gnus-undo" gnus-undo-mode gnus-undo-register)
1177      ("gnus-async" gnus-async-request-fetched-article gnus-async-prefetch-next
1178       gnus-async-prefetch-article gnus-async-prefetch-remove-group
1179       gnus-async-halt-prefetch)
1180      ("article" article-decode-rfc1522)
1181      ("gnus-vm" :interactive t gnus-summary-save-in-vm
1182       gnus-summary-save-article-vm))))
1183
1184 ;;; gnus-sum.el thingies
1185
1186
1187 (defcustom gnus-summary-line-format "%U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n"
1188   "*The format specification of the lines in the summary buffer.
1189
1190 It works along the same lines as a normal formatting string,
1191 with some simple extensions.
1192
1193 %N   Article number, left padded with spaces (string)
1194 %S   Subject (string)
1195 %s   Subject if it is at the root of a thread, and \"\" otherwise (string)
1196 %n   Name of the poster (string)
1197 %a   Extracted name of the poster (string)
1198 %A   Extracted address of the poster (string)
1199 %F   Contents of the From: header (string)
1200 %x   Contents of the Xref: header (string)
1201 %D   Date of the article (string)
1202 %d   Date of the article (string) in DD-MMM format
1203 %M   Message-id of the article (string)
1204 %r   References of the article (string)
1205 %c   Number of characters in the article (integer)
1206 %L   Number of lines in the article (integer)
1207 %I   Indentation based on thread level (a string of spaces)
1208 %T   A string with two possible values: 80 spaces if the article
1209      is on thread level two or larger and 0 spaces on level one
1210 %R   \"A\" if this article has been replied to, \" \" otherwise (character)
1211 %U   Status of this article (character, \"R\", \"K\", \"-\" or \" \")
1212 %[   Opening bracket (character, \"[\" or \"<\")
1213 %]   Closing bracket (character, \"]\" or \">\")
1214 %>   Spaces of length thread-level (string)
1215 %<   Spaces of length (- 20 thread-level) (string)
1216 %i   Article score (number)
1217 %z   Article zcore (character)
1218 %t   Number of articles under the current thread (number).
1219 %e   Whether the thread is empty or not (character).
1220 %l   GroupLens score (string).
1221 %V   Total thread score (number).
1222 %P   The line number (number).
1223 %u   User defined specifier.  The next character in the format string should
1224      be a letter.  Gnus will call the function gnus-user-format-function-X,
1225      where X is the letter following %u.  The function will be passed the
1226      current header as argument.  The function should return a string, which
1227      will be inserted into the summary just like information from any other
1228      summary specifier.
1229
1230 Text between %( and %) will be highlighted with `gnus-mouse-face'
1231 when the mouse point is placed inside the area.  There can only be one
1232 such area.
1233
1234 The %U (status), %R (replied) and %z (zcore) specs have to be handled
1235 with care.  For reasons of efficiency, Gnus will compute what column
1236 these characters will end up in, and \"hard-code\" that.  This means that
1237 it is illegal to have these specs after a variable-length spec.  Well,
1238 you might not be arrested, but your summary buffer will look strange,
1239 which is bad enough.
1240
1241 The smart choice is to have these specs as for to the left as
1242 possible.
1243
1244 This restriction may disappear in later versions of Gnus."
1245   :type 'string
1246   :group 'gnus-summary)
1247
1248 ;;;
1249 ;;; Skeleton keymaps
1250 ;;;
1251
1252 (defun gnus-suppress-keymap (keymap)
1253   (suppress-keymap keymap)
1254   (let ((keys `([delete] "\177" "\M-u"))) ;gnus-mouse-2
1255     (while keys
1256       (define-key keymap (pop keys) 'undefined))))
1257
1258 (defvar gnus-article-mode-map (make-keymap))
1259 (gnus-suppress-keymap gnus-article-mode-map)
1260 (defvar gnus-summary-mode-map (make-keymap))
1261 (gnus-suppress-keymap gnus-summary-mode-map)
1262 (defvar gnus-group-mode-map (make-keymap))
1263 (gnus-suppress-keymap gnus-group-mode-map)
1264
1265 \f
1266
1267 ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
1268 ;; If you want the cursor to go somewhere else, set these two
1269 ;; functions in some startup hook to whatever you want.
1270 (defalias 'gnus-summary-position-point 'gnus-goto-colon)
1271 (defalias 'gnus-group-position-point 'gnus-goto-colon)
1272
1273 ;;; Various macros and substs.
1274
1275 (defun gnus-header-from (header)
1276   (mail-header-from header))
1277
1278 (defmacro gnus-gethash (string hashtable)
1279   "Get hash value of STRING in HASHTABLE."
1280   `(symbol-value (intern-soft ,string ,hashtable)))
1281
1282 (defmacro gnus-sethash (string value hashtable)
1283   "Set hash value.  Arguments are STRING, VALUE, and HASHTABLE."
1284   `(set (intern ,string ,hashtable) ,value))
1285 (put 'gnus-sethash 'edebug-form-spec '(form form form))
1286
1287 (defmacro gnus-group-unread (group)
1288   "Get the currently computed number of unread articles in GROUP."
1289   `(car (gnus-gethash ,group gnus-newsrc-hashtb)))
1290
1291 (defmacro gnus-group-entry (group)
1292   "Get the newsrc entry for GROUP."
1293   `(gnus-gethash ,group gnus-newsrc-hashtb))
1294
1295 (defmacro gnus-active (group)
1296   "Get active info on GROUP."
1297   `(gnus-gethash ,group gnus-active-hashtb))
1298
1299 (defmacro gnus-set-active (group active)
1300   "Set GROUP's active info."
1301   `(gnus-sethash ,group ,active gnus-active-hashtb))
1302
1303 (defun gnus-alive-p ()
1304   "Say whether Gnus is running or not."
1305   (and gnus-group-buffer
1306        (get-buffer gnus-group-buffer)
1307        (save-excursion
1308          (set-buffer gnus-group-buffer)
1309          (eq major-mode 'gnus-group-mode))))
1310
1311 ;; Info access macros.
1312
1313 (defmacro gnus-info-group (info)
1314   `(nth 0 ,info))
1315 (defmacro gnus-info-rank (info)
1316   `(nth 1 ,info))
1317 (defmacro gnus-info-read (info)
1318   `(nth 2 ,info))
1319 (defmacro gnus-info-marks (info)
1320   `(nth 3 ,info))
1321 (defmacro gnus-info-method (info)
1322   `(nth 4 ,info))
1323 (defmacro gnus-info-params (info)
1324   `(nth 5 ,info))
1325
1326 (defmacro gnus-info-level (info)
1327   `(let ((rank (gnus-info-rank ,info)))
1328      (if (consp rank)
1329          (car rank)
1330        rank)))
1331 (defmacro gnus-info-score (info)
1332   `(let ((rank (gnus-info-rank ,info)))
1333      (or (and (consp rank) (cdr rank)) 0)))
1334
1335 (defmacro gnus-info-set-group (info group)
1336   `(setcar ,info ,group))
1337 (defmacro gnus-info-set-rank (info rank)
1338   `(setcar (nthcdr 1 ,info) ,rank))
1339 (defmacro gnus-info-set-read (info read)
1340   `(setcar (nthcdr 2 ,info) ,read))
1341 (defmacro gnus-info-set-marks (info marks &optional extend)
1342   (if extend
1343       `(gnus-info-set-entry ,info ,marks 3)
1344     `(setcar (nthcdr 3 ,info) ,marks)))
1345 (defmacro gnus-info-set-method (info method &optional extend)
1346   (if extend
1347       `(gnus-info-set-entry ,info ,method 4)
1348     `(setcar (nthcdr 4 ,info) ,method)))
1349 (defmacro gnus-info-set-params (info params &optional extend)
1350   (if extend
1351       `(gnus-info-set-entry ,info ,params 5)
1352     `(setcar (nthcdr 5 ,info) ,params)))
1353
1354 (defun gnus-info-set-entry (info entry number)
1355   ;; Extend the info until we have enough elements.
1356   (while (<= (length info) number)
1357     (nconc info (list nil)))
1358   ;; Set the entry.
1359   (setcar (nthcdr number info) entry))
1360
1361 (defmacro gnus-info-set-level (info level)
1362   `(let ((rank (cdr ,info)))
1363      (if (consp (car rank))
1364          (setcar (car rank) ,level)
1365        (setcar rank ,level))))
1366 (defmacro gnus-info-set-score (info score)
1367   `(let ((rank (cdr ,info)))
1368      (if (consp (car rank))
1369          (setcdr (car rank) ,score)
1370        (setcar rank (cons (car rank) ,score)))))
1371
1372 (defmacro gnus-get-info (group)
1373   `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb)))
1374
1375 ;; Byte-compiler warning.
1376 (defvar gnus-visual)
1377 ;; Find out whether the gnus-visual TYPE is wanted.
1378 (defun gnus-visual-p (&optional type class)
1379   (and gnus-visual                      ; Has to be non-nil, at least.
1380        (if (not type)                   ; We don't care about type.
1381            gnus-visual
1382          (if (listp gnus-visual)        ; It's a list, so we check it.
1383              (or (memq type gnus-visual)
1384                  (memq class gnus-visual))
1385            t))))
1386
1387 ;;; Load the compatability functions.
1388
1389 (require 'gnus-ems)
1390
1391 \f
1392 ;;;
1393 ;;; Shutdown
1394 ;;;
1395
1396 (defvar gnus-shutdown-alist nil)
1397
1398 (defun gnus-add-shutdown (function &rest symbols)
1399   "Run FUNCTION whenever one of SYMBOLS is shut down."
1400   (push (cons function symbols) gnus-shutdown-alist))
1401
1402 (defun gnus-shutdown (symbol)
1403   "Shut down everything that waits for SYMBOL."
1404   (let ((alist gnus-shutdown-alist)
1405         entry)
1406     (while (setq entry (pop alist))
1407       (when (memq symbol (cdr entry))
1408         (funcall (car entry))))))
1409
1410 \f
1411 ;;;
1412 ;;; Gnus Utility Functions
1413 ;;;
1414
1415 ;; Add the current buffer to the list of buffers to be killed on exit.
1416 (defun gnus-add-current-to-buffer-list ()
1417   (or (memq (current-buffer) gnus-buffer-list)
1418       (push (current-buffer) gnus-buffer-list)))
1419
1420 (defun gnus-version (&optional arg)
1421   "Version number of this version of Gnus.
1422 If ARG, insert string at point."
1423   (interactive "P")
1424   (let ((methods gnus-valid-select-methods)
1425         (mess gnus-version)
1426         meth)
1427     ;; Go through all the legal select methods and add their version
1428     ;; numbers to the total version string.  Only the backends that are
1429     ;; currently in use will have their message numbers taken into
1430     ;; consideration.
1431     (while methods
1432       (setq meth (intern (concat (caar methods) "-version")))
1433       (and (boundp meth)
1434            (stringp (symbol-value meth))
1435            (setq mess (concat mess "; " (symbol-value meth))))
1436       (setq methods (cdr methods)))
1437     (if arg
1438         (insert (message mess))
1439       (message mess))))
1440
1441 (defun gnus-continuum-version (version)
1442   "Return VERSION as a floating point number."
1443   (when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version)
1444             (string-match "^\\(.?\\)gnus-\\([0-9.]+\\)$" version))
1445     (let* ((alpha (and (match-beginning 1) (match-string 1 version)))
1446            (number (match-string 2 version))
1447            major minor least)
1448       (string-match "\\([0-9]\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?" number)
1449       (setq major (string-to-number (match-string 1 number)))
1450       (setq minor (string-to-number (match-string 2 number)))
1451       (setq least (if (match-beginning 3)
1452                       (string-to-number (match-string 3 number))
1453                     0))
1454       (string-to-number
1455        (if (zerop major)
1456            (format "%s00%02d%02d"
1457                    (cond
1458                     ((member alpha '("(ding)" "d")) "4.99")
1459                     ((member alpha '("September" "s")) "5.01")
1460                     ((member alpha '("Red" "r")) "5.03"))
1461                    minor least)
1462          (format "%d.%02d%02d" major minor least))))))
1463
1464 (defun gnus-info-find-node ()
1465   "Find Info documentation of Gnus."
1466   (interactive)
1467   ;; Enlarge info window if needed.
1468   (let (gnus-info-buffer)
1469     (Info-goto-node (cadr (assq major-mode gnus-info-nodes)))
1470     (setq gnus-info-buffer (current-buffer))
1471     (gnus-configure-windows 'info)))
1472
1473 ;;; More various functions.
1474
1475 (defun gnus-group-read-only-p (&optional group)
1476   "Check whether GROUP supports editing or not.
1477 If GROUP is nil, `gnus-newsgroup-name' will be checked instead.  Note
1478 that that variable is buffer-local to the summary buffers."
1479   (let ((group (or group gnus-newsgroup-name)))
1480     (not (gnus-check-backend-function 'request-replace-article group))))
1481
1482 (defun gnus-group-total-expirable-p (group)
1483   "Check whether GROUP is total-expirable or not."
1484   (let ((params (gnus-group-find-parameter group))
1485         val)
1486     (cond
1487      ((memq 'total-expire params)
1488       t)
1489      ((setq val (assq 'total-expire params)) ; (auto-expire . t)
1490       (cdr val))
1491      (gnus-total-expirable-newsgroups   ; Check var.
1492       (string-match gnus-total-expirable-newsgroups group)))))
1493
1494 (defun gnus-group-auto-expirable-p (group)
1495   "Check whether GROUP is total-expirable or not."
1496   (let ((params (gnus-group-find-parameter group))
1497         val)
1498     (cond
1499      ((memq 'auto-expire params)
1500       t)
1501      ((setq val (assq 'auto-expire params)) ; (auto-expire . t)
1502       (cdr val))
1503      (gnus-auto-expirable-newsgroups    ; Check var.
1504       (string-match gnus-auto-expirable-newsgroups group)))))
1505
1506 (defun gnus-virtual-group-p (group)
1507   "Say whether GROUP is virtual or not."
1508   (memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group)))
1509                         gnus-valid-select-methods)))
1510
1511 (defun gnus-news-group-p (group &optional article)
1512   "Return non-nil if GROUP (and ARTICLE) come from a news server."
1513   (or (gnus-member-of-valid 'post group) ; Ordinary news group.
1514       (and (gnus-member-of-valid 'post-mail group) ; Combined group.
1515            (eq (gnus-request-type group article) 'news))))
1516
1517 ;; Returns a list of writable groups.
1518 (defun gnus-writable-groups ()
1519   (let ((alist gnus-newsrc-alist)
1520         groups group)
1521     (while (setq group (car (pop alist)))
1522       (unless (gnus-group-read-only-p group)
1523         (push group groups)))
1524     (nreverse groups)))
1525
1526 ;; Check whether to use long file names.
1527 (defun gnus-use-long-file-name (symbol)
1528   ;; The variable has to be set...
1529   (and gnus-use-long-file-name
1530        ;; If it isn't a list, then we return t.
1531        (or (not (listp gnus-use-long-file-name))
1532            ;; If it is a list, and the list contains `symbol', we
1533            ;; return nil.
1534            (not (memq symbol gnus-use-long-file-name)))))
1535
1536 ;; Generate a unique new group name.
1537 (defun gnus-generate-new-group-name (leaf)
1538   (let ((name leaf)
1539         (num 0))
1540     (while (gnus-gethash name gnus-newsrc-hashtb)
1541       (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">")))
1542     name))
1543
1544 (defun gnus-ephemeral-group-p (group)
1545   "Say whether GROUP is ephemeral or not."
1546   (gnus-group-get-parameter group 'quit-config))
1547
1548 (defun gnus-group-quit-config (group)
1549   "Return the quit-config of GROUP."
1550   (gnus-group-get-parameter group 'quit-config))
1551
1552 (defun gnus-kill-ephemeral-group (group)
1553   "Remove ephemeral GROUP from relevant structures."
1554   (gnus-sethash group nil gnus-newsrc-hashtb))
1555
1556 (defun gnus-simplify-mode-line ()
1557   "Make mode lines a bit simpler."
1558   (setq mode-line-modified "-- ")
1559   (when (listp mode-line-format)
1560     (make-local-variable 'mode-line-format)
1561     (setq mode-line-format (copy-sequence mode-line-format))
1562     (when (equal (nth 3 mode-line-format) "   ")
1563       (setcar (nthcdr 3 mode-line-format) " "))))
1564
1565 ;;; Servers and groups.
1566
1567 (defsubst gnus-server-add-address (method)
1568   (let ((method-name (symbol-name (car method))))
1569     (if (and (memq 'address (assoc method-name gnus-valid-select-methods))
1570              (not (assq (intern (concat method-name "-address")) method)))
1571         (append method (list (list (intern (concat method-name "-address"))
1572                                    (nth 1 method))))
1573       method)))
1574
1575 (defsubst gnus-server-get-method (group method)
1576   ;; Input either a server name, and extended server name, or a
1577   ;; select method, and return a select method.
1578   (cond ((stringp method)
1579          (gnus-server-to-method method))
1580         ((equal method gnus-select-method)
1581          gnus-select-method)
1582         ((and (stringp (car method)) group)
1583          (gnus-server-extend-method group method))
1584         ((and method (not group)
1585               (equal (cadr method) ""))
1586          method)
1587         (t
1588          (gnus-server-add-address method))))
1589
1590 (defun gnus-server-to-method (server)
1591   "Map virtual server names to select methods."
1592   (or
1593    ;; Is this a method, perhaps?
1594    (and server (listp server) server)
1595    ;; Perhaps this is the native server?
1596    (and (equal server "native") gnus-select-method)
1597    ;; It should be in the server alist.
1598    (cdr (assoc server gnus-server-alist))
1599    ;; It could be in the predefined server alist.
1600    (cdr (assoc server gnus-predefined-server-alist))
1601    ;; If not, we look through all the opened server
1602    ;; to see whether we can find it there.
1603    (let ((opened gnus-opened-servers))
1604      (while (and opened
1605                  (not (equal server (format "%s:%s" (caaar opened)
1606                                             (cadaar opened)))))
1607        (pop opened))
1608      (caar opened))))
1609
1610 (defmacro gnus-method-equal (ss1 ss2)
1611   "Say whether two servers are equal."
1612   `(let ((s1 ,ss1)
1613          (s2 ,ss2))
1614      (or (equal s1 s2)
1615          (and (= (length s1) (length s2))
1616               (progn
1617                 (while (and s1 (member (car s1) s2))
1618                   (setq s1 (cdr s1)))
1619                 (null s1))))))
1620
1621 (defun gnus-server-equal (m1 m2)
1622   "Say whether two methods are equal."
1623   (let ((m1 (cond ((null m1) gnus-select-method)
1624                   ((stringp m1) (gnus-server-to-method m1))
1625                   (t m1)))
1626         (m2 (cond ((null m2) gnus-select-method)
1627                   ((stringp m2) (gnus-server-to-method m2))
1628                   (t m2))))
1629     (gnus-method-equal m1 m2)))
1630
1631 (defun gnus-servers-using-backend (backend)
1632   "Return a list of known servers using BACKEND."
1633   (let ((opened gnus-opened-servers)
1634         out)
1635     (while opened
1636       (when (eq backend (caaar opened))
1637         (push (caar opened) out))
1638       (pop opened))
1639     out))
1640
1641 (defun gnus-archive-server-wanted-p ()
1642   "Say whether the user wants to use the archive server."
1643   (cond
1644    ((or (not gnus-message-archive-method)
1645         (not gnus-message-archive-group))
1646     nil)
1647    ((and gnus-message-archive-method gnus-message-archive-group)
1648     t)
1649    (t
1650     (let ((active (cadr (assq 'nnfolder-active-file
1651                               gnus-message-archive-method))))
1652       (and active
1653            (file-exists-p active))))))
1654
1655 (defun gnus-group-prefixed-name (group method)
1656   "Return the whole name from GROUP and METHOD."
1657   (and (stringp method) (setq method (gnus-server-to-method method)))
1658   (if (not method)
1659       group
1660     (concat (format "%s" (car method))
1661             (when (and
1662                    (or (assoc (format "%s" (car method))
1663                               (gnus-methods-using 'address))
1664                        (gnus-server-equal method gnus-message-archive-method))
1665                    (nth 1 method)
1666                    (not (string= (nth 1 method) "")))
1667               (concat "+" (nth 1 method)))
1668             ":" group)))
1669
1670 (defun gnus-group-real-prefix (group)
1671   "Return the prefix of the current group name."
1672   (if (string-match "^[^:]+:" group)
1673       (substring group 0 (match-end 0))
1674     ""))
1675
1676 (defun gnus-group-method (group)
1677   "Return the server or method used for selecting GROUP."
1678   (let ((prefix (gnus-group-real-prefix group)))
1679     (if (equal prefix "")
1680         gnus-select-method
1681       (let ((servers gnus-opened-servers)
1682             (server "")
1683             backend possible found)
1684         (if (string-match "^[^\\+]+\\+" prefix)
1685             (setq backend (intern (substring prefix 0 (1- (match-end 0))))
1686                   server (substring prefix (match-end 0) (1- (length prefix))))
1687           (setq backend (intern (substring prefix 0 (1- (length prefix))))))
1688         (while servers
1689           (when (eq (caaar servers) backend)
1690             (setq possible (caar servers))
1691             (when (equal (cadaar servers) server)
1692               (setq found (caar servers))))
1693           (pop servers))
1694         (or (car (rassoc found gnus-server-alist))
1695             found
1696             (car (rassoc possible gnus-server-alist))
1697             possible
1698             (list backend server))))))
1699
1700 (defsubst gnus-secondary-method-p (method)
1701   "Return whether METHOD is a secondary select method."
1702   (let ((methods gnus-secondary-select-methods)
1703         (gmethod (gnus-server-get-method nil method)))
1704     (while (and methods
1705                 (not (equal (gnus-server-get-method nil (car methods))
1706                             gmethod)))
1707       (setq methods (cdr methods)))
1708     methods))
1709
1710 (defun gnus-group-foreign-p (group)
1711   "Say whether a group is foreign or not."
1712   (and (not (gnus-group-native-p group))
1713        (not (gnus-group-secondary-p group))))
1714
1715 (defun gnus-group-native-p (group)
1716   "Say whether the group is native or not."
1717   (not (string-match ":" group)))
1718
1719 (defun gnus-group-secondary-p (group)
1720   "Say whether the group is secondary or not."
1721   (gnus-secondary-method-p (gnus-find-method-for-group group)))
1722
1723 (defun gnus-group-find-parameter (group &optional symbol)
1724   "Return the group parameters for GROUP.
1725 If SYMBOL, return the value of that symbol in the group parameters."
1726   (save-excursion
1727     (set-buffer gnus-group-buffer)
1728     (let ((parameters (funcall gnus-group-get-parameter-function group)))
1729       (if symbol
1730           (gnus-group-parameter-value parameters symbol)
1731         parameters))))
1732
1733 (defun gnus-group-get-parameter (group &optional symbol)
1734   "Return the group parameters for GROUP.
1735 If SYMBOL, return the value of that symbol in the group parameters."
1736   (let ((params (gnus-info-params (gnus-get-info group))))
1737     (if symbol
1738         (gnus-group-parameter-value params symbol)
1739       params)))
1740
1741 (defun gnus-group-parameter-value (params symbol)
1742   "Return the value of SYMBOL in group PARAMS."
1743   (or (car (memq symbol params))        ; It's either a simple symbol
1744       (cdr (assq symbol params))))      ; or a cons.
1745
1746 (defun gnus-group-add-parameter (group param)
1747   "Add parameter PARAM to GROUP."
1748   (let ((info (gnus-get-info group)))
1749     (if (not info)
1750         ()                              ; This is a dead group.  We just ignore it.
1751       ;; Cons the new param to the old one and update.
1752       (gnus-group-set-info (cons param (gnus-info-params info))
1753                            group 'params))))
1754
1755 (defun gnus-group-set-parameter (group name value)
1756   "Set parameter NAME to VALUE in GROUP."
1757   (let ((info (gnus-get-info group)))
1758     (if (not info)
1759         ()                              ; This is a dead group.  We just ignore it.
1760       (let ((old-params (gnus-info-params info))
1761             (new-params (list (cons name value))))
1762         (while old-params
1763           (when (or (not (listp (car old-params)))
1764                     (not (eq (caar old-params) name)))
1765             (setq new-params (append new-params (list (car old-params)))))
1766           (setq old-params (cdr old-params)))
1767         (gnus-group-set-info new-params group 'params)))))
1768
1769 (defun gnus-group-add-score (group &optional score)
1770   "Add SCORE to the GROUP score.
1771 If SCORE is nil, add 1 to the score of GROUP."
1772   (let ((info (gnus-get-info group)))
1773     (when info
1774       (gnus-info-set-score info (+ (gnus-info-score info) (or score 1))))))
1775
1776 ;; Function written by Stainless Steel Rat <ratinox@peorth.gweep.net>
1777 (defun gnus-short-group-name (group &optional levels)
1778   "Collapse GROUP name LEVELS.
1779 Select methods are stripped and any remote host name is stripped down to
1780 just the host name."
1781   (let* ((name "") (foreign "") (depth -1) (skip 1)
1782          (levels (or levels
1783                      (progn
1784                        (while (string-match "\\." group skip)
1785                          (setq skip (match-end 0)
1786                                depth (+ depth 1)))
1787                        depth))))
1788     ;; separate foreign select method from group name and collapse.
1789     ;; if method contains a server, collapse to non-domain server name,
1790     ;; otherwise collapse to select method
1791     (when (string-match ":" group)
1792       (cond ((string-match "+" group)
1793              (let* ((plus (string-match "+" group))
1794                     (colon (string-match ":" group (or plus 0)))
1795                     (dot (string-match "\\." group)))
1796                (setq foreign (concat
1797                               (substring group (+ 1 plus)
1798                                          (cond ((null dot) colon)
1799                                                ((< colon dot) colon)
1800                                                ((< dot colon) dot)))
1801                               ":")
1802                      group (substring group (+ 1 colon)))))
1803             (t
1804              (let* ((colon (string-match ":" group)))
1805                (setq foreign (concat (substring group 0 (+ 1 colon)))
1806                      group (substring group (+ 1 colon)))))))
1807     ;; collapse group name leaving LEVELS uncollapsed elements
1808     (while group
1809       (if (and (string-match "\\." group) (> levels 0))
1810           (setq name (concat name (substring group 0 1))
1811                 group (substring group (match-end 0))
1812                 levels (- levels 1)
1813                 name (concat name "."))
1814         (setq name (concat foreign name group)
1815               group nil)))
1816     name))
1817
1818 \f
1819 ;;;
1820 ;;; Kill file handling.
1821 ;;;
1822
1823 (defun gnus-apply-kill-file ()
1824   "Apply a kill file to the current newsgroup.
1825 Returns the number of articles marked as read."
1826   (if (or (file-exists-p (gnus-newsgroup-kill-file nil))
1827           (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)))
1828       (gnus-apply-kill-file-internal)
1829     0))
1830
1831 (defun gnus-kill-save-kill-buffer ()
1832   (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name)))
1833     (when (get-file-buffer file)
1834       (save-excursion
1835         (set-buffer (get-file-buffer file))
1836         (when (buffer-modified-p)
1837           (save-buffer))
1838         (kill-buffer (current-buffer))))))
1839
1840 (defcustom gnus-kill-file-name "KILL"
1841   "Suffix of the kill files."
1842   :group 'gnus-score
1843   :type 'string)
1844
1845 (defun gnus-newsgroup-kill-file (newsgroup)
1846   "Return the name of a kill file name for NEWSGROUP.
1847 If NEWSGROUP is nil, return the global kill file name instead."
1848   (cond
1849    ;; The global KILL file is placed at top of the directory.
1850    ((or (null newsgroup)
1851         (string-equal newsgroup ""))
1852     (expand-file-name gnus-kill-file-name
1853                       gnus-kill-files-directory))
1854    ;; Append ".KILL" to newsgroup name.
1855    ((gnus-use-long-file-name 'not-kill)
1856     (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup)
1857                               "." gnus-kill-file-name)
1858                       gnus-kill-files-directory))
1859    ;; Place "KILL" under the hierarchical directory.
1860    (t
1861     (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
1862                               "/" gnus-kill-file-name)
1863                       gnus-kill-files-directory))))
1864
1865 ;;; Server things.
1866
1867 (defun gnus-member-of-valid (symbol group)
1868   "Find out if GROUP has SYMBOL as part of its \"valid\" spec."
1869   (memq symbol (assoc
1870                 (symbol-name (car (gnus-find-method-for-group group)))
1871                 gnus-valid-select-methods)))
1872
1873 (defun gnus-method-option-p (method option)
1874   "Return non-nil if select METHOD has OPTION as a parameter."
1875   (when (stringp method)
1876     (setq method (gnus-server-to-method method)))
1877   (memq option (assoc (format "%s" (car method))
1878                       gnus-valid-select-methods)))
1879
1880 (defun gnus-server-extend-method (group method)
1881   ;; This function "extends" a virtual server.  If the server is
1882   ;; "hello", and the select method is ("hello" (my-var "something"))
1883   ;; in the group "alt.alt", this will result in a new virtual server
1884   ;; called "hello+alt.alt".
1885   (let ((entry
1886          (gnus-copy-sequence
1887           (if (gnus-server-equal method gnus-select-method) gnus-select-method
1888             (cdr (assoc (car method) gnus-server-alist))))))
1889     (if (not entry)
1890         method
1891       (setcar (cdr entry) (concat (nth 1 entry) "+" group))
1892       (nconc entry (cdr method)))))
1893
1894 (defun gnus-server-status (method)
1895   "Return the status of METHOD."
1896   (nth 1 (assoc method gnus-opened-servers)))
1897
1898 (defun gnus-group-name-to-method (group)
1899   "Return a select method suitable for GROUP."
1900   (if (string-match ":" group)
1901       (let ((server (substring group 0 (match-beginning 0))))
1902         (if (string-match "\\+" server)
1903             (list (intern (substring server 0 (match-beginning 0)))
1904                   (substring server (match-end 0)))
1905           (list (intern server) "")))
1906     gnus-select-method))
1907
1908 (defun gnus-find-method-for-group (group &optional info)
1909   "Find the select method that GROUP uses."
1910   (or gnus-override-method
1911       (and (not group)
1912            gnus-select-method)
1913       (let ((info (or info (gnus-get-info group)))
1914             method)
1915         (if (or (not info)
1916                 (not (setq method (gnus-info-method info)))
1917                 (equal method "native"))
1918             gnus-select-method
1919           (setq method
1920                 (cond ((stringp method)
1921                        (gnus-server-to-method method))
1922                       ((stringp (car method))
1923                        (gnus-server-extend-method group method))
1924                       (t
1925                        method)))
1926           (cond ((equal (cadr method) "")
1927                  method)
1928                 ((null (cadr method))
1929                  (list (car method) ""))
1930                 (t
1931                  (gnus-server-add-address method)))))))
1932
1933 (defun gnus-check-backend-function (func group)
1934   "Check whether GROUP supports function FUNC."
1935   (ignore-errors
1936     (let ((method (if (stringp group)
1937                       (car (gnus-find-method-for-group group))
1938                     group)))
1939       (unless (featurep method)
1940         (require method))
1941       (fboundp (intern (format "%s-%s" method func))))))
1942
1943 (defun gnus-methods-using (feature)
1944   "Find all methods that have FEATURE."
1945   (let ((valids gnus-valid-select-methods)
1946         outs)
1947     (while valids
1948       (when (memq feature (car valids))
1949         (push (car valids) outs))
1950       (setq valids (cdr valids)))
1951     outs))
1952
1953 (defun gnus-read-group (prompt)
1954   "Prompt the user for a group name.
1955 Disallow illegal group names."
1956   (let ((prefix "")
1957         group)
1958     (while (not group)
1959       (when (string-match
1960              "[: `'\"/]\\|^$"
1961              (setq group (read-string (concat prefix prompt)
1962                                       "" 'gnus-group-history)))
1963         (setq prefix (format "Illegal group name: \"%s\".  " group)
1964               group nil)))
1965     group))
1966
1967 (defun gnus-read-method (prompt)
1968   "Prompt the user for a method.
1969 Allow completion over sensible values."
1970   (let ((method
1971          (completing-read
1972           prompt (append gnus-valid-select-methods gnus-predefined-server-alist
1973                          gnus-server-alist)
1974           nil t nil 'gnus-method-history)))
1975     (cond
1976      ((equal method "")
1977       (setq method gnus-select-method))
1978      ((assoc method gnus-valid-select-methods)
1979       (list (intern method)
1980             (if (memq 'prompt-address
1981                       (assoc method gnus-valid-select-methods))
1982                 (read-string "Address: ")
1983               "")))
1984      ((assoc method gnus-server-alist)
1985       method)
1986      (t
1987       (list (intern method) "")))))
1988
1989 ;;; User-level commands.
1990
1991 ;;;###autoload
1992 (defun gnus-slave-no-server (&optional arg)
1993   "Read network news as a slave, without connecting to local server"
1994   (interactive "P")
1995   (gnus-no-server arg t))
1996
1997 ;;;###autoload
1998 (defun gnus-no-server (&optional arg slave)
1999   "Read network news.
2000 If ARG is a positive number, Gnus will use that as the
2001 startup level.  If ARG is nil, Gnus will be started at level 2.
2002 If ARG is non-nil and not a positive number, Gnus will
2003 prompt the user for the name of an NNTP server to use.
2004 As opposed to `gnus', this command will not connect to the local server."
2005   (interactive "P")
2006   (gnus-no-server-1 arg slave))
2007
2008 ;;;###autoload
2009 (defun gnus-slave (&optional arg)
2010   "Read news as a slave."
2011   (interactive "P")
2012   (gnus arg nil 'slave))
2013
2014 ;;;###autoload
2015 (defun gnus-other-frame (&optional arg)
2016   "Pop up a frame to read news."
2017   (interactive "P")
2018   (let ((window (get-buffer-window gnus-group-buffer)))
2019     (cond (window
2020            (select-frame (window-frame window)))
2021           ((= (length (frame-list)) 1)
2022            (select-frame (make-frame)))
2023           (t
2024            (other-frame 1))))
2025   (gnus arg))
2026
2027 ;;;###autoload
2028 (defun gnus (&optional arg dont-connect slave)
2029   "Read network news.
2030 If ARG is non-nil and a positive number, Gnus will use that as the
2031 startup level.  If ARG is non-nil and not a positive number, Gnus will
2032 prompt the user for the name of an NNTP server to use."
2033   (interactive "P")
2034   (gnus-1 arg dont-connect slave))
2035
2036 ;; Allow redefinition of Gnus functions.
2037
2038 (gnus-ems-redefine)
2039
2040 (provide 'gnus)
2041
2042 ;;; gnus.el ends here