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

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