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

   1 ;;; gnus.el --- a newsreader for GNU Emacs
   2
   3 ;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, 1997,
   4 ;; 1998, 2000, 2001, 2002, 2003, 2004 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 2, or (at your option)
  15 ;; 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; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Commentary:
  28
  29 ;;; Code:
  30
  31 (eval '(run-hooks 'gnus-load-hook))
  32
  33 (eval-when-compile (require 'cl))
  34 (require 'wid-edit)
  35 (require 'mm-util)
  36 (require 'nnheader)
  37 (autoload 'message-y-or-n-p "message" nil nil 'macro)
  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-format nil
  45   "Dealing with formatting issues."
  46   :group 'gnus)
  47
  48 (defgroup gnus-charset nil
  49   "Group character set issues."
  50   :link '(custom-manual "(gnus)Charsets")
  51   :version "21.1"
  52   :group 'gnus)
  53
  54 (defgroup gnus-cache nil
  55   "Cache interface."
  56   :link '(custom-manual "(gnus)Article Caching")
  57   :group 'gnus)
  58
  59 (defgroup gnus-registry nil
  60   "Article Registry."
  61   :group 'gnus)
  62
  63 (defgroup gnus-start nil
  64   "Starting your favorite newsreader."
  65   :group 'gnus)
  66
  67 (defgroup gnus-start-server nil
  68   "Server options at startup."
  69   :group 'gnus-start)
  70
  71 ;; These belong to gnus-group.el.
  72 (defgroup gnus-group nil
  73   "Group buffers."
  74   :link '(custom-manual "(gnus)Group Buffer")
  75   :group 'gnus)
  76
  77 (defgroup gnus-group-foreign nil
  78   "Foreign groups."
  79   :link '(custom-manual "(gnus)Foreign Groups")
  80   :group 'gnus-group)
  81
  82 (defgroup gnus-group-new nil
  83   "Automatic subscription of new groups."
  84   :group 'gnus-group)
  85
  86 (defgroup gnus-group-levels nil
  87   "Group levels."
  88   :link '(custom-manual "(gnus)Group Levels")
  89   :group 'gnus-group)
  90
  91 (defgroup gnus-group-select nil
  92   "Selecting a Group."
  93   :link '(custom-manual "(gnus)Selecting a Group")
  94   :group 'gnus-group)
  95
  96 (defgroup gnus-group-listing nil
  97   "Showing slices of the group list."
  98   :link '(custom-manual "(gnus)Listing Groups")
  99   :group 'gnus-group)
 100
 101 (defgroup gnus-group-visual nil
 102   "Sorting the group buffer."
 103   :link '(custom-manual "(gnus)Group Buffer Format")
 104   :group 'gnus-group
 105   :group 'gnus-visual)
 106
 107 (defgroup gnus-group-various nil
 108   "Various group options."
 109   :link '(custom-manual "(gnus)Scanning New Messages")
 110   :group 'gnus-group)
 111
 112 ;; These belong to gnus-sum.el.
 113 (defgroup gnus-summary nil
 114   "Summary buffers."
 115   :link '(custom-manual "(gnus)Summary Buffer")
 116   :group 'gnus)
 117
 118 (defgroup gnus-summary-exit nil
 119   "Leaving summary buffers."
 120   :link '(custom-manual "(gnus)Exiting the Summary Buffer")
 121   :group 'gnus-summary)
 122
 123 (defgroup gnus-summary-marks nil
 124   "Marks used in summary buffers."
 125   :link '(custom-manual "(gnus)Marking Articles")
 126   :group 'gnus-summary)
 127
 128 (defgroup gnus-thread nil
 129   "Ordering articles according to replies."
 130   :link '(custom-manual "(gnus)Threading")
 131   :group 'gnus-summary)
 132
 133 (defgroup gnus-summary-format nil
 134   "Formatting of the summary buffer."
 135   :link '(custom-manual "(gnus)Summary Buffer Format")
 136   :group 'gnus-summary)
 137
 138 (defgroup gnus-summary-choose nil
 139   "Choosing Articles."
 140   :link '(custom-manual "(gnus)Choosing Articles")
 141   :group 'gnus-summary)
 142
 143 (defgroup gnus-summary-maneuvering nil
 144   "Summary movement commands."
 145   :link '(custom-manual "(gnus)Summary Maneuvering")
 146   :group 'gnus-summary)
 147
 148 (defgroup gnus-picon nil
 149   "Show pictures of people, domains, and newsgroups."
 150   :group 'gnus-visual)
 151
 152 (defgroup gnus-summary-mail nil
 153   "Mail group commands."
 154   :link '(custom-manual "(gnus)Mail Group Commands")
 155   :group 'gnus-summary)
 156
 157 (defgroup gnus-summary-sort nil
 158   "Sorting the summary buffer."
 159   :link '(custom-manual "(gnus)Sorting the Summary Buffer")
 160   :group 'gnus-summary)
 161
 162 (defgroup gnus-summary-visual nil
 163   "Highlighting and menus in the summary buffer."
 164   :link '(custom-manual "(gnus)Summary Highlighting")
 165   :group 'gnus-visual
 166   :group 'gnus-summary)
 167
 168 (defgroup gnus-summary-various nil
 169   "Various summary buffer options."
 170   :link '(custom-manual "(gnus)Various Summary Stuff")
 171   :group 'gnus-summary)
 172
 173 (defgroup gnus-summary-pick nil
 174   "Pick mode in the summary buffer."
 175   :link '(custom-manual "(gnus)Pick and Read")
 176   :prefix "gnus-pick-"
 177   :group 'gnus-summary)
 178
 179 (defgroup gnus-summary-tree nil
 180   "Tree display of threads in the summary buffer."
 181   :link '(custom-manual "(gnus)Tree Display")
 182   :prefix "gnus-tree-"
 183   :group 'gnus-summary)
 184
 185 ;; Belongs to gnus-uu.el
 186 (defgroup gnus-extract-view nil
 187   "Viewing extracted files."
 188   :link '(custom-manual "(gnus)Viewing Files")
 189   :group 'gnus-extract)
 190
 191 ;; Belongs to gnus-score.el
 192 (defgroup gnus-score nil
 193   "Score and kill file handling."
 194   :group 'gnus)
 195
 196 (defgroup gnus-score-kill nil
 197   "Kill files."
 198   :group 'gnus-score)
 199
 200 (defgroup gnus-score-adapt nil
 201   "Adaptive score files."
 202   :group 'gnus-score)
 203
 204 (defgroup gnus-score-default nil
 205   "Default values for score files."
 206   :group 'gnus-score)
 207
 208 (defgroup gnus-score-expire nil
 209   "Expiring score rules."
 210   :group 'gnus-score)
 211
 212 (defgroup gnus-score-decay nil
 213   "Decaying score rules."
 214   :group 'gnus-score)
 215
 216 (defgroup gnus-score-files nil
 217   "Score and kill file names."
 218   :group 'gnus-score
 219   :group 'gnus-files)
 220
 221 (defgroup gnus-score-various nil
 222   "Various scoring and killing options."
 223   :group 'gnus-score)
 224
 225 ;; Other
 226 (defgroup gnus-visual nil
 227   "Options controlling the visual fluff."
 228   :group 'gnus
 229   :group 'faces)
 230
 231 (defgroup gnus-agent nil
 232   "Offline support for Gnus."
 233   :group 'gnus)
 234
 235 (defgroup gnus-files nil
 236   "Files used by Gnus."
 237   :group 'gnus)
 238
 239 (defgroup gnus-dribble-file nil
 240   "Auto save file."
 241   :link '(custom-manual "(gnus)Auto Save")
 242   :group 'gnus-files)
 243
 244 (defgroup gnus-newsrc nil
 245   "Storing Gnus state."
 246   :group 'gnus-files)
 247
 248 (defgroup gnus-server nil
 249   "Options related to newsservers and other servers used by Gnus."
 250   :group 'gnus)
 251
 252 (defgroup gnus-server-visual nil
 253   "Highlighting and menus in the server buffer."
 254   :group 'gnus-visual
 255   :group 'gnus-server)
 256
 257 (defgroup gnus-message '((message custom-group))
 258   "Composing replies and followups in Gnus."
 259   :group 'gnus)
 260
 261 (defgroup gnus-meta nil
 262   "Meta variables controlling major portions of Gnus.
 263 In general, modifying these variables does not take affect until Gnus
 264 is restarted, and sometimes reloaded."
 265   :group 'gnus)
 266
 267 (defgroup gnus-various nil
 268   "Other Gnus options."
 269   :link '(custom-manual "(gnus)Various Various")
 270   :group 'gnus)
 271
 272 (defgroup gnus-mime nil
 273   "Variables for controlling the Gnus MIME interface."
 274   :group 'gnus)
 275
 276 (defgroup gnus-exit nil
 277   "Exiting gnus."
 278   :link '(custom-manual "(gnus)Exiting Gnus")
 279   :group 'gnus)
 280
 281 (defgroup gnus-fun nil
 282   "Frivolous Gnus extensions."
 283   :link '(custom-manual "(gnus)Exiting Gnus")
 284   :group 'gnus)
 285
 286 (defconst gnus-version-number "0.3"
 287   "Version number for this version of Gnus.")
 288
 289 (defconst gnus-version (format "No Gnus v%s" gnus-version-number)
 290   "Version string for this version of Gnus.")
 291
 292 (defcustom gnus-inhibit-startup-message nil
 293   "If non-nil, the startup message will not be displayed.
 294 This variable is used before `.gnus.el' is loaded, so it should
 295 be set in `.emacs' instead."
 296   :group 'gnus-start
 297   :type 'boolean)
 298
 299 (defcustom gnus-play-startup-jingle nil
 300   "If non-nil, play the Gnus jingle at startup."
 301   :group 'gnus-start
 302   :type 'boolean)
 303
 304 (unless (fboundp 'gnus-group-remove-excess-properties)
 305   (defalias 'gnus-group-remove-excess-properties 'ignore))
 306
 307 (unless (featurep 'gnus-xmas)
 308   (defalias 'gnus-make-overlay 'make-overlay)
 309   (defalias 'gnus-delete-overlay 'delete-overlay)
 310   (defalias 'gnus-overlay-put 'overlay-put)
 311   (defalias 'gnus-move-overlay 'move-overlay)
 312   (defalias 'gnus-overlay-buffer 'overlay-buffer)
 313   (defalias 'gnus-overlay-start 'overlay-start)
 314   (defalias 'gnus-overlay-end 'overlay-end)
 315   (defalias 'gnus-extent-detached-p 'ignore)
 316   (defalias 'gnus-extent-start-open 'ignore)
 317   (defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names)
 318   (defalias 'gnus-character-to-event 'identity)
 319   (defalias 'gnus-assq-delete-all 'assq-delete-all)
 320   (defalias 'gnus-add-text-properties 'add-text-properties)
 321   (defalias 'gnus-put-text-property 'put-text-property)
 322   (defvar gnus-mode-line-image-cache t)
 323   (if (fboundp 'find-image)
 324       (defun gnus-mode-line-buffer-identification (line)
 325         (let ((str (car-safe line)))
 326           (if (and (stringp str)
 327                    (string-match "^Gnus:" str))
 328               (progn (add-text-properties
 329                       0 5
 330                       (list 'display
 331                             (if (eq t gnus-mode-line-image-cache)
 332                                 (setq gnus-mode-line-image-cache
 333                                       (find-image
 334                                        '((:type xpm :file "gnus-pointer.xpm"
 335                                                 :ascent center)
 336                                          (:type xbm :file "gnus-pointer.xbm"
 337                                                 :ascent center))))
 338                               gnus-mode-line-image-cache)
 339                             'help-echo (format
 340                                         "This is %s, %s."
 341                                         gnus-version (gnus-emacs-version)))
 342                       str)
 343                      (list str))
 344             line)))
 345     (defalias 'gnus-mode-line-buffer-identification 'identity))
 346   (defalias 'gnus-characterp 'numberp)
 347   (defalias 'gnus-deactivate-mark 'deactivate-mark)
 348   (defalias 'gnus-window-edges 'window-edges)
 349   (defalias 'gnus-key-press-event-p 'numberp)
 350   ;;(defalias 'gnus-decode-rfc1522 'ignore)
 351   )
 352
 353 ;; We define these group faces here to avoid the display
 354 ;; update forced when creating new faces.
 355
 356 (defface gnus-group-news-1-face
 357   '((((class color)
 358       (background dark))
 359      (:foreground "PaleTurquoise" :bold t))
 360     (((class color)
 361       (background light))
 362      (:foreground "ForestGreen" :bold t))
 363     (t
 364      ()))
 365   "Level 1 newsgroup face.")
 366
 367 (defface gnus-group-news-1-empty-face
 368   '((((class color)
 369       (background dark))
 370      (:foreground "PaleTurquoise"))
 371     (((class color)
 372       (background light))
 373      (:foreground "ForestGreen"))
 374     (t
 375      ()))
 376   "Level 1 empty newsgroup face.")
 377
 378 (defface gnus-group-news-2-face
 379   '((((class color)
 380       (background dark))
 381      (:foreground "turquoise" :bold t))
 382     (((class color)
 383       (background light))
 384      (:foreground "CadetBlue4" :bold t))
 385     (t
 386      ()))
 387   "Level 2 newsgroup face.")
 388
 389 (defface gnus-group-news-2-empty-face
 390   '((((class color)
 391       (background dark))
 392      (:foreground "turquoise"))
 393     (((class color)
 394       (background light))
 395      (:foreground "CadetBlue4"))
 396     (t
 397      ()))
 398   "Level 2 empty newsgroup face.")
 399
 400 (defface gnus-group-news-3-face
 401   '((((class color)
 402       (background dark))
 403      (:bold t))
 404     (((class color)
 405       (background light))
 406      (:bold t))
 407     (t
 408      ()))
 409   "Level 3 newsgroup face.")
 410
 411 (defface gnus-group-news-3-empty-face
 412   '((((class color)
 413       (background dark))
 414      ())
 415     (((class color)
 416       (background light))
 417      ())
 418     (t
 419      ()))
 420   "Level 3 empty newsgroup face.")
 421
 422 (defface gnus-group-news-4-face
 423   '((((class color)
 424       (background dark))
 425      (:bold t))
 426     (((class color)
 427       (background light))
 428      (:bold t))
 429     (t
 430      ()))
 431   "Level 4 newsgroup face.")
 432
 433 (defface gnus-group-news-4-empty-face
 434   '((((class color)
 435       (background dark))
 436      ())
 437     (((class color)
 438       (background light))
 439      ())
 440     (t
 441      ()))
 442   "Level 4 empty newsgroup face.")
 443
 444 (defface gnus-group-news-5-face
 445   '((((class color)
 446       (background dark))
 447      (:bold t))
 448     (((class color)
 449       (background light))
 450      (:bold t))
 451     (t
 452      ()))
 453   "Level 5 newsgroup face.")
 454
 455 (defface gnus-group-news-5-empty-face
 456   '((((class color)
 457       (background dark))
 458      ())
 459     (((class color)
 460       (background light))
 461      ())
 462     (t
 463      ()))
 464   "Level 5 empty newsgroup face.")
 465
 466 (defface gnus-group-news-6-face
 467   '((((class color)
 468       (background dark))
 469      (:bold t))
 470     (((class color)
 471       (background light))
 472      (:bold t))
 473     (t
 474      ()))
 475   "Level 6 newsgroup face.")
 476
 477 (defface gnus-group-news-6-empty-face
 478   '((((class color)
 479       (background dark))
 480      ())
 481     (((class color)
 482       (background light))
 483      ())
 484     (t
 485      ()))
 486   "Level 6 empty newsgroup face.")
 487
 488 (defface gnus-group-news-low-face
 489   '((((class color)
 490       (background dark))
 491      (:foreground "DarkTurquoise" :bold t))
 492     (((class color)
 493       (background light))
 494      (:foreground "DarkGreen" :bold t))
 495     (t
 496      ()))
 497   "Low level newsgroup face.")
 498
 499 (defface gnus-group-news-low-empty-face
 500   '((((class color)
 501       (background dark))
 502      (:foreground "DarkTurquoise"))
 503     (((class color)
 504       (background light))
 505      (:foreground "DarkGreen"))
 506     (t
 507      ()))
 508   "Low level empty newsgroup face.")
 509
 510 (defface gnus-group-mail-1-face
 511   '((((class color)
 512       (background dark))
 513      (:foreground "aquamarine1" :bold t))
 514     (((class color)
 515       (background light))
 516      (:foreground "DeepPink3" :bold t))
 517     (t
 518      (:bold t)))
 519   "Level 1 mailgroup face.")
 520
 521 (defface gnus-group-mail-1-empty-face
 522   '((((class color)
 523       (background dark))
 524      (:foreground "aquamarine1"))
 525     (((class color)
 526       (background light))
 527      (:foreground "DeepPink3"))
 528     (t
 529      (:italic t :bold t)))
 530   "Level 1 empty mailgroup face.")
 531
 532 (defface gnus-group-mail-2-face
 533   '((((class color)
 534       (background dark))
 535      (:foreground "aquamarine2" :bold t))
 536     (((class color)
 537       (background light))
 538      (:foreground "HotPink3" :bold t))
 539     (t
 540      (:bold t)))
 541   "Level 2 mailgroup face.")
 542
 543 (defface gnus-group-mail-2-empty-face
 544   '((((class color)
 545       (background dark))
 546      (:foreground "aquamarine2"))
 547     (((class color)
 548       (background light))
 549      (:foreground "HotPink3"))
 550     (t
 551      (:bold t)))
 552   "Level 2 empty mailgroup face.")
 553
 554 (defface gnus-group-mail-3-face
 555   '((((class color)
 556       (background dark))
 557      (:foreground "aquamarine3" :bold t))
 558     (((class color)
 559       (background light))
 560      (:foreground "magenta4" :bold t))
 561     (t
 562      (:bold t)))
 563   "Level 3 mailgroup face.")
 564
 565 (defface gnus-group-mail-3-empty-face
 566   '((((class color)
 567       (background dark))
 568      (:foreground "aquamarine3"))
 569     (((class color)
 570       (background light))
 571      (:foreground "magenta4"))
 572     (t
 573      ()))
 574   "Level 3 empty mailgroup face.")
 575
 576 (defface gnus-group-mail-low-face
 577   '((((class color)
 578       (background dark))
 579      (:foreground "aquamarine4" :bold t))
 580     (((class color)
 581       (background light))
 582      (:foreground "DeepPink4" :bold t))
 583     (t
 584      (:bold t)))
 585   "Low level mailgroup face.")
 586
 587 (defface gnus-group-mail-low-empty-face
 588   '((((class color)
 589       (background dark))
 590      (:foreground "aquamarine4"))
 591     (((class color)
 592       (background light))
 593      (:foreground "DeepPink4"))
 594     (t
 595      (:bold t)))
 596   "Low level empty mailgroup face.")
 597
 598 ;; Summary mode faces.
 599
 600 (defface gnus-summary-selected-face '((t
 601                                        (:underline t)))
 602   "Face used for selected articles.")
 603
 604 (defface gnus-summary-cancelled-face
 605   '((((class color))
 606      (:foreground "yellow" :background "black")))
 607   "Face used for cancelled articles.")
 608
 609 (defface gnus-summary-high-ticked-face
 610   '((((class color)
 611       (background dark))
 612      (:foreground "pink" :bold t))
 613     (((class color)
 614       (background light))
 615      (:foreground "firebrick" :bold t))
 616     (t
 617      (:bold t)))
 618   "Face used for high interest ticked articles.")
 619
 620 (defface gnus-summary-low-ticked-face
 621   '((((class color)
 622       (background dark))
 623      (:foreground "pink" :italic t))
 624     (((class color)
 625       (background light))
 626      (:foreground "firebrick" :italic t))
 627     (t
 628      (:italic t)))
 629   "Face used for low interest ticked articles.")
 630
 631 (defface gnus-summary-normal-ticked-face
 632   '((((class color)
 633       (background dark))
 634      (:foreground "pink"))
 635     (((class color)
 636       (background light))
 637      (:foreground "firebrick"))
 638     (t
 639      ()))
 640   "Face used for normal interest ticked articles.")
 641
 642 (defface gnus-summary-high-ancient-face
 643   '((((class color)
 644       (background dark))
 645      (:foreground "SkyBlue" :bold t))
 646     (((class color)
 647       (background light))
 648      (:foreground "RoyalBlue" :bold t))
 649     (t
 650      (:bold t)))
 651   "Face used for high interest ancient articles.")
 652
 653 (defface gnus-summary-low-ancient-face
 654   '((((class color)
 655       (background dark))
 656      (:foreground "SkyBlue" :italic t))
 657     (((class color)
 658       (background light))
 659      (:foreground "RoyalBlue" :italic t))
 660     (t
 661      (:italic t)))
 662   "Face used for low interest ancient articles.")
 663
 664 (defface gnus-summary-normal-ancient-face
 665   '((((class color)
 666       (background dark))
 667      (:foreground "SkyBlue"))
 668     (((class color)
 669       (background light))
 670      (:foreground "RoyalBlue"))
 671     (t
 672      ()))
 673   "Face used for normal interest ancient articles.")
 674
 675 (defface gnus-summary-high-undownloaded-face
 676    '((((class color)
 677        (background light))
 678       (:bold t :foreground "cyan4"))
 679      (((class color) (background dark))
 680       (:bold t :foreground "LightGray"))
 681      (t (:inverse-video t :bold t)))
 682   "Face used for high interest uncached articles.")
 683
 684 (defface gnus-summary-low-undownloaded-face
 685    '((((class color)
 686        (background light))
 687       (:italic t :foreground "cyan4" :bold nil))
 688      (((class color) (background dark))
 689       (:italic t :foreground "LightGray" :bold nil))
 690      (t (:inverse-video t :italic t)))
 691   "Face used for low interest uncached articles.")
 692
 693 (defface gnus-summary-normal-undownloaded-face
 694    '((((class color)
 695        (background light))
 696       (:foreground "cyan4" :bold nil))
 697      (((class color) (background dark))
 698       (:foreground "LightGray" :bold nil))
 699      (t (:inverse-video t)))
 700   "Face used for normal interest uncached articles.")
 701
 702 (defface gnus-summary-high-unread-face
 703   '((t
 704      (:bold t)))
 705   "Face used for high interest unread articles.")
 706
 707 (defface gnus-summary-low-unread-face
 708   '((t
 709      (:italic t)))
 710   "Face used for low interest unread articles.")
 711
 712 (defface gnus-summary-normal-unread-face
 713   '((t
 714      ()))
 715   "Face used for normal interest unread articles.")
 716
 717 (defface gnus-summary-high-read-face
 718   '((((class color)
 719       (background dark))
 720      (:foreground "PaleGreen"
 721                   :bold t))
 722     (((class color)
 723       (background light))
 724      (:foreground "DarkGreen"
 725                   :bold t))
 726     (t
 727      (:bold t)))
 728   "Face used for high interest read articles.")
 729
 730 (defface gnus-summary-low-read-face
 731   '((((class color)
 732       (background dark))
 733      (:foreground "PaleGreen"
 734                   :italic t))
 735     (((class color)
 736       (background light))
 737      (:foreground "DarkGreen"
 738                   :italic t))
 739     (t
 740      (:italic t)))
 741   "Face used for low interest read articles.")
 742
 743 (defface gnus-summary-normal-read-face
 744   '((((class color)
 745       (background dark))
 746      (:foreground "PaleGreen"))
 747     (((class color)
 748       (background light))
 749      (:foreground "DarkGreen"))
 750     (t
 751      ()))
 752   "Face used for normal interest read articles.")
 753
 754
 755 ;;;
 756 ;;; Gnus buffers
 757 ;;;
 758
 759 (defvar gnus-buffers nil)
 760
 761 (defun gnus-get-buffer-create (name)
 762   "Do the same as `get-buffer-create', but store the created buffer."
 763   (or (get-buffer name)
 764       (car (push (get-buffer-create name) gnus-buffers))))
 765
 766 (defun gnus-add-buffer ()
 767   "Add the current buffer to the list of Gnus buffers."
 768   (push (current-buffer) gnus-buffers))
 769
 770 (defmacro gnus-kill-buffer (buffer)
 771   "Kill BUFFER and remove from the list of Gnus buffers."
 772   `(let ((buf ,buffer))
 773      (when (gnus-buffer-exists-p buf)
 774        (setq gnus-buffers (delete (get-buffer buf) gnus-buffers))
 775        (kill-buffer buf))))
 776
 777 (defun gnus-buffers ()
 778   "Return a list of live Gnus buffers."
 779   (while (and gnus-buffers
 780               (not (buffer-name (car gnus-buffers))))
 781     (pop gnus-buffers))
 782   (let ((buffers gnus-buffers))
 783     (while (cdr buffers)
 784       (if (buffer-name (cadr buffers))
 785           (pop buffers)
 786         (setcdr buffers (cddr buffers)))))
 787   gnus-buffers)
 788
 789 ;;; Splash screen.
 790
 791 (defvar gnus-group-buffer "*Group*")
 792
 793 (eval-and-compile
 794   (autoload 'gnus-play-jingle "gnus-audio"))
 795
 796 (defface gnus-splash-face
 797   '((((class color)
 798       (background dark))
 799      (:foreground "#888888"))
 800     (((class color)
 801       (background light))
 802      (:foreground "#888888"))
 803     (t
 804      ()))
 805   "Face for the splash screen.")
 806
 807 (defun gnus-splash ()
 808   (save-excursion
 809     (switch-to-buffer (gnus-get-buffer-create gnus-group-buffer))
 810     (let ((buffer-read-only nil))
 811       (erase-buffer)
 812       (unless gnus-inhibit-startup-message
 813         (gnus-group-startup-message)
 814         (sit-for 0)
 815         (when gnus-play-startup-jingle
 816           (gnus-play-jingle))))))
 817
 818 (defun gnus-indent-rigidly (start end arg)
 819   "Indent rigidly using only spaces and no tabs."
 820   (save-excursion
 821     (save-restriction
 822       (narrow-to-region start end)
 823       (let ((tab-width 8))
 824         (indent-rigidly start end arg)
 825         ;; We translate tabs into spaces -- not everybody uses
 826         ;; an 8-character tab.
 827         (goto-char (point-min))
 828         (while (search-forward "\t" nil t)
 829           (replace-match "        " t t))))))
 830
 831 (defvar gnus-simple-splash nil)
 832
 833 ;;(format "%02x%02x%02x" 114 66 20) "724214"
 834
 835 (defvar gnus-logo-color-alist
 836   '((flame "#cc3300" "#ff2200")
 837     (pine "#c0cc93" "#f8ffb8")
 838     (moss "#a1cc93" "#d2ffb8")
 839     (irish "#04cc90" "#05ff97")
 840     (sky "#049acc" "#05deff")
 841     (tin "#6886cc" "#82b6ff")
 842     (velvet "#7c68cc" "#8c82ff")
 843     (grape "#b264cc" "#cf7df")
 844     (labia "#cc64c2" "#fd7dff")
 845     (berry "#cc6485" "#ff7db5")
 846     (dino "#724214" "#1e3f03")
 847     (oort "#cccccc" "#888888")
 848     (storm "#666699" "#99ccff")
 849     (pdino "#9999cc" "#99ccff")
 850     (purp "#9999cc" "#666699")
 851     (no "#ff0000" "#ffff00")
 852     (neutral "#b4b4b4" "#878787")
 853     (september "#bf9900" "#ffcc00"))
 854   "Color alist used for the Gnus logo.")
 855
 856 (defcustom gnus-logo-color-style 'no
 857   "*Color styles used for the Gnus logo."
 858   :type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem)))
 859                            gnus-logo-color-alist))
 860   :group 'gnus-xmas)
 861
 862 (defvar gnus-logo-colors
 863   (cdr (assq gnus-logo-color-style gnus-logo-color-alist))
 864   "Colors used for the Gnus logo.")
 865
 866 (defun gnus-group-startup-message (&optional x y)
 867   "Insert startup message in current buffer."
 868   ;; Insert the message.
 869   (erase-buffer)
 870   (cond
 871    ((and
 872      (fboundp 'find-image)
 873      (display-graphic-p)
 874      (let* ((data-directory (nnheader-find-etc-directory "gnus"))
 875             (image (find-image
 876                     `((:type xpm :file "gnus.xpm"
 877                              :color-symbols
 878                              (("thing" . ,(car gnus-logo-colors))
 879                               ("shadow" . ,(cadr gnus-logo-colors))
 880                               ("oort" . "#eeeeee")
 881                               ("background" . ,(face-background 'default))))
 882                       (:type pbm :file "gnus.pbm"
 883                              ;; Account for the pbm's blackground.
 884                              :background ,(face-foreground 'gnus-splash-face)
 885                              :foreground ,(face-background 'default))
 886                       (:type xbm :file "gnus.xbm"
 887                              ;; Account for the xbm's blackground.
 888                              :background ,(face-foreground 'gnus-splash-face)
 889                              :foreground ,(face-background 'default))))))
 890        (when image
 891          (let ((size (image-size image)))
 892            (insert-char ?\n (max 0 (round (- (window-height)
 893                                              (or y (cdr size)) 1) 2)))
 894            (insert-char ?\  (max 0 (round (- (window-width)
 895                                              (or x (car size))) 2)))
 896            (insert-image image))
 897          (setq gnus-simple-splash nil)
 898          t))))
 899    (t
 900     (insert
 901      (format "              %s
 902           _    ___ _             _
 903           _ ___ __ ___  __    _ ___
 904           __   _     ___    __  ___
 905               _           ___     _
 906              _  _ __             _
 907              ___   __            _
 908                    __           _
 909                     _      _   _
 910                    _      _    _
 911                       _  _    _
 912                   __  ___
 913                  _   _ _     _
 914                 _   _
 915               _    _
 916              _    _
 917             _
 918           __
 919
 920 "
 921              ""))
 922     ;; And then hack it.
 923     (gnus-indent-rigidly (point-min) (point-max)
 924                          (/ (max (- (window-width) (or x 46)) 0) 2))
 925     (goto-char (point-min))
 926     (forward-line 1)
 927     (let* ((pheight (count-lines (point-min) (point-max)))
 928            (wheight (window-height))
 929            (rest (- wheight pheight)))
 930       (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
 931     ;; Fontify some.
 932     (put-text-property (point-min) (point-max) 'face 'gnus-splash-face)
 933     (setq gnus-simple-splash t)))
 934   (goto-char (point-min))
 935   (setq mode-line-buffer-identification (concat " " gnus-version))
 936   (set-buffer-modified-p t))
 937
 938 (eval-when (load)
 939   (let ((command (format "%s" this-command)))
 940     (when (string-match "gnus" command)
 941       (if (string-match "gnus-other-frame" command)
 942           (gnus-get-buffer-create gnus-group-buffer)
 943         (gnus-splash)))))
 944
 945 ;;; Do the rest.
 946
 947 (require 'gnus-util)
 948 (require 'nnheader)
 949
 950 (defcustom gnus-parameters nil
 951   "Alist of group parameters.
 952
 953 For example:
 954    ((\"mail\\\\..*\"  (gnus-show-threads nil)
 955                   (gnus-use-scoring nil)
 956                   (gnus-summary-line-format
 957                         \"%U%R%z%I%(%[%d:%ub%-23,23f%]%) %s\\n\")
 958                   (gcc-self . t)
 959                   (display . all))
 960      (\"mail\\\\.me\" (gnus-use-scoring  t))
 961      (\"list\\\\..*\" (total-expire . t)
 962                   (broken-reply-to . t)))"
 963   :version "21.4"
 964   :group 'gnus-group-various
 965   :type '(repeat (cons regexp
 966                        (repeat sexp))))
 967
 968 (defvar gnus-group-parameters-more nil)
 969
 970 (defmacro gnus-define-group-parameter (param &rest rest)
 971   "Define a group parameter PARAM.
 972 REST is a plist of following:
 973 :type               One of `bool', `list' or nil.
 974 :function           The name of the function.
 975 :function-document  The documentation of the function.
 976 :parameter-type     The type for customizing the parameter.
 977 :parameter-document The documentation for the parameter.
 978 :variable           The name of the variable.
 979 :variable-document  The documentation for the variable.
 980 :variable-group     The group for customizing the variable.
 981 :variable-type      The type for customizing the variable.
 982 :variable-default   The default value of the variable."
 983   (let* ((type (plist-get rest :type))
 984          (parameter-type (plist-get rest :parameter-type))
 985          (parameter-document (plist-get rest :parameter-document))
 986          (function (or (plist-get rest :function)
 987                        (intern (format "gnus-parameter-%s" param))))
 988          (function-document (or (plist-get rest :function-document) ""))
 989          (variable (or (plist-get rest :variable)
 990                        (intern (format "gnus-parameter-%s-alist" param))))
 991          (variable-document (or (plist-get rest :variable-document) ""))
 992          (variable-group (plist-get rest :variable-group))
 993          (variable-type (or (plist-get rest :variable-type)
 994                             `(quote (repeat
 995                                      (list (regexp :tag "Group")
 996                                            ,(car (cdr parameter-type)))))))
 997          (variable-default (plist-get rest :variable-default)))
 998     (list
 999      'progn
1000      `(defcustom ,variable ,variable-default
1001         ,variable-document