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 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
  38 (defgroup gnus nil
  39   "The coffee-brewing, all singing, all dancing, kitchen sink newsreader."
  40   :group 'news
  41   :group 'mail)
  42
  43 (defgroup gnus-format nil
  44   "Dealing with formatting issues."
  45   :group 'gnus)
  46
  47 (defgroup gnus-charset nil
  48   "Group character set issues."
  49   :link '(custom-manual "(gnus)Charsets")
  50   :version "21.1"
  51   :group 'gnus)
  52
  53 (defgroup gnus-cache nil
  54   "Cache interface."
  55   :link '(custom-manual "(gnus)Article Caching")
  56   :group 'gnus)
  57
  58 (defgroup gnus-registry nil
  59   "Article Registry."
  60   :group 'gnus)
  61
  62 (defgroup gnus-start nil
  63   "Starting your favorite newsreader."
  64   :group 'gnus)
  65
  66 (defgroup gnus-start-server nil
  67   "Server options at startup."
  68   :group 'gnus-start)
  69
  70 ;; These belong to gnus-group.el.
  71 (defgroup gnus-group nil
  72   "Group buffers."
  73   :link '(custom-manual "(gnus)The Group Buffer")
  74   :group 'gnus)
  75
  76 (defgroup gnus-group-foreign nil
  77   "Foreign groups."
  78   :link '(custom-manual "(gnus)Foreign Groups")
  79   :group 'gnus-group)
  80
  81 (defgroup gnus-group-new nil
  82   "Automatic subscription of new groups."
  83   :group 'gnus-group)
  84
  85 (defgroup gnus-group-levels nil
  86   "Group levels."
  87   :link '(custom-manual "(gnus)Group Levels")
  88   :group 'gnus-group)
  89
  90 (defgroup gnus-group-select nil
  91   "Selecting a Group."
  92   :link '(custom-manual "(gnus)Selecting a Group")
  93   :group 'gnus-group)
  94
  95 (defgroup gnus-group-listing nil
  96   "Showing slices of the group list."
  97   :link '(custom-manual "(gnus)Listing Groups")
  98   :group 'gnus-group)
  99
 100 (defgroup gnus-group-visual nil
 101   "Sorting the group buffer."
 102   :link '(custom-manual "(gnus)Group Buffer Format")
 103   :group 'gnus-group
 104   :group 'gnus-visual)
 105
 106 (defgroup gnus-group-various nil
 107   "Various group options."
 108   :link '(custom-manual "(gnus)Scanning New Messages")
 109   :group 'gnus-group)
 110
 111 ;; These belong to gnus-sum.el.
 112 (defgroup gnus-summary nil
 113   "Summary buffers."
 114   :link '(custom-manual "(gnus)The Summary Buffer")
 115   :group 'gnus)
 116
 117 (defgroup gnus-summary-exit nil
 118   "Leaving summary buffers."
 119   :link '(custom-manual "(gnus)Exiting the Summary Buffer")
 120   :group 'gnus-summary)
 121
 122 (defgroup gnus-summary-marks nil
 123   "Marks used in summary buffers."
 124   :link '(custom-manual "(gnus)Marking Articles")
 125   :group 'gnus-summary)
 126
 127 (defgroup gnus-thread nil
 128   "Ordering articles according to replies."
 129   :link '(custom-manual "(gnus)Threading")
 130   :group 'gnus-summary)
 131
 132 (defgroup gnus-summary-format nil
 133   "Formatting of the summary buffer."
 134   :link '(custom-manual "(gnus)Summary Buffer Format")
 135   :group 'gnus-summary)
 136
 137 (defgroup gnus-summary-choose nil
 138   "Choosing Articles."
 139   :link '(custom-manual "(gnus)Choosing Articles")
 140   :group 'gnus-summary)
 141
 142 (defgroup gnus-summary-maneuvering nil
 143   "Summary movement commands."
 144   :link '(custom-manual "(gnus)Summary Maneuvering")
 145   :group 'gnus-summary)
 146
 147 (defgroup gnus-picon nil
 148   "Show pictures of people, domains, and newsgroups."
 149   :group 'gnus-visual)
 150
 151 (defgroup gnus-summary-mail nil
 152   "Mail group commands."
 153   :link '(custom-manual "(gnus)Mail Group Commands")
 154   :group 'gnus-summary)
 155
 156 (defgroup gnus-summary-sort nil
 157   "Sorting the summary buffer."
 158   :link '(custom-manual "(gnus)Sorting")
 159   :group 'gnus-summary)
 160
 161 (defgroup gnus-summary-visual nil
 162   "Highlighting and menus in the summary buffer."
 163   :link '(custom-manual "(gnus)Summary Highlighting")
 164   :group 'gnus-visual
 165   :group 'gnus-summary)
 166
 167 (defgroup gnus-summary-various nil
 168   "Various summary buffer options."
 169   :link '(custom-manual "(gnus)Various Summary Stuff")
 170   :group 'gnus-summary)
 171
 172 (defgroup gnus-summary-pick nil
 173   "Pick mode in the summary buffer."
 174   :link '(custom-manual "(gnus)Pick and Read")
 175   :prefix "gnus-pick-"
 176   :group 'gnus-summary)
 177
 178 (defgroup gnus-summary-tree nil
 179   "Tree display of threads in the summary buffer."
 180   :link '(custom-manual "(gnus)Tree Display")
 181   :prefix "gnus-tree-"
 182   :group 'gnus-summary)
 183
 184 ;; Belongs to gnus-uu.el
 185 (defgroup gnus-extract-view nil
 186   "Viewing extracted files."
 187   :link '(custom-manual "(gnus)Viewing Files")
 188   :group 'gnus-extract)
 189
 190 ;; Belongs to gnus-score.el
 191 (defgroup gnus-score nil
 192   "Score and kill file handling."
 193   :group 'gnus)
 194
 195 (defgroup gnus-score-kill nil
 196   "Kill files."
 197   :group 'gnus-score)
 198
 199 (defgroup gnus-score-adapt nil
 200   "Adaptive score files."
 201   :group 'gnus-score)
 202
 203 (defgroup gnus-score-default nil
 204   "Default values for score files."
 205   :group 'gnus-score)
 206
 207 (defgroup gnus-score-expire nil
 208   "Expiring score rules."
 209   :group 'gnus-score)
 210
 211 (defgroup gnus-score-decay nil
 212   "Decaying score rules."
 213   :group 'gnus-score)
 214
 215 (defgroup gnus-score-files nil
 216   "Score and kill file names."
 217   :group 'gnus-score
 218   :group 'gnus-files)
 219
 220 (defgroup gnus-score-various nil
 221   "Various scoring and killing options."
 222   :group 'gnus-score)
 223
 224 ;; Other
 225 (defgroup gnus-visual nil
 226   "Options controlling the visual fluff."
 227   :group 'gnus
 228   :group 'faces)
 229
 230 (defgroup gnus-agent nil
 231   "Offline support for Gnus."
 232   :group 'gnus)
 233
 234 (defgroup gnus-files nil
 235   "Files used by Gnus."
 236   :group 'gnus)
 237
 238 (defgroup gnus-dribble-file nil
 239   "Auto save file."
 240   :link '(custom-manual "(gnus)Auto Save")
 241   :group 'gnus-files)
 242
 243 (defgroup gnus-newsrc nil
 244   "Storing Gnus state."
 245   :group 'gnus-files)
 246
 247 (defgroup gnus-server nil
 248   "Options related to newsservers and other servers used by Gnus."
 249   :group 'gnus)
 250
 251 (defgroup gnus-server-visual nil
 252   "Highlighting and menus in the server buffer."
 253   :group 'gnus-visual
 254   :group 'gnus-server)
 255
 256 (defgroup gnus-message '((message custom-group))
 257   "Composing replies and followups in Gnus."
 258   :group 'gnus)
 259
 260 (defgroup gnus-meta nil
 261   "Meta variables controlling major portions of Gnus.
 262 In general, modifying these variables does not take affect until Gnus
 263 is restarted, and sometimes reloaded."
 264   :group 'gnus)
 265
 266 (defgroup gnus-various nil
 267   "Other Gnus options."
 268   :link '(custom-manual "(gnus)Various Various")
 269   :group 'gnus)
 270
 271 (defgroup gnus-mime nil
 272   "Variables for controlling the Gnus MIME interface."
 273   :group 'gnus)
 274
 275 (defgroup gnus-exit nil
 276   "Exiting gnus."
 277   :link '(custom-manual "(gnus)Exiting Gnus")
 278   :group 'gnus)
 279
 280 (defgroup gnus-fun nil
 281   "Frivolous Gnus extensions."
 282   :link '(custom-manual "(gnus)Exiting Gnus")
 283   :group 'gnus)
 284
 285 (defconst gnus-version-number "5.10.2"
 286   "Version number for this version of Gnus.")
 287
 288 (defconst gnus-version (format "Gnus v%s" gnus-version-number)
 289   "Version string for this version of Gnus.")
 290
 291 (defcustom gnus-inhibit-startup-message nil
 292   "If non-nil, the startup message will not be displayed.
 293 This variable is used before `.gnus.el' is loaded, so it should
 294 be set in `.emacs' instead."
 295   :group 'gnus-start
 296   :type 'boolean)
 297
 298 (defcustom gnus-play-startup-jingle nil
 299   "If non-nil, play the Gnus jingle at startup."
 300   :group 'gnus-start
 301   :type 'boolean)
 302
 303 (unless (fboundp 'gnus-group-remove-excess-properties)
 304   (defalias 'gnus-group-remove-excess-properties 'ignore))
 305
 306 (unless (fboundp 'gnus-set-text-properties)
 307   (defalias 'gnus-set-text-properties 'set-text-properties))
 308
 309 (unless (featurep 'gnus-xmas)
 310   (defalias 'gnus-make-overlay 'make-overlay)
 311   (defalias 'gnus-delete-overlay 'delete-overlay)
 312   (defalias 'gnus-overlay-put 'overlay-put)
 313   (defalias 'gnus-move-overlay 'move-overlay)
 314   (defalias 'gnus-overlay-buffer 'overlay-buffer)
 315   (defalias 'gnus-overlay-start 'overlay-start)
 316   (defalias 'gnus-overlay-end 'overlay-end)
 317   (defalias 'gnus-extent-detached-p 'ignore)
 318   (defalias 'gnus-extent-start-open 'ignore)
 319   (defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window)
 320   (defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names)
 321   (defalias 'gnus-character-to-event 'identity)
 322   (defalias 'gnus-add-text-properties 'add-text-properties)
 323   (defalias 'gnus-put-text-property 'put-text-property)
 324   (defvar gnus-mode-line-image-cache t)
 325   (if (fboundp 'find-image)
 326       (defun gnus-mode-line-buffer-identification (line)
 327         (let ((str (car-safe line)))
 328           (if (and (stringp str)
 329                    (string-match "^Gnus:" str))
 330               (progn (add-text-properties
 331                       0 5
 332                       (list 'display
 333                             (if (eq t gnus-mode-line-image-cache)
 334                                 (setq gnus-mode-line-image-cache
 335                                       (find-image
 336                                        '((:type xpm :file "gnus-pointer.xpm"
 337                                                 :ascent center)
 338                                          (:type xbm :file "gnus-pointer.xbm"
 339                                                 :ascent center))))
 340                               gnus-mode-line-image-cache)
 341                             'help-echo "This is Gnus")
 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 "#000000" "#ff0000")
 852     (neutral "#b4b4b4" "#878787")
 853     (september "#bf9900" "#ffcc00"))
 854   "Color alist used for the Gnus logo.")
 855
 856 (defcustom gnus-logo-color-style 'oort
 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     (if (and (string-match "gnus" command)
 941              (not (string-match "gnus-other-frame" command)))
 942         (gnus-splash)
 943       (gnus-get-buffer-create gnus-group-buffer))))
 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   :group 'gnus-group-various
 964   :type '(repeat (cons regexp
 965                        (repeat sexp))))
 966
 967 (defvar gnus-group-parameters-more nil)
 968
 969 (defmacro gnus-define-group-parameter (param &rest rest)
 970   "Define a group parameter PARAM.
 971 REST is a plist of following:
 972 :type               One of `bool', `list' or nil.
 973 :function           The name of the function.
 974 :function-document  The documentation of the function.
 975 :parameter-type     The type for customizing the parameter.
 976 :parameter-document The documentation for the parameter.
 977 :variable           The name of the variable.
 978 :variable-document  The documentation for the variable.
 979 :variable-group     The group for customizing the variable.
 980 :variable-type      The type for customizing the variable.
 981 :variable-default   The default value of the variable."
 982   (let* ((type (plist-get rest :type))
 983          (parameter-type (plist-get rest :parameter-type))
 984          (parameter-document (plist-get rest :parameter-document))
 985          (function (or (plist-get rest :function)
 986                        (intern (format "gnus-parameter-%s" param))))
 987          (function-document (or (plist-get rest :function-document) ""))
 988          (variable (or (plist-get rest :variable)
 989                        (intern (format "gnus-parameter-%s-alist" param))))
 990          (variable-document (or (plist-get rest :variable-document) ""))
 991          (variable-group (plist-get rest :variable-group))
 992          (variable-type (or (plist-get rest :variable-type)
 993                             `(quote (repeat
 994                                      (list (regexp :tag "Group")
 995                                            ,(car (cdr parameter-type)))))))
 996          (variable-default (plist-get rest :variable-default)))
 997     (list
 998      'progn
 999      `(defcustom ,variable ,variable-default
1000         ,variable-document
1001         :group 'gnus-group-parameter
1002         :group ',variable-group
1003         :type ,variable-type)
1004      `(setq gnus-group-parameters-more
1005             (delq (assq ',param gnus-group-parameters-more)
1006                   gnus-group-parameters-more))
1007      `(add-to-list 'gnus-group-parameters-more
1008                    (list ',param
1009                          ,parameter-type
1010                          ,parameter-document))
1011      (if (eq type 'bool)
1012          `(defun ,function (name)
1013             ,function-document
1014             (let ((params (gnus-group-find-parameter name))
1015                   val)
1016               (cond
1017                ((memq ',param params)
1018                 t)
1019                ((setq val (assq ',param params))
1020                 (cdr val))
1021                ((stringp ,variable)
1022                 (string-match ,variable name))
1023                (,variable
1024                 (let ((alist ,variable)
1025                       elem value)
1026                   (while (setq elem (pop alist))
1027                     (when (and name
1028                                (string-match (car elem) name))
1029                       (setq alist nil
1030                             value (cdr elem))))
1031                   (if (consp value) (car value) value))))))
1032        `(defun ,function (name)
1033           ,function-document
1034           (and name
1035                (or (gnus-group-find-parameter name ',param ,(and type t))
1036                    (let ((alist ,variable)
1037                          elem value)
1038                      (while (setq elem (pop alist))
1039                        (when (and name
1040                                   (string-match (car elem) name))
1041                          (setq alist nil
1042                                value (cdr elem))))
1043                      ,(if type
1044                           'value
1045                         '(if (consp value) (car value) value))))))))))
1046
1047 (defcustom gnus-home-directory "~/"
1048   "Directory variable that specifies the \"home\" directory.
1049 All other Gnus file and directory variables are initialized from this variable."
1050   :group 'gnus-files
1051   :type 'directory)
1052
1053 (defcustom gnus-directory (or (getenv "SAVEDIR")
1054                               (nnheader-concat gnus-home-directory "News/"))
1055   "*Directory variable from which all other Gnus file variables are derived.
1056
1057 Note that Gnus is mostly loaded when the `.gnus.el' file is read.
1058 This means that other directory variables that are initialized from
1059 this variable won't be set properly if you set this variable in `.gnus.el'.
1060 Set this variable in `.emacs' instead."
1061   :group 'gnus-files
1062   :type 'directory)
1063
1064 (defcustom gnus-default-directory nil
1065   "*Default directory for all Gnus buffers."
1066   :group 'gnus-files
1067   :type '(choice (const :tag "current" nil)
1068                  directory))
1069
1070 ;; Site dependent variables.  These variables should be defined in
1071 ;; paths.el.
1072
1073 (defvar gnus-default-nntp-server nil
1074   "Specify a default NNTP server.
1075 This variable should be defined in paths.el, and should never be set
1076 by the user.
1077 If you want to change servers, you should use `gnus-select-method'.
1078 See the documentation to that variable.")
1079
1080 ;; Don't touch this variable.
1081 (defvar gnus-nntp-service "nntp"
1082   "NNTP service name (\"nntp\" or 119).
1083 This is an obsolete variable, which is scarcely used.  If you use an
1084 nntp server for your newsgroup and want to change the port number
1085 used to 899, you would say something along these lines:
1086
1087  (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))")
1088
1089 (defcustom gnus-nntpserver-file "/etc/nntpserver"
1090   "A file with only the name of the nntp server in it."
1091   :group 'gnus-files
1092   :group 'gnus-server
1093   :type 'file)
1094
1095 ;; This function is used to check both the environment variable
1096 ;; NNTPSERVER and the /etc/nntpserver file to see whether one can find
1097 ;; an nntp server name default.
1098 (defun gnus-getenv-nntpserver ()
1099   (or (getenv "NNTPSERVER")
1100       (and (file-readable-p gnus-nntpserver-file)
1101            (save-excursion
1102              (set-buffer (gnus-get-buffer-create " *gnus nntp*"))
1103              (insert-file-contents gnus-nntpserver-file)
1104              (let ((name (buffer-string)))
1105                (prog1
1106                    (if (string-match "\\'[ \t\n]*$" name)
1107                        nil
1108                      name)
1109                  (kill-buffer (current-buffer))))))))
1110
1111 (defcustom gnus-select-method
1112   (condition-case nil
1113       (nconc
1114        (list 'nntp (or (condition-case nil