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

   1 ;;; gnus.el --- a newsreader for GNU Emacs
   2
   3 ;; Copyright (C) 1987-1990, 1993-1998, 2000-2011
   4 ;;   Free Software Foundation, Inc.
   5
   6 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
   7 ;;      Lars Magne Ingebrigtsen <larsi@gnus.org>
   8 ;; Keywords: news, mail
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26
  27 ;;; Code:
  28
  29 (eval '(run-hooks 'gnus-load-hook))
  30
  31 ;; For Emacs <22.2 and XEmacs.
  32 (eval-and-compile
  33   (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
  34
  35 (eval-when-compile (require 'cl))
  36 (require 'wid-edit)
  37 (require 'mm-util)
  38 (require 'nnheader)
  39
  40 ;; These are defined afterwards with gnus-define-group-parameter
  41 (defvar gnus-ham-process-destinations)
  42 (defvar gnus-parameter-ham-marks-alist)
  43 (defvar gnus-parameter-spam-marks-alist)
  44 (defvar gnus-spam-autodetect)
  45 (defvar gnus-spam-autodetect-methods)
  46 (defvar gnus-spam-newsgroup-contents)
  47 (defvar gnus-spam-process-destinations)
  48 (defvar gnus-spam-resend-to)
  49 (defvar gnus-ham-resend-to)
  50 (defvar gnus-spam-process-newsgroups)
  51
  52
  53 (defgroup gnus nil
  54   "The coffee-brewing, all singing, all dancing, kitchen sink newsreader."
  55   :group 'news
  56   :group 'mail)
  57
  58 (defgroup gnus-start nil
  59   "Starting your favorite newsreader."
  60   :group 'gnus)
  61
  62 (defgroup gnus-format nil
  63   "Dealing with formatting issues."
  64   :group 'gnus)
  65
  66 (defgroup gnus-charset nil
  67   "Group character set issues."
  68   :link '(custom-manual "(gnus)Charsets")
  69   :version "21.1"
  70   :group 'gnus)
  71
  72 (defgroup gnus-cache nil
  73   "Cache interface."
  74   :link '(custom-manual "(gnus)Article Caching")
  75   :group 'gnus)
  76
  77 (defgroup gnus-registry nil
  78   "Article Registry."
  79   :group 'gnus)
  80
  81 (defgroup gnus-start-server nil
  82   "Server options at startup."
  83   :group 'gnus-start)
  84
  85 ;; These belong to gnus-group.el.
  86 (defgroup gnus-group nil
  87   "Group buffers."
  88   :link '(custom-manual "(gnus)Group Buffer")
  89   :group 'gnus)
  90
  91 (defgroup gnus-group-foreign nil
  92   "Foreign groups."
  93   :link '(custom-manual "(gnus)Foreign Groups")
  94   :group 'gnus-group)
  95
  96 (defgroup gnus-group-new nil
  97   "Automatic subscription of new groups."
  98   :group 'gnus-group)
  99
 100 (defgroup gnus-group-levels nil
 101   "Group levels."
 102   :link '(custom-manual "(gnus)Group Levels")
 103   :group 'gnus-group)
 104
 105 (defgroup gnus-group-select nil
 106   "Selecting a Group."
 107   :link '(custom-manual "(gnus)Selecting a Group")
 108   :group 'gnus-group)
 109
 110 (defgroup gnus-group-listing nil
 111   "Showing slices of the group list."
 112   :link '(custom-manual "(gnus)Listing Groups")
 113   :group 'gnus-group)
 114
 115 (defgroup gnus-group-visual nil
 116   "Sorting the group buffer."
 117   :link '(custom-manual "(gnus)Group Buffer Format")
 118   :group 'gnus-group
 119   :group 'gnus-visual)
 120
 121 (defgroup gnus-group-various nil
 122   "Various group options."
 123   :link '(custom-manual "(gnus)Scanning New Messages")
 124   :group 'gnus-group)
 125
 126 ;; These belong to gnus-sum.el.
 127 (defgroup gnus-summary nil
 128   "Summary buffers."
 129   :link '(custom-manual "(gnus)Summary Buffer")
 130   :group 'gnus)
 131
 132 (defgroup gnus-summary-exit nil
 133   "Leaving summary buffers."
 134   :link '(custom-manual "(gnus)Exiting the Summary Buffer")
 135   :group 'gnus-summary)
 136
 137 (defgroup gnus-summary-marks nil
 138   "Marks used in summary buffers."
 139   :link '(custom-manual "(gnus)Marking Articles")
 140   :group 'gnus-summary)
 141
 142 (defgroup gnus-thread nil
 143   "Ordering articles according to replies."
 144   :link '(custom-manual "(gnus)Threading")
 145   :group 'gnus-summary)
 146
 147 (defgroup gnus-summary-format nil
 148   "Formatting of the summary buffer."
 149   :link '(custom-manual "(gnus)Summary Buffer Format")
 150   :group 'gnus-summary)
 151
 152 (defgroup gnus-summary-choose nil
 153   "Choosing Articles."
 154   :link '(custom-manual "(gnus)Choosing Articles")
 155   :group 'gnus-summary)
 156
 157 (defgroup gnus-summary-maneuvering nil
 158   "Summary movement commands."
 159   :link '(custom-manual "(gnus)Summary Maneuvering")
 160   :group 'gnus-summary)
 161
 162 (defgroup gnus-picon nil
 163   "Show pictures of people, domains, and newsgroups."
 164   :group 'gnus-visual)
 165
 166 (defgroup gnus-summary-mail nil
 167   "Mail group commands."
 168   :link '(custom-manual "(gnus)Mail Group Commands")
 169   :group 'gnus-summary)
 170
 171 (defgroup gnus-summary-sort nil
 172   "Sorting the summary buffer."
 173   :link '(custom-manual "(gnus)Sorting the Summary Buffer")
 174   :group 'gnus-summary)
 175
 176 (defgroup gnus-summary-visual nil
 177   "Highlighting and menus in the summary buffer."
 178   :link '(custom-manual "(gnus)Summary Highlighting")
 179   :group 'gnus-visual
 180   :group 'gnus-summary)
 181
 182 (defgroup gnus-summary-various nil
 183   "Various summary buffer options."
 184   :link '(custom-manual "(gnus)Various Summary Stuff")
 185   :group 'gnus-summary)
 186
 187 (defgroup gnus-summary-pick nil
 188   "Pick mode in the summary buffer."
 189   :link '(custom-manual "(gnus)Pick and Read")
 190   :prefix "gnus-pick-"
 191   :group 'gnus-summary)
 192
 193 (defgroup gnus-summary-tree nil
 194   "Tree display of threads in the summary buffer."
 195   :link '(custom-manual "(gnus)Tree Display")
 196   :prefix "gnus-tree-"
 197   :group 'gnus-summary)
 198
 199 ;; Belongs to gnus-uu.el
 200 (defgroup gnus-extract-view nil
 201   "Viewing extracted files."
 202   :link '(custom-manual "(gnus)Viewing Files")
 203   :group 'gnus-extract)
 204
 205 ;; Belongs to gnus-score.el
 206 (defgroup gnus-score nil
 207   "Score and kill file handling."
 208   :group 'gnus)
 209
 210 (defgroup gnus-score-kill nil
 211   "Kill files."
 212   :group 'gnus-score)
 213
 214 (defgroup gnus-score-adapt nil
 215   "Adaptive score files."
 216   :group 'gnus-score)
 217
 218 (defgroup gnus-score-default nil
 219   "Default values for score files."
 220   :group 'gnus-score)
 221
 222 (defgroup gnus-score-expire nil
 223   "Expiring score rules."
 224   :group 'gnus-score)
 225
 226 (defgroup gnus-score-decay nil
 227   "Decaying score rules."
 228   :group 'gnus-score)
 229
 230 (defgroup gnus-score-files nil
 231   "Score and kill file names."
 232   :group 'gnus-score
 233   :group 'gnus-files)
 234
 235 (defgroup gnus-score-various nil
 236   "Various scoring and killing options."
 237   :group 'gnus-score)
 238
 239 ;; Other
 240 (defgroup gnus-visual nil
 241   "Options controlling the visual fluff."
 242   :group 'gnus
 243   :group 'faces)
 244
 245 (defgroup gnus-agent nil
 246   "Offline support for Gnus."
 247   :group 'gnus)
 248
 249 (defgroup gnus-files nil
 250   "Files used by Gnus."
 251   :group 'gnus)
 252
 253 (defgroup gnus-dribble-file nil
 254   "Auto save file."
 255   :link '(custom-manual "(gnus)Auto Save")
 256   :group 'gnus-files)
 257
 258 (defgroup gnus-newsrc nil
 259   "Storing Gnus state."
 260   :group 'gnus-files)
 261
 262 (defgroup gnus-server nil
 263   "Options related to newsservers and other servers used by Gnus."
 264   :group 'gnus)
 265
 266 (defgroup gnus-server-visual nil
 267   "Highlighting and menus in the server buffer."
 268   :group 'gnus-visual
 269   :group 'gnus-server)
 270
 271 (defgroup gnus-message '((message custom-group))
 272   "Composing replies and followups in Gnus."
 273   :group 'gnus)
 274
 275 (defgroup gnus-meta nil
 276   "Meta variables controlling major portions of Gnus.
 277 In general, modifying these variables does not take effect until Gnus
 278 is restarted, and sometimes reloaded."
 279   :group 'gnus)
 280
 281 (defgroup gnus-various nil
 282   "Other Gnus options."
 283   :link '(custom-manual "(gnus)Various Various")
 284   :group 'gnus)
 285
 286 (defgroup gnus-exit nil
 287   "Exiting Gnus."
 288   :link '(custom-manual "(gnus)Exiting Gnus")
 289   :group 'gnus)
 290
 291 (defgroup gnus-fun nil
 292   "Frivolous Gnus extensions."
 293   :link '(custom-manual "(gnus)Exiting Gnus")
 294   :group 'gnus)
 295
 296 (defconst gnus-version-number "0.18"
 297   "Version number for this version of Gnus.")
 298
 299 (defconst gnus-version (format "No Gnus v%s" gnus-version-number)
 300   "Version string for this version of Gnus.")
 301
 302 (defcustom gnus-inhibit-startup-message nil
 303   "If non-nil, the startup message will not be displayed.
 304 This variable is used before `.gnus.el' is loaded, so it should
 305 be set in `.emacs' instead."
 306   :group 'gnus-start
 307   :type 'boolean)
 308
 309 (unless (featurep 'gnus-xmas)
 310   (defalias 'gnus-make-overlay 'make-overlay)
 311   (defalias 'gnus-delete-overlay 'delete-overlay)
 312   (defalias 'gnus-overlay-get 'overlay-get)
 313   (defalias 'gnus-overlay-put 'overlay-put)
 314   (defalias 'gnus-move-overlay 'move-overlay)
 315   (defalias 'gnus-overlay-buffer 'overlay-buffer)
 316   (defalias 'gnus-overlay-start 'overlay-start)
 317   (defalias 'gnus-overlay-end 'overlay-end)
 318   (defalias 'gnus-overlays-in 'overlays-in)
 319   (defalias 'gnus-extent-detached-p 'ignore)
 320   (defalias 'gnus-extent-start-open 'ignore)
 321   (defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names)
 322   (defalias 'gnus-character-to-event 'identity)
 323   (defalias 'gnus-assq-delete-all 'assq-delete-all)
 324   (defalias 'gnus-add-text-properties 'add-text-properties)
 325   (defalias 'gnus-put-text-property 'put-text-property)
 326   (defvar gnus-mode-line-image-cache t)
 327   (if (fboundp 'find-image)
 328       (defun gnus-mode-line-buffer-identification (line)
 329         (let ((str (car-safe line))
 330               (load-path (mm-image-load-path)))
 331           (if (and (stringp str)
 332                    (string-match "^Gnus:" str))
 333               (progn (add-text-properties
 334                       0 5
 335                       (list 'display
 336                             (if (eq t gnus-mode-line-image-cache)
 337                                 (setq gnus-mode-line-image-cache
 338                                       (find-image
 339                                        '((:type xpm :file "gnus-pointer.xpm"
 340                                                 :ascent center)
 341                                          (:type xbm :file "gnus-pointer.xbm"
 342                                                 :ascent center))))
 343                               gnus-mode-line-image-cache)
 344                             'help-echo (format
 345                                         "This is %s, %s."
 346                                         gnus-version (gnus-emacs-version)))
 347                       str)
 348                      (list str))
 349             line)))
 350     (defalias 'gnus-mode-line-buffer-identification 'identity))
 351   (defalias 'gnus-deactivate-mark 'deactivate-mark)
 352   (defalias 'gnus-window-edges 'window-edges)
 353   (defalias 'gnus-key-press-event-p 'numberp)
 354   ;;(defalias 'gnus-decode-rfc1522 'ignore)
 355   )
 356
 357 ;; We define these group faces here to avoid the display
 358 ;; update forced when creating new faces.
 359
 360 (defface gnus-group-news-1
 361   '((((class color)
 362       (background dark))
 363      (:foreground "PaleTurquoise" :bold t))
 364     (((class color)
 365       (background light))
 366      (:foreground "ForestGreen" :bold t))
 367     (t
 368      ()))
 369   "Level 1 newsgroup face."
 370   :group 'gnus-group)
 371 ;; backward-compatibility alias
 372 (put 'gnus-group-news-1-face 'face-alias 'gnus-group-news-1)
 373 (put 'gnus-group-news-1-face 'obsolete-face "22.1")
 374
 375 (defface gnus-group-news-1-empty
 376   '((((class color)
 377       (background dark))
 378      (:foreground "PaleTurquoise"))
 379     (((class color)
 380       (background light))
 381      (:foreground "ForestGreen"))
 382     (t
 383      ()))
 384   "Level 1 empty newsgroup face."
 385   :group 'gnus-group)
 386 ;; backward-compatibility alias
 387 (put 'gnus-group-news-1-empty-face 'face-alias 'gnus-group-news-1-empty)
 388 (put 'gnus-group-news-1-empty-face 'obsolete-face "22.1")
 389
 390 (defface gnus-group-news-2
 391   '((((class color)
 392       (background dark))
 393      (:foreground "turquoise" :bold t))
 394     (((class color)
 395       (background light))
 396      (:foreground "CadetBlue4" :bold t))
 397     (t
 398      ()))
 399   "Level 2 newsgroup face."
 400   :group 'gnus-group)
 401 ;; backward-compatibility alias
 402 (put 'gnus-group-news-2-face 'face-alias 'gnus-group-news-2)
 403 (put 'gnus-group-news-2-face 'obsolete-face "22.1")
 404
 405 (defface gnus-group-news-2-empty
 406   '((((class color)
 407       (background dark))
 408      (:foreground "turquoise"))
 409     (((class color)
 410       (background light))
 411      (:foreground "CadetBlue4"))
 412     (t
 413      ()))
 414   "Level 2 empty newsgroup face."
 415   :group 'gnus-group)
 416 ;; backward-compatibility alias
 417 (put 'gnus-group-news-2-empty-face 'face-alias 'gnus-group-news-2-empty)
 418 (put 'gnus-group-news-2-empty-face 'obsolete-face "22.1")
 419
 420 (defface gnus-group-news-3
 421   '((((class color)
 422       (background dark))
 423      (:bold t))
 424     (((class color)
 425       (background light))
 426      (:bold t))
 427     (t
 428      ()))
 429   "Level 3 newsgroup face."
 430   :group 'gnus-group)
 431 ;; backward-compatibility alias
 432 (put 'gnus-group-news-3-face 'face-alias 'gnus-group-news-3)
 433 (put 'gnus-group-news-3-face 'obsolete-face "22.1")
 434
 435 (defface gnus-group-news-3-empty
 436   '((((class color)
 437       (background dark))
 438      ())
 439     (((class color)
 440       (background light))
 441      ())
 442     (t
 443      ()))
 444   "Level 3 empty newsgroup face."
 445   :group 'gnus-group)
 446 ;; backward-compatibility alias
 447 (put 'gnus-group-news-3-empty-face 'face-alias 'gnus-group-news-3-empty)
 448 (put 'gnus-group-news-3-empty-face 'obsolete-face "22.1")
 449
 450 (defface gnus-group-news-4
 451   '((((class color)
 452       (background dark))
 453      (:bold t))
 454     (((class color)
 455       (background light))
 456      (:bold t))
 457     (t
 458      ()))
 459   "Level 4 newsgroup face."
 460   :group 'gnus-group)
 461 ;; backward-compatibility alias
 462 (put 'gnus-group-news-4-face 'face-alias 'gnus-group-news-4)
 463 (put 'gnus-group-news-4-face 'obsolete-face "22.1")
 464
 465 (defface gnus-group-news-4-empty
 466   '((((class color)
 467       (background dark))
 468      ())
 469     (((class color)
 470       (background light))
 471      ())
 472     (t
 473      ()))
 474   "Level 4 empty newsgroup face."
 475   :group 'gnus-group)
 476 ;; backward-compatibility alias
 477 (put 'gnus-group-news-4-empty-face 'face-alias 'gnus-group-news-4-empty)
 478 (put 'gnus-group-news-4-empty-face 'obsolete-face "22.1")
 479
 480 (defface gnus-group-news-5
 481   '((((class color)
 482       (background dark))
 483      (:bold t))
 484     (((class color)
 485       (background light))
 486      (:bold t))
 487     (t
 488      ()))
 489   "Level 5 newsgroup face."
 490   :group 'gnus-group)
 491 ;; backward-compatibility alias
 492 (put 'gnus-group-news-5-face 'face-alias 'gnus-group-news-5)
 493 (put 'gnus-group-news-5-face 'obsolete-face "22.1")
 494
 495 (defface gnus-group-news-5-empty
 496   '((((class color)
 497       (background dark))
 498      ())
 499     (((class color)
 500       (background light))
 501      ())
 502     (t
 503      ()))
 504   "Level 5 empty newsgroup face."
 505   :group 'gnus-group)
 506 ;; backward-compatibility alias
 507 (put 'gnus-group-news-5-empty-face 'face-alias 'gnus-group-news-5-empty)
 508 (put 'gnus-group-news-5-empty-face 'obsolete-face "22.1")
 509
 510 (defface gnus-group-news-6
 511   '((((class color)
 512       (background dark))
 513      (:bold t))
 514     (((class color)
 515       (background light))
 516      (:bold t))
 517     (t
 518      ()))
 519   "Level 6 newsgroup face."
 520   :group 'gnus-group)
 521 ;; backward-compatibility alias
 522 (put 'gnus-group-news-6-face 'face-alias 'gnus-group-news-6)
 523 (put 'gnus-group-news-6-face 'obsolete-face "22.1")
 524
 525 (defface gnus-group-news-6-empty
 526   '((((class color)
 527       (background dark))
 528      ())
 529     (((class color)
 530       (background light))
 531      ())
 532     (t
 533      ()))
 534   "Level 6 empty newsgroup face."
 535   :group 'gnus-group)
 536 ;; backward-compatibility alias
 537 (put 'gnus-group-news-6-empty-face 'face-alias 'gnus-group-news-6-empty)
 538 (put 'gnus-group-news-6-empty-face 'obsolete-face "22.1")
 539
 540 (defface gnus-group-news-low
 541   '((((class color)
 542       (background dark))
 543      (:foreground "DarkTurquoise" :bold t))
 544     (((class color)
 545       (background light))
 546      (:foreground "DarkGreen" :bold t))
 547     (t
 548      ()))
 549   "Low level newsgroup face."
 550   :group 'gnus-group)
 551 ;; backward-compatibility alias
 552 (put 'gnus-group-news-low-face 'face-alias 'gnus-group-news-low)
 553 (put 'gnus-group-news-low-face 'obsolete-face "22.1")
 554
 555 (defface gnus-group-news-low-empty
 556   '((((class color)
 557       (background dark))
 558      (:foreground "DarkTurquoise"))
 559     (((class color)
 560       (background light))
 561      (:foreground "DarkGreen"))
 562     (t
 563      ()))
 564   "Low level empty newsgroup face."
 565   :group 'gnus-group)
 566 ;; backward-compatibility alias
 567 (put 'gnus-group-news-low-empty-face 'face-alias 'gnus-group-news-low-empty)
 568 (put 'gnus-group-news-low-empty-face 'obsolete-face "22.1")
 569
 570 (defface gnus-group-mail-1
 571   '((((class color)
 572       (background dark))
 573      (:foreground "#e1ffe1" :bold t))
 574     (((class color)
 575       (background light))
 576      (:foreground "DeepPink3" :bold t))
 577     (t
 578      (:bold t)))
 579   "Level 1 mailgroup face."
 580   :group 'gnus-group)
 581 ;; backward-compatibility alias
 582 (put 'gnus-group-mail-1-face 'face-alias 'gnus-group-mail-1)
 583 (put 'gnus-group-mail-1-face 'obsolete-face "22.1")
 584
 585 (defface gnus-group-mail-1-empty
 586   '((((class color)
 587       (background dark))
 588      (:foreground "#e1ffe1"))
 589     (((class color)
 590       (background light))
 591      (:foreground "DeepPink3"))
 592     (t
 593      (:italic t :bold t)))
 594   "Level 1 empty mailgroup face."
 595   :group 'gnus-group)
 596 ;; backward-compatibility alias
 597 (put 'gnus-group-mail-1-empty-face 'face-alias 'gnus-group-mail-1-empty)
 598 (put 'gnus-group-mail-1-empty-face 'obsolete-face "22.1")
 599
 600 (defface gnus-group-mail-2
 601   '((((class color)
 602       (background dark))
 603      (:foreground "DarkSeaGreen1" :bold t))
 604     (((class color)
 605       (background light))
 606      (:foreground "HotPink3" :bold t))
 607     (t
 608      (:bold t)))
 609   "Level 2 mailgroup face."
 610   :group 'gnus-group)
 611 ;; backward-compatibility alias
 612 (put 'gnus-group-mail-2-face 'face-alias 'gnus-group-mail-2)
 613 (put 'gnus-group-mail-2-face 'obsolete-face "22.1")
 614
 615 (defface gnus-group-mail-2-empty
 616   '((((class color)
 617       (background dark))
 618      (:foreground "DarkSeaGreen1"))
 619     (((class color)
 620       (background light))
 621      (:foreground "HotPink3"))
 622     (t
 623      (:bold t)))
 624   "Level 2 empty mailgroup face."
 625   :group 'gnus-group)
 626 ;; backward-compatibility alias
 627 (put 'gnus-group-mail-2-empty-face 'face-alias 'gnus-group-mail-2-empty)
 628 (put 'gnus-group-mail-2-empty-face 'obsolete-face "22.1")
 629
 630 (defface gnus-group-mail-3
 631   '((((class color)
 632       (background dark))
 633      (:foreground "aquamarine1" :bold t))
 634     (((class color)
 635       (background light))
 636      (:foreground "magenta4" :bold t))
 637     (t
 638      (:bold t)))
 639   "Level 3 mailgroup face."
 640   :group 'gnus-group)
 641 ;; backward-compatibility alias
 642 (put 'gnus-group-mail-3-face 'face-alias 'gnus-group-mail-3)
 643 (put 'gnus-group-mail-3-face 'obsolete-face "22.1")
 644
 645 (defface gnus-group-mail-3-empty
 646   '((((class color)
 647       (background dark))
 648      (:foreground "aquamarine1"))
 649     (((class color)
 650       (background light))
 651      (:foreground "magenta4"))
 652     (t
 653      ()))
 654   "Level 3 empty mailgroup face."
 655   :group 'gnus-group)
 656 ;; backward-compatibility alias
 657 (put 'gnus-group-mail-3-empty-face 'face-alias 'gnus-group-mail-3-empty)
 658 (put 'gnus-group-mail-3-empty-face 'obsolete-face "22.1")
 659
 660 (defface gnus-group-mail-low
 661   '((((class color)
 662       (background dark))
 663      (:foreground "aquamarine2" :bold t))
 664     (((class color)
 665       (background light))
 666      (:foreground "DeepPink4" :bold t))
 667     (t
 668      (:bold t)))
 669   "Low level mailgroup face."
 670   :group 'gnus-group)
 671 ;; backward-compatibility alias
 672 (put 'gnus-group-mail-low-face 'face-alias 'gnus-group-mail-low)
 673 (put 'gnus-group-mail-low-face 'obsolete-face "22.1")
 674
 675 (defface gnus-group-mail-low-empty
 676   '((((class color)
 677       (background dark))
 678      (:foreground "aquamarine2"))
 679     (((class color)
 680       (background light))
 681      (:foreground "DeepPink4"))
 682     (t
 683      (:bold t)))
 684   "Low level empty mailgroup face."
 685   :group 'gnus-group)
 686 ;; backward-compatibility alias
 687 (put 'gnus-group-mail-low-empty-face 'face-alias 'gnus-group-mail-low-empty)
 688 (put 'gnus-group-mail-low-empty-face 'obsolete-face "22.1")
 689
 690 ;; Summary mode faces.
 691
 692 (defface gnus-summary-selected '((t (:underline t)))
 693   "Face used for selected articles."
 694   :group 'gnus-summary)
 695 ;; backward-compatibility alias
 696 (put 'gnus-summary-selected-face 'face-alias 'gnus-summary-selected)
 697 (put 'gnus-summary-selected-face 'obsolete-face "22.1")
 698
 699 (defface gnus-summary-cancelled
 700   '((((class color))
 701      (:foreground "yellow" :background "black")))
 702   "Face used for cancelled articles."
 703   :group 'gnus-summary)
 704 ;; backward-compatibility alias
 705 (put 'gnus-summary-cancelled-face 'face-alias 'gnus-summary-cancelled)
 706 (put 'gnus-summary-cancelled-face 'obsolete-face "22.1")
 707
 708 (defface gnus-summary-high-ticked
 709   '((((class color)
 710       (background dark))
 711      (:foreground "pink" :bold t))
 712     (((class color)
 713       (background light))
 714      (:foreground "firebrick" :bold t))
 715     (t
 716      (:bold t)))
 717   "Face used for high interest ticked articles."
 718   :group 'gnus-summary)
 719 ;; backward-compatibility alias
 720 (put 'gnus-summary-high-ticked-face 'face-alias 'gnus-summary-high-ticked)
 721 (put 'gnus-summary-high-ticked-face 'obsolete-face "22.1")
 722
 723 (defface gnus-summary-low-ticked
 724   '((((class color)
 725       (background dark))
 726      (:foreground "pink" :italic t))
 727     (((class color)
 728       (background light))
 729      (:foreground "firebrick" :italic t))
 730     (t
 731      (:italic t)))
 732   "Face used for low interest ticked articles."
 733   :group 'gnus-summary)
 734 ;; backward-compatibility alias
 735 (put 'gnus-summary-low-ticked-face 'face-alias 'gnus-summary-low-ticked)
 736 (put 'gnus-summary-low-ticked-face 'obsolete-face "22.1")
 737
 738 (defface gnus-summary-normal-ticked
 739   '((((class color)
 740       (background dark))
 741      (:foreground "pink"))
 742     (((class color)
 743       (background light))
 744      (:foreground "firebrick"))
 745     (t
 746      ()))
 747   "Face used for normal interest ticked articles."
 748   :group 'gnus-summary)
 749 ;; backward-compatibility alias
 750 (put 'gnus-summary-normal-ticked-face 'face-alias 'gnus-summary-normal-ticked)
 751 (put 'gnus-summary-normal-ticked-face 'obsolete-face "22.1")
 752
 753 (defface gnus-summary-high-ancient
 754   '((((class color)
 755       (background dark))
 756      (:foreground "SkyBlue" :bold t))
 757     (((class color)
 758       (background light))
 759      (:foreground "RoyalBlue" :bold t))
 760     (t
 761      (:bold t)))
 762   "Face used for high interest ancient articles."
 763   :group 'gnus-summary)
 764 ;; backward-compatibility alias
 765 (put 'gnus-summary-high-ancient-face 'face-alias 'gnus-summary-high-ancient)
 766 (put 'gnus-summary-high-ancient-face 'obsolete-face "22.1")
 767
 768 (defface gnus-summary-low-ancient
 769   '((((class color)
 770       (background dark))
 771      (:foreground "SkyBlue" :italic t))
 772     (((class color)
 773       (background light))
 774      (:foreground "RoyalBlue" :italic t))
 775     (t
 776      (:italic t)))
 777   "Face used for low interest ancient articles."
 778   :group 'gnus-summary)
 779 ;; backward-compatibility alias
 780 (put 'gnus-summary-low-ancient-face 'face-alias 'gnus-summary-low-ancient)
 781 (put 'gnus-summary-low-ancient-face 'obsolete-face "22.1")
 782
 783 (defface gnus-summary-normal-ancient
 784   '((((class color)
 785       (background dark))
 786      (:foreground "SkyBlue"))
 787     (((class color)
 788       (background light))
 789      (:foreground "RoyalBlue"))
 790     (t
 791      ()))
 792   "Face used for normal interest ancient articles."
 793   :group 'gnus-summary)
 794 ;; backward-compatibility alias
 795 (put 'gnus-summary-normal-ancient-face 'face-alias 'gnus-summary-normal-ancient)
 796 (put 'gnus-summary-normal-ancient-face 'obsolete-face "22.1")
 797
 798 (defface gnus-summary-high-undownloaded
 799    '((((class color)
 800        (background light))
 801       (:bold t :foreground "cyan4"))
 802      (((class color) (background dark))
 803       (:bold t :foreground "LightGray"))
 804      (t (:inverse-video t :bold t)))
 805   "Face used for high interest uncached articles."
 806   :group 'gnus-summary)
 807 ;; backward-compatibility alias
 808 (put 'gnus-summary-high-undownloaded-face 'face-alias 'gnus-summary-high-undownloaded)
 809 (put 'gnus-summary-high-undownloaded-face 'obsolete-face "22.1")
 810
 811 (defface gnus-summary-low-undownloaded
 812    '((((class color)
 813        (background light))
 814       (:italic t :foreground "cyan4" :bold nil))
 815      (((class color) (background dark))
 816       (:italic t :foreground "LightGray" :bold nil))
 817      (t (:inverse-video t :italic t)))
 818   "Face used for low interest uncached articles."
 819   :group 'gnus-summary)
 820 ;; backward-compatibility alias
 821 (put 'gnus-summary-low-undownloaded-face 'face-alias 'gnus-summary-low-undownloaded)
 822 (put 'gnus-summary-low-undownloaded-face 'obsolete-face "22.1")
 823
 824 (defface gnus-summary-normal-undownloaded
 825    '((((class color)
 826        (background light))
 827       (:foreground "cyan4" :bold nil))
 828      (((class color) (background dark))
 829       (:foreground "LightGray" :bold nil))
 830      (t (:inverse-video t)))
 831   "Face used for normal interest uncached articles."
 832   :group 'gnus-summary)
 833 ;; backward-compatibility alias
 834 (put 'gnus-summary-normal-undownloaded-face 'face-alias 'gnus-summary-normal-undownloaded)
 835 (put 'gnus-summary-normal-undownloaded-face 'obsolete-face "22.1")
 836
 837 (defface gnus-summary-high-unread
 838   '((t
 839      (:bold t)))
 840   "Face used for high interest unread articles."
 841   :group 'gnus-summary)
 842 ;; backward-compatibility alias
 843 (put 'gnus-summary-high-unread-face 'face-alias 'gnus-summary-high-unread)
 844 (put 'gnus-summary-high-unread-face 'obsolete-face "22.1")
 845
 846 (defface gnus-summary-low-unread
 847   '((t
 848      (:italic t)))
 849   "Face used for low interest unread articles."
 850   :group 'gnus-summary)
 851 ;; backward-compatibility alias
 852 (put 'gnus-summary-low-unread-face 'face-alias 'gnus-summary-low-unread)
 853 (put 'gnus-summary-low-unread-face 'obsolete-face "22.1")
 854
 855 (defface gnus-summary-normal-unread
 856   '((t
 857      ()))
 858   "Face used for normal interest unread articles."
 859   :group 'gnus-summary)
 860 ;; backward-compatibility alias
 861 (put 'gnus-summary-normal-unread-face 'face-alias 'gnus-summary-normal-unread)
 862 (put 'gnus-summary-normal-unread-face 'obsolete-face "22.1")
 863
 864 (defface gnus-summary-high-read
 865   '((((class color)
 866       (background dark))
 867      (:foreground "PaleGreen"
 868                   :bold t))
 869     (((class color)
 870       (background light))
 871      (:foreground "DarkGreen"
 872                   :bold t))
 873     (t
 874      (:bold t)))
 875   "Face used for high interest read articles."
 876   :group 'gnus-summary)
 877 ;; backward-compatibility alias
 878 (put 'gnus-summary-high-read-face 'face-alias 'gnus-summary-high-read)
 879 (put 'gnus-summary-high-read-face 'obsolete-face "22.1")
 880
 881 (defface gnus-summary-low-read
 882   '((((class color)
 883       (background dark))
 884      (:foreground "PaleGreen"
 885                   :italic t))
 886     (((class color)
 887       (background light))
 888      (:foreground "DarkGreen"
 889                   :italic t))
 890     (t
 891      (:italic t)))
 892   "Face used for low interest read articles."
 893   :group 'gnus-summary)
 894 ;; backward-compatibility alias
 895 (put 'gnus-summary-low-read-face 'face-alias 'gnus-summary-low-read)
 896 (put 'gnus-summary-low-read-face 'obsolete-face "22.1")
 897
 898 (defface gnus-summary-normal-read
 899   '((((class color)
 900       (background dark))
 901      (:foreground "PaleGreen"))
 902     (((class color)
 903       (background light))
 904      (:foreground "DarkGreen"))
 905     (t
 906      ()))
 907   "Face used for normal interest read articles."
 908   :group 'gnus-summary)
 909 ;; backward-compatibility alias
 910 (put 'gnus-summary-normal-read-face 'face-alias 'gnus-summary-normal-read)
 911 (put 'gnus-summary-normal-read-face 'obsolete-face "22.1")
 912
 913
 914 ;;;
 915 ;;; Gnus buffers
 916 ;;;
 917
 918 (defvar gnus-buffers nil
 919   "List of buffers handled by Gnus.")
 920
 921 (defun gnus-get-buffer-create (name)
 922   "Do the same as `get-buffer-create', but store the created buffer."
 923   (or (get-buffer name)
 924       (car (push (get-buffer-create name) gnus-buffers))))
 925
 926 (defun gnus-add-buffer ()
 927   "Add the current buffer to the list of Gnus buffers."
 928   (push (current-buffer) gnus-buffers))
 929
 930 (defmacro gnus-kill-buffer (buffer)
 931   "Kill BUFFER and remove from the list of Gnus buffers."
 932   `(let ((buf ,buffer))
 933      (when (gnus-buffer-exists-p buf)
 934        (setq gnus-buffers (delete (get-buffer buf) gnus-buffers))
 935        (kill-buffer buf))))
 936
 937 (defun gnus-buffers ()
 938   "Return a list of live Gnus buffers."
 939   (while (and gnus-buffers
 940               (not (buffer-name (car gnus-buffers))))
 941     (pop gnus-buffers))
 942   (let ((buffers gnus-buffers))
 943     (while (cdr buffers)
 944       (if (buffer-name (cadr buffers))
 945           (pop buffers)
 946         (setcdr buffers (cddr buffers)))))
 947   gnus-buffers)
 948
 949 ;;; Splash screen.
 950
 951 (defvar gnus-group-buffer "*Group*"
 952   "Name of the Gnus group buffer.")
 953
 954 (defface gnus-splash
 955   '((((class color)
 956       (background dark))
 957      (:foreground "#cccccc"))
 958     (((class color)
 959       (background light))
 960      (:foreground "#888888"))
 961     (t
 962      ()))
 963   "Face for the splash screen."
 964   :group 'gnus-start)
 965 ;; backward-compatibility alias
 966 (put 'gnus-splash-face 'face-alias 'gnus-splash)
 967 (put 'gnus-splash-face 'obsolete-face "22.1")
 968
 969 (defun gnus-splash ()
 970   (save-excursion
 971     (switch-to-buffer (gnus-get-buffer-create gnus-group-buffer))
 972     (let ((buffer-read-only nil))
 973       (erase-buffer)
 974       (unless gnus-inhibit-startup-message
 975         (gnus-group-startup-message)
 976         (sit-for 0)))))
 977
 978 (defun gnus-indent-rigidly (start end arg)
 979   "Indent rigidly using only spaces and no tabs."
 980   (save-excursion
 981     (save-restriction
 982       (narrow-to-region start end)
 983       (let ((tab-width 8))
 984         (indent-rigidly start end arg)
 985         ;; We translate tabs into spaces -- not everybody uses
 986         ;; an 8-character tab.
 987         (goto-char (point-min))
 988         (while (search-forward "\t" nil t)
 989           (replace-match "        " t t))))))
 990
 991 ;;(format "%02x%02x%02x" 114 66 20) "724214"
 992
 993 (defvar gnus-logo-color-alist
 994   '((flame "#cc3300" "#ff2200")
 995     (pine "#c0cc93" "#f8ffb8")
 996     (moss "#a1cc93" "#d2ffb8")
 997     (irish "#04cc90" "#05ff97")
 998     (sky "#049acc" "#05deff")
 999     (tin "#6886cc" "#82b6ff")
1000     (velvet "#7c68cc" "#8c82ff")
1001     (grape "#b264cc" "#cf7df")
1002     (labia "#cc64c2" "#fd7dff")
1003     (berry "#cc6485" "#ff7db5")
1004     (dino "#724214" "#1e3f03")
1005     (oort "#cccccc" "#888888")
1006     (storm "#666699" "#99ccff")
1007     (pdino "#9999cc" "#99ccff")
1008     (purp "#9999cc" "#666699")
1009     (no "#ff0000" "#ffff00")
1010     (neutral "#b4b4b4" "#878787")
1011     (september "#bf9900" "#ffcc00"))
1012   "Color alist used for the Gnus logo.")
1013
1014 (defcustom gnus-logo-color-style 'no
1015   "*Color styles used for the Gnus logo."
1016   :type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem)))
1017                            gnus-logo-color-alist))
1018   :group 'gnus-xmas)
1019
1020 (defvar gnus-logo-colors
1021   (cdr (assq gnus-logo-color-style gnus-logo-color-alist))
1022   "Colors used for the Gnus logo.")
1023
1024 (declare-function image-size "image.c" (spec &optional pixels frame))
1025
1026 (defun gnus-group-startup-message (&optional x y)
1027   "Insert startup message in current buffer."
1028   ;; Insert the message.
1029   (erase-buffer)
1030   (unless (and
1031            (fboundp 'find-image)
1032            (display-graphic-p)
1033            ;; Make sure the library defining `image-load-path' is
1034            ;; loaded (`find-image' is autoloaded) (and discard the
1035            ;; result).  Else, we may get "defvar ignored because
1036            ;; image-load-path is let-bound" when calling `find-image'
1037            ;; below.
1038            (or (find-image '(nil (:type xpm :file "gnus.xpm"))) t)
1039            (let* ((data-directory (nnheader-find-etc-directory "images/gnus"))
1040                   (image-load-path (cond (data-directory
1041                                           (list data-directory))
1042                                          ((boundp 'image-load-path)
1043                                           (symbol-value 'image-load-path))
1044                                          (t load-path)))
1045                   (image (gnus-splash-svg-color-symbols (find-image
1046                           `((:type svg :file "gnus.svg"
1047                                    :color-symbols
1048                                    (("#bf9900" . ,(car gnus-logo-colors))
1049                                     ("#ffcc00" . ,(cadr gnus-logo-colors))))
1050                             (:type xpm :file "gnus.xpm"
1051                                    :color-symbols
1052                                    (("thing" . ,(car gnus-logo-colors))
1053                                     ("shadow" . ,(cadr gnus-logo-colors))))
1054                             (:type png :file "gnus.png")
1055                             (:type pbm :file "gnus.pbm"
1056                                    ;; Account for the pbm's background.
1057                                    :background ,(face-foreground 'gnus-splash)
1058                                    :foreground ,(face-background 'default))
1059                             (:type xbm :file "gnus.xbm"
1060                                    ;; Account for the xbm's background.
1061                                    :background ,(face-foreground 'gnus-splash)
1062                                    :foreground ,(face-background 'default)))))))
1063              (when image
1064                (let ((size (image-size image)))
1065                  (insert-char ?\n (max 0 (round (- (window-height)
1066                                                    (or y (cdr size)) 1) 2)))
1067                  (insert-char ?\  (max 0 (round (- (window-width)
1068                                                    (or x (car size))) 2)))
1069                  (insert-image image))
1070                (goto-char (point-min))
1071                t)))
1072     (insert
1073      (format "
1074           _    ___ _             _
1075           _ ___ __ ___  __    _ ___
1076           __   _     ___    __  ___
1077               _           ___     _
1078              _  _ __             _
1079              ___   __            _
1080                    __           _
1081                     _      _   _
1082                    _      _    _
1083                       _  _    _
1084                   __  ___
1085                  _   _ _     _
1086                 _   _
1087               _    _
1088              _    _
1089             _
1090           __
1091
1092 "))
1093     ;; And then hack it.
1094     (gnus-indent-rigidly (point-min) (point-max)
1095                          (/ (max (- (window-width) (or x 46)) 0) 2))
1096     (goto-char (point-min))
1097     (forward-line 1)
1098     (let* ((pheight (count-lines (point-min) (point-max)))
1099            (wheight (window-height))
1100            (rest (- wheight pheight)))
1101       (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
1102     ;; Fontify some.
1103     (put-text-property (point-min) (point-max) 'face 'gnus-splash)
1104     (goto-char (point-min))
1105     (setq mode-line-buffer-identification (concat " " gnus-version))
1106     (set-buffer-modified-p t)))
1107
1108 (defun gnus-splash-svg-color-symbols (list)
1109   "Do color-symbol search-and-replace in svg file."
1110   (let ((type (plist-get (cdr list) :type))
1111         (file (plist-get (cdr list) :file))
1112         (color-symbols (plist-get (cdr list) :color-symbols)))
1113     (if (string= type "svg")
1114         (let ((data (with-temp-buffer (insert-file-contents file)
1115                                       (buffer-string))))
1116           (mapc (lambda (rule)
1117                   (setq data (replace-regexp-in-string
1118                               (concat "fill:" (car rule))
1119                               (concat "fill:" (cdr rule)) data)))
1120                 color-symbols)
1121           (cons (car list) (list :type type :data data)))
1122        list)))
1123
1124 (eval-when (load)
1125   (let ((command (format "%s" this-command)))
1126     (when (string-match "gnus" command)
1127       (if (string-match "gnus-other-frame" command)
1128           (gnus-get-buffer-create gnus-group-buffer)
1129         (gnus-splash)))))
1130
1131 ;;; Do the rest.
1132
1133 (require 'gnus-util)
1134 (require 'nnheader)
1135
1136 (defcustom gnus-parameters nil
1137   "Alist of group parameters.
1138
1139 For example:
1140    ((\"mail\\\\..*\"  (gnus-show-threads nil)
1141                   (gnus-use-scoring nil)
1142                   (gnus-summary-line-format
1143                         \"%U%R%z%I%(%[%d:%ub%-23,23f%]%) %s\\n\")
1144                   (gcc-self . t)
1145                   (display . all))
1146      (\"mail\\\\.me\" (gnus-use-scoring  t))
1147      (\"list\\\\..*\" (total-expire . t)
1148                   (broken-reply-to . t)))"
1149   :version "22.1"
1150   :group 'gnus-group-various
1151   :type '(repeat (cons regexp
1152                        (repeat sexp))))
1153
1154 (defcustom gnus-parameters-case-fold-search 'default
1155   "If it is t, ignore case of group names specified in `gnus-parameters'.
1156 If it is nil, don't ignore case.  If it is `default', which is for the
1157 backward compatibility, use the value of `case-fold-search'."
1158   :version "22.1"
1159   :group 'gnus-group-various
1160   :type '(choice :format "%{%t%}:\n %[Value Menu%] %v"
1161                  (const :tag "Use `case-fold-search'" default)
1162                  (const nil)
1163                  (const t)))
1164
1165 (defvar gnus-group-parameters-more nil)
1166
1167 (defmacro gnus-define-group-parameter (param &rest rest)
1168   "Define a group parameter PARAM.
1169 REST is a plist of following:
1170 :type               One of `bool', `list' or nil.
1171 :function           The name of the function.
1172 :function-document  The documentation of the function.
1173 :parameter-type     The type for customizing the parameter.
1174 :parameter-document The documentation for the parameter.
1175 :variable           The name of the variable.
1176 :variable-document  The documentation for the variable.
1177 :variable-group     The group for customizing the variable.
1178 :variable-type      The type for customizing the variable.
1179 :variable-default   The default value of the variable."
1180   (let* ((type (plist-get rest :type))
1181          (parameter-type (plist-get rest :parameter-type))
1182          (parameter-document (plist-get rest :parameter-document))
1183          (function (or (plist-get rest :function)
1184                        (intern (format "gnus-parameter-%s" param))))
1185          (function-document (or (plist-get rest :function-document) ""))
1186          (variable (or (plist-get rest :variable)
1187                        (intern (format "gnus-parameter-%s-alist" param))))
1188          (variable-document (or (plist-get rest :variable-document) ""))
1189          (variable-group (plist-get rest :variable-group))
1190          (variable-type (or (plist-get rest :variable-type)
1191                             `(quote (repeat
1192                                      (list (regexp :tag "Group")
1193                                            ,(car (cdr parameter-type)))))))
1194          (variable-default (plist-get rest :variable-default)))
1195     (list
1196      'progn
1197      `(defcustom ,variable ,variable-default
1198         ,variable-document
1199         :group 'gnus-group-parameter
1200         :group ',variable-group
1201         :type ,variable-type)
1202      `(setq gnus-group-parameters-more
1203             (delq (assq ',param gnus-group-parameters-more)
1204                   gnus-group-parameters-more))
1205      `(add-to-list 'gnus-group-parameters-more
1206                    (list ',param
1207                          ,parameter-type
1208                          ,parameter-document))
1209      (if (eq type 'bool)
1210          `(defun ,function (name)
1211             ,function-document
1212             (let ((params (gnus-group-find-parameter name))
1213                   val)
1214               (cond
1215                ((memq ',param params)
1216                 t)
1217                ((setq val (assq ',param params))
1218                 (cdr val))
1219                ((stringp ,variable)
1220                 (string-match ,variable name))
1221                (,variable
1222                 (let ((alist ,variable)
1223                       elem value)
1224                   (while (setq elem (pop alist))
1225                     (when (and name
1226                                (string-match (car elem) name))
1227                       (setq alist nil
1228                             value (cdr elem))))
1229                   (if (consp value) (car value) value))))))
1230        `(defun ,function (name)
1231           ,function-document
1232           (and name
1233                (or (gnus-group-find-parameter name ',param ,(and type t))
1234                    (let ((alist ,variable)
1235                          elem value)
1236                      (while (setq elem (pop alist))
1237                        (when (and name
1238                                   (string-match (car elem) name))
1239                          (setq alist nil
1240                                value (cdr elem))))
1241                      ,(if type
1242                           'value
1243                         '(if (consp value) (car value) value))))))))))
1244
1245 (defcustom gnus-home-directory "~/"
1246   "Directory variable that specifies the \"home\" directory.
1247 All other Gnus file and directory variables are initialized from this variable.
1248
1249 Note that Gnus is mostly loaded when the `.gnus.el' file is read.
1250 This means that other directory variables that are initialized
1251 from this variable won't be set properly if you set this variable
1252 in `.gnus.el'.  Set this variable in `.emacs' instead."
1253   :group 'gnus-files
1254   :type 'directory)
1255
1256 (defcustom gnus-directory (or (getenv "SAVEDIR")
1257                               (nnheader-concat gnus-home-directory "News/"))
1258   "*Directory variable from which all other Gnus file variables are derived.
1259
1260 Note that Gnus is mostly loaded when the `.gnus.el' file is read.
1261 This means that other directory variables that are initialized from
1262 this variable won't be set properly if you set this variable in `.gnus.el'.
1263 Set this variable in `.emacs' instead."
1264   :group 'gnus-files
1265   :type 'directory)
1266
1267 (defcustom gnus-default-directory nil
1268   "*Default directory for all Gnus buffers."
1269   :group 'gnus-files
1270   :type '(choice (const :tag "current" nil)
1271                  directory))
1272
1273 ;; Site dependent variables.  These variables should be defined in
1274 ;; paths.el.
1275
1276 (defvar gnus-default-nntp-server nil
1277   "Specify a default NNTP server.
1278 This variable should be defined in paths.el, and should never be set
1279 by the user.
1280 If you want to change servers, you should use `gnus-select-method'.
1281 See the documentation to that variable.")
1282
1283 (defcustom gnus-nntpserver-file "/etc/nntpserver"
1284   "A file with only the name of the nntp server in it."
1285   :group 'gnus-files
1286   :group 'gnus-server
1287   :type 'file)
1288
1289 (defun gnus-getenv-nntpserver ()
1290   "Find default nntp server.
1291 Check the NNTPSERVER environment variable and the
1292 `gnus-nntpserver-file' file."
1293   (or (getenv "NNTPSERVER")
1294       (and (file-readable-p gnus-nntpserver-file)
1295            (with-temp-buffer
1296              (insert-file-contents gnus-nntpserver-file)
1297              (when (re-search-forward "[^ \t\n\r]+" nil t)
1298                (match-string 0))))))
1299
1300 ;; `M-x customize-variable RET gnus-select-method RET' should work without
1301 ;; starting or even loading Gnus.
1302 ;;;###autoload(when (fboundp 'custom-autoload)
1303 ;;;###autoload  (custom-autoload 'gnus-select-method "gnus"))
1304
1305 (defcustom gnus-select-method
1306   (list 'nntp (or (gnus-getenv-nntpserver)
1307                   (when (and gnus-default-nntp-server
1308                              (not (string= gnus-default-nntp-server "")))
1309                     gnus-default-nntp-server)
1310                   "news"))
1311   "Default method for selecting a newsgroup.
1312 This variable should be a list, where the first element is how the
1313 news is to be fetched, the second is the address.
1314
1315 For instance, if you want to get your news via \"flab.flab.edu\" using
1316 NNTP, you could say:
1317
1318 \(setq gnus-select-method '(nntp \"flab.flab.edu\"))
1319
1320 If you want to use your local spool, say:
1321
1322 \(setq gnus-select-method (list 'nnspool (system-name)))
1323
1324 If you use this variable, you must set `gnus-nntp-server' to nil.
1325
1326 There is a lot more to know about select methods and virtual servers -
1327 see the manual for details."
1328   :group 'gnus-server
1329   :group 'gnus-start
1330   :initialize 'custom-initialize-default
1331   :type 'gnus-select-method)
1332
1333 (defcustom gnus-message-archive-method "archive"
1334   "*Method used for archiving messages you've sent.
1335 This should be a mail method.
1336
1337 See also `gnus-update-message-archive-method'."
1338   :group 'gnus-server
1339   :group 'gnus-message
1340   :type '(choice (const :tag "Default archive method" "archive")
1341                  gnus-select-method))
1342
1343 (defcustom gnus-update-message-archive-method nil
1344   "Non-nil means always update the saved \"archive\" method.
1345
1346 The archive method is initially set according to the value of
1347 `gnus-message-archive-method' and is saved in the \"~/.newsrc.eld\" file
1348 so that it may be used as a real method of the server which is named
1349 \"archive\" ever since.  If it once has been saved, it will never be
1350 updated if the value of this variable is nil, even if you change the
1351 value of `gnus-message-archive-method' afterward.  If you want the
1352 saved \"archive\" method to be updated whenever you change the value of
1353 `gnus-message-archive-method', set this variable to a non-nil value."
1354   :version "23.1"
1355   :group 'gnus-server
1356   :group 'gnus-message
1357   :type 'boolean)
1358
1359 (defcustom gnus-message-archive-group '((format-time-string "sent.%Y-%m"))
1360   "*Name of the group in which to save the messages you've written.
1361 This can either be a string; a list of strings; or an alist
1362 of regexps/functions/forms to be evaluated to return a string (or a list
1363 of strings).  The functions are called with the name of the current
1364 group (or nil) as a parameter.
1365
1366 If you want to save your mail in one group and the news articles you
1367 write in another group, you could say something like:
1368
1369  \(setq gnus-message-archive-group
1370         '((if (message-news-p)
1371               \"misc-news\"
1372             \"misc-mail\")))
1373
1374 Normally the group names returned by this variable should be
1375 unprefixed -- which implicitly means \"store on the archive server\".
1376 However, you may wish to store the message on some other server.  In
1377 that case, just return a fully prefixed name of the group --
1378 \"nnml+private:mail.misc\", for instance."
1379   :version "24.1"
1380   :group 'gnus-message
1381   :type '(choice (const :tag "none" nil)
1382                  (const :tag "Weekly" ((format-time-string "sent.%Yw%U")))
1383                  (const :tag "Monthly" ((format-time-string "sent.%Y-%m")))
1384                  (const :tag "Yearly" ((format-time-string "sent.%Y")))
1385                  function
1386                  sexp
1387                  string))
1388
1389 (defcustom gnus-secondary-servers nil
1390   "List of NNTP servers that the user can choose between interactively.
1391 To make Gnus query you for a server, you have to give `gnus' a
1392 non-numeric prefix - `C-u M-x gnus', in short."
1393   :group 'gnus-server
1394   :type '(repeat string))
1395 (make-obsolete-variable 'gnus-secondary-servers 'gnus-select-method "24.1")
1396
1397 (defcustom gnus-nntp-server nil
1398   "The name of the host running the NNTP server."
1399   :group 'gnus-server
1400   :type '(choice (const :tag "disable" nil)
1401                  string))
1402 (make-obsolete-variable 'gnus-nntp-server 'gnus-select-method "24.1")
1403
1404 (defcustom gnus-secondary-select-methods nil
1405   "A list of secondary methods that will be used for reading news.
1406 This is a list where each element is a complete select method (see
1407 `gnus-select-method').
1408
1409 If, for instance, you want to read your mail with the nnml back end,
1410 you could set this variable:
1411
1412 \(setq gnus-secondary-select-methods '((nnml \"\")))"
1413   :group 'gnus-server
1414   :type '(repeat gnus-select-method))
1415
1416 (defcustom gnus-local-domain nil
1417   "Local domain name without a host name.
1418 The DOMAINNAME environment variable is used instead if it is defined.
1419 If the function `system-name' returns the full Internet name, there is
1420 no need to set this variable."
1421   :group 'gnus-message
1422   :type '(choice (const :tag "default" nil)
1423                  string))
1424 (make-obsolete-variable 'gnus-local-domain nil "Emacs 24.1")
1425
1426 ;; Customization variables
1427
1428 (defcustom gnus-refer-article-method 'current
1429   "Preferred method for fetching an article by Message-ID.
1430 The value of this variable must be a valid select method as discussed
1431 in the documentation of `gnus-select-method'.
1432
1433 It can also be a list of select methods, as well as the special symbol
1434 `current', which means to use the current select method.  If it is a
1435 list, Gnus will try all the methods in the list until it finds a match."
1436   :version "24.1"
1437   :group 'gnus-server
1438   :type '(choice (const :tag "default" nil)
1439                  (const current)
1440                  (const :tag "Google" (nnweb "refer" (nnweb-type google)))
1441                  gnus-select-method
1442                  sexp
1443                  (repeat :menu-tag "Try multiple"
1444                          :tag "Multiple"
1445                          :value (current (nnweb "refer" (nnweb-type google)))
1446                          (choice :tag "Method"
1447                                  (const current)
1448                                  (const :tag "Google"
1449                                         (nnweb "refer" (nnweb-type google)))
1450                                  gnus-select-method))))
1451
1452 (defcustom gnus-use-cross-reference t
1453   "*Non-nil means that cross referenced articles will be marked as read.
1454 If nil, ignore cross references.  If t, mark articles as read in
1455 subscribed newsgroups.  If neither t nor nil, mark as read in all
1456 newsgroups."
1457   :group 'gnus-server
1458   :type '(choice (const :tag "off" nil)
1459                  (const :tag "subscribed" t)
1460                  (sexp :format "all"
1461                        :value always)))
1462
1463 (defcustom gnus-process-mark ?#
1464   "*Process mark."
1465   :group 'gnus-group-visual
1466   :group 'gnus-summary-marks
1467   :type 'character)
1468
1469 (defcustom gnus-large-newsgroup 200
1470   "*The number of articles which indicates a large newsgroup.
1471 If the number of articles in a newsgroup is greater than this value,
1472 confirmation is required for selecting the newsgroup.
1473 If it is nil, no confirmation is required.
1474
1475 Also see `gnus-large-ephemeral-newsgroup'."
1476   :group 'gnus-group-select
1477   :type '(choice (const :tag "No limit" nil)
1478                  integer))
1479
1480 (defcustom gnus-use-long-file-name (not (memq system-type '(usg-unix-v)))
1481   "Non-nil means that the default name of a file to save articles in is the group name.
1482 If it's nil, the directory form of the group name is used instead.
1483
1484 If this variable is a list, and the list contains the element
1485 `not-score', long file names will not be used for score files; if it
1486 contains the element `not-save', long file names will not be used for
1487 saving; and if it contains the element `not-kill', long file names
1488 will not be used for kill files.
1489
1490 Note that the default for this variable varies according to what system
1491 type you're using.  On `usg-unix-v' this variable defaults to nil while
1492 on all other systems it defaults to t."
1493   :group 'gnus-start
1494   :type '(radio (sexp :format "Non-nil\n"
1495                       :match (lambda (widget value)
1496                                (and value (not (listp value))))
1497                       :value t)
1498                 (const nil)
1499                 (checklist (const :format "%v " not-score)
1500                            (const :format "%v " not-save)
1501                            (const not-kill))))
1502
1503 (defcustom gnus-kill-files-directory gnus-directory
1504   "*Name of the directory where kill files will be stored (default \"~/News\")."
1505   :group 'gnus-score-files
1506   :group 'gnus-score-kill
1507   :type 'directory)
1508
1509 (defcustom gnus-save-score nil
1510   "*If non-nil, save group scoring info."
1511   :group 'gnus-score-various
1512   :group 'gnus-start
1513   :type 'boolean)
1514
1515 (defcustom gnus-use-undo t
1516   "*If non-nil, allow undoing in Gnus group mode buffers."
1517   :group 'gnus-meta
1518   :type 'boolean)
1519
1520 (defcustom gnus-use-adaptive-scoring nil
1521   "*If non-nil, use some adaptive scoring scheme.
1522 If a list, then the values `word' and `line' are meaningful.  The
1523 former will perform adaption on individual words in the subject
1524 header while `line' will perform adaption on several headers."
1525   :group 'gnus-meta
1526   :group 'gnus-score-adapt
1527   :type '(set (const word) (const line)))
1528
1529 (defcustom gnus-use-cache 'passive
1530   "*If nil, Gnus will ignore the article cache.
1531 If `passive', it will allow entering (and reading) articles
1532 explicitly entered into the cache.  If anything else, use the
1533 cache to the full extent of the law."
1534   :group 'gnus-meta
1535   :group 'gnus-cache
1536   :type '(choice (const :tag "off" nil)
1537                  (const :tag "passive" passive)
1538                  (const :tag "active" t)))
1539
1540 (defcustom gnus-use-trees nil
1541   "*If non-nil, display a thread tree buffer."
1542   :group 'gnus-meta
1543   :type 'boolean)
1544
1545 (defcustom gnus-keep-backlog 20
1546   "*If non-nil, Gnus will keep read articles for later re-retrieval.
1547 If it is a number N, then Gnus will only keep the last N articles
1548 read.  If it is neither nil nor a number, Gnus will keep all read
1549 articles.  This is not a good idea."
1550   :group 'gnus-meta
1551   :type '(choice (const :tag "off" nil)
1552                  integer
1553                  (sexp :format "all"
1554                        :value t)))
1555
1556 (defcustom gnus-suppress-duplicates nil
1557   "*If non-nil, Gnus will mark duplicate copies of the same article as read."
1558   :group 'gnus-meta
1559   :type 'boolean)
1560
1561 (defcustom gnus-use-scoring t
1562   "*If non-nil, enable scoring."
1563   :group 'gnus-meta
1564   :type 'boolean)
1565
1566 (defcustom gnus-summary-prepare-exit-hook
1567   '(gnus-summary-expire-articles)
1568   "*A hook called when preparing to exit from the summary buffer.
1569 It calls `gnus-summary-expire-articles' by default."
1570   :group 'gnus-summary-exit
1571   :type 'hook)
1572
1573 (defcustom gnus-novice-user t
1574   "*Non-nil means that you are a Usenet novice.
1575 If non-nil, verbose messages may be displayed and confirmations may be
1576 required."
1577   :group 'gnus-meta
1578   :type 'boolean)
1579
1580 (defcustom gnus-expert-user nil
1581   "*Non-nil means that you will never be asked for confirmation about anything.
1582 That doesn't mean *anything* anything; particularly destructive
1583 commands will still require prompting."
1584   :group 'gnus-meta
1585   :type 'boolean)
1586
1587 (defcustom gnus-interactive-catchup t
1588   "*If non-nil, require your confirmation when catching up a group."
1589   :group 'gnus-group-select
1590   :type 'boolean)
1591
1592 (defcustom gnus-interactive-exit t
1593   "*If non-nil, require your confirmation when exiting Gnus.
1594 If `quiet', update any active summary buffers automatically
1595 first before exiting."
1596   :group 'gnus-exit
1597   :type 'boolean)
1598
1599 (defcustom gnus-extract-address-components 'gnus-extract-address-components
1600   "*Function for extracting address components from a From header.
1601 Two pre-defined function exist: `gnus-extract-address-components',
1602 which is the default, quite fast, and too simplistic solution, and
1603 `mail-extract-address-components', which works much better, but is
1604 slower."
1605   :group 'gnus-summary-format
1606   :type '(radio (function-item gnus-extract-address-components)
1607                 (function-item mail-extract-address-components)
1608                 (function :tag "Other")))
1609
1610 (defcustom gnus-shell-command-separator ";"
1611   "String used to separate shell commands."
1612   :group 'gnus-files
1613   :type 'string)
1614
1615 (defcustom gnus-valid-select-methods
1616   '(("nntp" post address prompt-address physical-address)
1617     ("nnspool" post address)
1618     ("nnvirtual" post-mail virtual prompt-address)
1619     ("nnmbox" mail respool address)
1620     ("nnml" post-mail respool address)
1621     ("nnmh" mail respool address)
1622     ("nndir" post-mail prompt-address physical-address)
1623     ("nneething" none address prompt-address physical-address)
1624     ("nndoc" none address prompt-address)
1625     ("nnbabyl" mail address respool)
1626     ("nndraft" post-mail)
1627     ("nnfolder" mail respool address)
1628     ("nngateway" post-mail address prompt-address physical-address)
1629     ("nnweb" none)
1630     ("nnrss" none)
1631     ("nnagent" post-mail)
1632     ("nnimap" post-mail address prompt-address physical-address respool
1633      server-marks)
1634     ("nnmaildir" mail respool address)
1635     ("nnnil" none))
1636   "*An alist of valid select methods.
1637 The first element of each list lists should be a string with the name
1638 of the select method.  The other elements may be the category of
1639 this method (i. e., `post', `mail', `none' or whatever) or other
1640 properties that this method has (like being respoolable).
1641 If you implement a new select method, all you should have to change is
1642 this variable.  I think."
1643   :group 'gnus-server
1644   :type '(repeat (group (string :tag "Name")
1645                         (radio-button-choice (const :format "%v " post)
1646                                              (const :format "%v " mail)
1647                                              (const :format "%v " none)
1648                                              (const post-mail))
1649                         (checklist :inline t
1650                                    (const :format "%v " address)
1651                                    (const :format "%v " prompt-address)
1652                                    (const :format "%v " physical-address)
1653                                    (const :format "%v " virtual)
1654                                    (const respool))))
1655   :version "24.1")
1656
1657 (defun gnus-redefine-select-method-widget ()
1658   "Recomputes the select-method widget based on the value of
1659 `gnus-valid-select-methods'."
1660   (define-widget 'gnus-select-method 'list
1661     "Widget for entering a select method."
1662     :value '(nntp "")
1663     :tag "Select Method"
1664     :args `((choice :tag "Method"
1665                     ,@(mapcar (lambda (entry)
1666                                 (list 'const :format "%v\n"
1667                                       (intern (car entry))))
1668                               gnus-valid-select-methods)
1669                     (symbol :tag "other"))
1670             (string :tag "Address")
1671             (repeat :tag "Options"
1672                     :inline t
1673                     (list :format "%v"
1674                           variable
1675                           (sexp :tag "Value"))))))
1676
1677 (gnus-redefine-select-method-widget)
1678
1679 (defcustom gnus-updated-mode-lines '(group article summary tree)
1680   "List of buffers that should update their mode lines.
1681 The list may contain the symbols `group', `article', `tree' and
1682 `summary'.  If the corresponding symbol is present, Gnus will keep
1683 that mode line updated with information that may be pertinent.
1684 If this variable is nil, screen refresh may be quicker."
1685   :group 'gnus-various
1686   :type '(set (const group)
1687               (const article)
1688               (const summary)
1689               (const tree)))
1690
1691 (defcustom gnus-mode-non-string-length 30
1692   "*Max length of mode-line non-string contents.
1693 If this is nil, Gnus will take space as is needed, leaving the rest
1694 of the mode line intact."
1695   :version "24.1"
1696   :group 'gnus-various
1697   :type '(choice (const nil)
1698                  integer))
1699
1700 ;; There should be special validation for this.
1701 (define-widget 'gnus-email-address 'string
1702   "An email address.")
1703
1704 (gnus-define-group-parameter
1705  to-address
1706  :function-document
1707  "Return GROUP's to-address."
1708  :variable-document
1709  "*Alist of group regexps and correspondent to-addresses."
1710  :variable-group gnus-group-parameter
1711  :parameter-type '(gnus-email-address :tag "To Address")
1712  :parameter-document "\
1713 This will be used when doing followups and posts.
1714
1715 This is primarily useful in mail groups that represent closed
1716 mailing lists--mailing lists where it's expected that everybody that
1717 writes to the mailing list is subscribed to it.  Since using this
1718 parameter ensures that the mail only goes to the mailing list itself,
1719 it means that members won't receive two copies of your followups.
1720
1721 Using `to-address' will actually work whether the group is foreign or
1722 not.  Let's say there's a group on the server that is called
1723 `fa.4ad-l'.  This is a real newsgroup, but the server has gotten the
1724 articles from a mail-to-news gateway.  Posting directly to this group
1725 is therefore impossible--you have to send mail to the mailing list
1726 address instead.
1727
1728 The gnus-group-split mail splitting mechanism will behave as if this
1729 address was listed in gnus-group-split Addresses (see below).")
1730
1731 (gnus-define-group-parameter
1732  to-list
1733  :function-document
1734  "Return GROUP's to-list."
1735  :variable-document
1736  "*Alist of group regexps and correspondent to-lists."
1737  :variable-group gnus-group-parameter