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