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

   1 ;;; gnus.el --- a newsreader for GNU Emacs
   2 ;; Copyright (C) 1987,88,89,90,93,94,95,96,97 Free Software Foundation, Inc.
   3
   4 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
   5 ;;      Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
   6 ;; Keywords: news
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;;; Code:
  28
  29 (eval '(run-hooks 'gnus-load-hook))
  30
  31 (require 'custom)
  32 (require 'gnus-load)
  33
  34 (defgroup gnus nil
  35   "The coffee-brewing, all singing, all dancing, kitchen sink newsreader."
  36   :group 'emacs)
  37
  38 (defgroup gnus-start nil
  39   "Starting your favorite newsreader."
  40   :group 'gnus)
  41
  42 (defgroup gnus-start-server nil
  43   "Server options at startup."
  44   :group 'gnus-start)
  45
  46 ;; These belong to gnus-group.el.
  47 (defgroup gnus-group nil
  48   "Group buffers."
  49   :link '(custom-manual "(gnus)The Group Buffer")
  50   :group 'gnus)
  51
  52 (defgroup gnus-group-foreign nil
  53   "Foreign groups."
  54   :link '(custom-manual "(gnus)Foreign Groups")
  55   :group 'gnus-group)
  56
  57 (defgroup gnus-group-new nil
  58   "Automatic subscription of new groups."
  59   :group 'gnus-group)
  60
  61 (defgroup gnus-group-levels nil
  62   "Group levels."
  63   :link '(custom-manual "(gnus)Group Levels")
  64   :group 'gnus-group)
  65
  66 (defgroup gnus-group-select nil
  67   "Selecting a Group."
  68   :link '(custom-manual "(gnus)Selecting a Group")
  69   :group 'gnus-group)
  70
  71 (defgroup gnus-group-listing nil
  72   "Showing slices of the group list."
  73   :link '(custom-manual "(gnus)Listing Groups")
  74   :group 'gnus-group)
  75
  76 (defgroup gnus-group-visual nil
  77   "Sorting the group buffer."
  78   :link '(custom-manual "(gnus)Group Buffer Format")
  79   :group 'gnus-group
  80   :group 'gnus-visual)
  81
  82 (defgroup gnus-group-various nil
  83   "Various group options."
  84   :link '(custom-manual "(gnus)Scanning New Messages")
  85   :group 'gnus-group)
  86
  87 ;; These belong to gnus-sum.el.
  88 (defgroup gnus-summary nil
  89   "Summary buffers."
  90   :link '(custom-manual "(gnus)The Summary Buffer")
  91   :group 'gnus)
  92
  93 (defgroup gnus-summary-exit nil
  94   "Leaving summary buffers."
  95   :link '(custom-manual "(gnus)Exiting the Summary Buffer")
  96   :group 'gnus-summary)
  97
  98 (defgroup gnus-summary-marks nil
  99   "Marks used in summary buffers."
 100   :link '(custom-manual "(gnus)Marking Articles")
 101   :group 'gnus-summary)
 102
 103 (defgroup gnus-thread nil
 104   "Ordering articles according to replies."
 105   :link '(custom-manual "(gnus)Threading")
 106   :group 'gnus-summary)
 107
 108 (defgroup gnus-summary-format nil
 109   "Formatting of the summary buffer."
 110   :link '(custom-manual "(gnus)Summary Buffer Format")
 111   :group 'gnus-summary)
 112
 113 (defgroup gnus-summary-choose nil
 114   "Choosing Articles."
 115   :link '(custom-manual "(gnus)Choosing Articles")
 116   :group 'gnus-summary)
 117
 118 (defgroup gnus-summary-maneuvering nil
 119   "Summary movement commands."
 120   :link '(custom-manual "(gnus)Summary Maneuvering")
 121   :group 'gnus-summary)
 122
 123 (defgroup gnus-summary-mail nil
 124   "Mail group commands."
 125   :link '(custom-manual "(gnus)Mail Group Commands")
 126   :group 'gnus-summary)
 127
 128 (defgroup gnus-summary-sort nil
 129   "Sorting the summary buffer."
 130   :link '(custom-manual "(gnus)Sorting")
 131   :group 'gnus-summary)
 132
 133 (defgroup gnus-summary-visual nil
 134   "Highlighting and menus in the summary buffer."
 135   :link '(custom-manual "(gnus)Summary Highlighting")
 136   :group 'gnus-visual
 137   :group 'gnus-summary)
 138
 139 (defgroup gnus-summary-various nil
 140   "Various summary buffer options."
 141   :link '(custom-manual "(gnus)Various Summary Stuff")
 142   :group 'gnus-summary)
 143
 144 ;; Belongs to gnus-uu.el
 145 (defgroup gnus-extract-view nil
 146   "Viewing extracted files."
 147   :link '(custom-manual "(gnus)Viewing Files")
 148   :group 'gnus-extract)
 149
 150 ;; Belongs to gnus-score.el
 151 (defgroup gnus-score nil
 152   "Score and kill file handling."
 153   :group 'gnus)
 154
 155 (defgroup gnus-score-kill nil
 156   "Kill files."
 157   :group 'gnus-score)
 158
 159 (defgroup gnus-score-adapt nil
 160   "Adaptive score files."
 161   :group 'gnus-score)
 162
 163 (defgroup gnus-score-default nil
 164   "Default values for score files."
 165   :group 'gnus-score)
 166
 167 (defgroup gnus-score-expire nil
 168   "Expiring score rules."
 169   :group 'gnus-score)
 170
 171 (defgroup gnus-score-decay nil
 172   "Decaying score rules."
 173   :group 'gnus-score)
 174
 175 (defgroup gnus-score-files nil
 176   "Score and kill file names."
 177   :group 'gnus-score
 178   :group 'gnus-files)
 179
 180 (defgroup gnus-score-various nil
 181   "Various scoring and killing options."
 182   :group 'gnus-score)
 183
 184 ;; Other
 185 (defgroup gnus-visual nil
 186   "Options controling the visual fluff."
 187   :group 'gnus)
 188
 189 (defgroup gnus-files nil
 190   "Files used by Gnus."
 191   :group 'gnus)
 192
 193 (defgroup gnus-dribble-file nil
 194   "Auto save file."
 195   :link '(custom-manual "(gnus)Auto Save")
 196   :group 'gnus-files)
 197
 198 (defgroup gnus-newsrc nil
 199   "Storing Gnus state."
 200   :group 'gnus-files)
 201
 202 (defgroup gnus-server nil
 203   "Options related to newsservers and other servers used by Gnus."
 204   :group 'gnus)
 205
 206 (defgroup gnus-message '((message custom-group))
 207   "Composing replies and followups in Gnus."
 208   :group 'gnus)
 209
 210 (defgroup gnus-meta nil
 211   "Meta variables controling major portions of Gnus.
 212 In general, modifying these variables does not take affect until Gnus
 213 is restarted, and sometimes reloaded."
 214   :group 'gnus)
 215
 216 (defgroup gnus-various nil
 217   "Other Gnus options."
 218   :link '(custom-manual "(gnus)Various Various")
 219   :group 'gnus)
 220
 221 (defgroup gnus-exit nil
 222   "Exiting gnus."
 223   :link '(custom-manual "(gnus)Exiting Gnus")
 224   :group 'gnus)
 225
 226 (defconst gnus-version-number "5.4.16"
 227   "Version number for this version of Gnus.")
 228
 229 (defconst gnus-version (format "Gnus v%s" gnus-version-number)
 230   "Version string for this version of Gnus.")
 231
 232 (defcustom gnus-inhibit-startup-message nil
 233   "If non-nil, the startup message will not be displayed.
 234 This variable is used before `.gnus.el' is loaded, so it should
 235 be set in `.emacs' instead."
 236   :group 'gnus-start
 237   :type 'boolean)
 238
 239 (defcustom gnus-play-startup-jingle nil
 240   "If non-nil, play the Gnus jingle at startup."
 241   :group 'gnus-start
 242   :type 'boolean)
 243
 244 ;;; Kludges to help the transition from the old `custom.el'.
 245
 246 (unless (featurep 'gnus-xmas)
 247   (defalias 'gnus-make-overlay 'make-overlay)
 248   (defalias 'gnus-overlay-put 'overlay-put)
 249   (defalias 'gnus-move-overlay 'move-overlay)
 250   (defalias 'gnus-overlay-end 'overlay-end)
 251   (defalias 'gnus-extent-detached-p 'ignore)
 252   (defalias 'gnus-extent-start-open 'ignore)
 253   (defalias 'gnus-set-text-properties 'set-text-properties)
 254   (defalias 'gnus-group-remove-excess-properties 'ignore)
 255   (defalias 'gnus-topic-remove-excess-properties 'ignore)
 256   (defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window)
 257   (defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names)
 258   (defalias 'gnus-add-hook 'add-hook)
 259   (defalias 'gnus-character-to-event 'identity)
 260   (defalias 'gnus-add-text-properties 'add-text-properties)
 261   (defalias 'gnus-put-text-property 'put-text-property)
 262   (defalias 'gnus-mode-line-buffer-identification 'identity)
 263   (defalias 'gnus-characterp 'numberp)
 264   (defalias 'gnus-key-press-event-p 'numberp))
 265
 266 ;; The XEmacs people think this is evil, so it must go.
 267 (defun custom-face-lookup (&optional fg bg stipple bold italic underline)
 268   "Lookup or create a face with specified attributes."
 269   (let ((name (intern (format "custom-face-%s-%s-%s-%S-%S-%S"
 270                               (or fg "default")
 271                               (or bg "default")
 272                               (or stipple "default")
 273                               bold italic underline))))
 274     (if (and (custom-facep name)
 275              (fboundp 'make-face))
 276         ()
 277       (copy-face 'default name)
 278       (when (and fg
 279                  (not (string-equal fg "default")))
 280         (ignore-errors
 281           (set-face-foreground name fg)))
 282       (when (and bg
 283                  (not (string-equal bg "default")))
 284         (ignore-errors
 285           (set-face-background name bg)))
 286       (when (and stipple
 287                  (not (string-equal stipple "default"))
 288                  (not (eq stipple 'custom:asis))
 289                  (fboundp 'set-face-stipple))
 290         (set-face-stipple name stipple))
 291       (when (and bold
 292                  (not (eq bold 'custom:asis)))
 293         (ignore-errors
 294           (make-face-bold name)))
 295       (when (and italic
 296                  (not (eq italic 'custom:asis)))
 297         (ignore-errors
 298           (make-face-italic name)))
 299       (when (and underline
 300                  (not (eq underline 'custom:asis)))
 301         (ignore-errors
 302           (set-face-underline-p name t))))
 303     name))
 304
 305 ;; We define these group faces here to avoid the display
 306 ;; update forced when creating new faces.
 307
 308 (defface gnus-group-news-1-face
 309   '((((class color)
 310       (background dark))
 311      (:foreground "PaleTurquoise" :bold t))
 312     (((class color)
 313       (background light))
 314      (:foreground "ForestGreen" :bold t))
 315     (t
 316      ()))
 317   "Level 1 newsgroup face.")
 318
 319 (defface gnus-group-news-1-empty-face
 320   '((((class color)
 321       (background dark))
 322      (:foreground "PaleTurquoise"))
 323     (((class color)
 324       (background light))
 325      (:foreground "ForestGreen"))
 326     (t
 327      ()))
 328   "Level 1 empty newsgroup face.")
 329
 330 (defface gnus-group-news-2-face
 331   '((((class color)
 332       (background dark))
 333      (:foreground "turquoise" :bold t))
 334     (((class color)
 335       (background light))
 336      (:foreground "CadetBlue4" :bold t))
 337     (t
 338      ()))
 339   "Level 2 newsgroup face.")
 340
 341 (defface gnus-group-news-2-empty-face
 342   '((((class color)
 343       (background dark))
 344      (:foreground "turquoise"))
 345     (((class color)
 346       (background light))
 347      (:foreground "CadetBlue4"))
 348     (t
 349      ()))
 350   "Level 2 empty newsgroup face.")
 351
 352 (defface gnus-group-news-3-face
 353   '((((class color)
 354       (background dark))
 355      (:bold t))
 356     (((class color)
 357       (background light))
 358      (:bold t))
 359     (t
 360      ()))
 361   "Level 3 newsgroup face.")
 362
 363 (defface gnus-group-news-3-empty-face
 364   '((((class color)
 365       (background dark))
 366      ())
 367     (((class color)
 368       (background light))
 369      ())
 370     (t
 371      ()))
 372   "Level 3 empty newsgroup face.")
 373
 374 (defface gnus-group-news-low-face
 375   '((((class color)
 376       (background dark))
 377      (:foreground "DarkTurquoise" :bold t))
 378     (((class color)
 379       (background light))
 380      (:foreground "DarkGreen" :bold t))
 381     (t
 382      ()))
 383   "Low level newsgroup face.")
 384
 385 (defface gnus-group-news-low-empty-face
 386   '((((class color)
 387       (background dark))
 388      (:foreground "DarkTurquoise"))
 389     (((class color)
 390       (background light))
 391      (:foreground "DarkGreen"))
 392     (t
 393      ()))
 394   "Low level empty newsgroup face.")
 395
 396 (defface gnus-group-mail-1-face
 397   '((((class color)
 398       (background dark))
 399      (:foreground "aquamarine1" :bold t))
 400     (((class color)
 401       (background light))
 402      (:foreground "DeepPink3" :bold t))
 403     (t
 404      (:bold t)))
 405   "Level 1 mailgroup face.")
 406
 407 (defface gnus-group-mail-1-empty-face
 408   '((((class color)
 409       (background dark))
 410      (:foreground "aquamarine1"))
 411     (((class color)
 412       (background light))
 413      (:foreground "DeepPink3"))
 414     (t
 415      (:italic t :bold t)))
 416   "Level 1 empty mailgroup face.")
 417
 418 (defface gnus-group-mail-2-face
 419   '((((class color)
 420       (background dark))
 421      (:foreground "aquamarine2" :bold t))
 422     (((class color)
 423       (background light))
 424      (:foreground "HotPink3" :bold t))
 425     (t
 426      (:bold t)))
 427   "Level 2 mailgroup face.")
 428
 429 (defface gnus-group-mail-2-empty-face
 430   '((((class color)
 431       (background dark))
 432      (:foreground "aquamarine2"))
 433     (((class color)
 434       (background light))
 435      (:foreground "HotPink3"))
 436     (t
 437      (:bold t)))
 438   "Level 2 empty mailgroup face.")
 439
 440 (defface gnus-group-mail-3-face
 441   '((((class color)
 442       (background dark))
 443      (:foreground "aquamarine3" :bold t))
 444     (((class color)
 445       (background light))
 446      (:foreground "magenta4" :bold t))
 447     (t
 448      (:bold t)))
 449   "Level 3 mailgroup face.")
 450
 451 (defface gnus-group-mail-3-empty-face
 452   '((((class color)
 453       (background dark))
 454      (:foreground "aquamarine3"))
 455     (((class color)
 456       (background light))
 457      (:foreground "magenta4"))
 458     (t
 459      ()))
 460   "Level 3 empty mailgroup face.")
 461
 462 (defface gnus-group-mail-low-face
 463   '((((class color)
 464       (background dark))
 465      (:foreground "aquamarine4" :bold t))
 466     (((class color)
 467       (background light))
 468      (:foreground "DeepPink4" :bold t))
 469     (t
 470      (:bold t)))
 471   "Low level mailgroup face.")
 472
 473 (defface gnus-group-mail-low-empty-face
 474   '((((class color)
 475       (background dark))
 476      (:foreground "aquamarine4"))
 477     (((class color)
 478       (background light))
 479      (:foreground "DeepPink4"))
 480     (t
 481      (:bold t)))
 482   "Low level empty mailgroup face.")
 483
 484 ;; Summary mode faces.
 485
 486 (defface gnus-summary-selected-face '((t
 487                                        (:underline t)))
 488   "Face used for selected articles.")
 489
 490 (defface gnus-summary-cancelled-face
 491   '((((class color))
 492      (:foreground "yellow" :background "black")))
 493   "Face used for cancelled articles.")
 494
 495 (defface gnus-summary-high-ticked-face
 496   '((((class color)
 497       (background dark))
 498      (:foreground "pink" :bold t))
 499     (((class color)
 500       (background light))
 501      (:foreground "firebrick" :bold t))
 502     (t
 503      (:bold t)))
 504   "Face used for high interest ticked articles.")
 505
 506 (defface gnus-summary-low-ticked-face
 507   '((((class color)
 508       (background dark))
 509      (:foreground "pink" :italic t))
 510     (((class color)
 511       (background light))
 512      (:foreground "firebrick" :italic t))
 513     (t
 514      (:italic t)))
 515   "Face used for low interest ticked articles.")
 516
 517 (defface gnus-summary-normal-ticked-face
 518   '((((class color)
 519       (background dark))
 520      (:foreground "pink"))
 521     (((class color)
 522       (background light))
 523      (:foreground "firebrick"))
 524     (t
 525      ()))
 526   "Face used for normal interest ticked articles.")
 527
 528 (defface gnus-summary-high-ancient-face
 529   '((((class color)
 530       (background dark))
 531      (:foreground "SkyBlue" :bold t))
 532     (((class color)
 533       (background light))
 534      (:foreground "RoyalBlue" :bold t))
 535     (t
 536      (:bold t)))
 537   "Face used for high interest ancient articles.")
 538
 539 (defface gnus-summary-low-ancient-face
 540   '((((class color)
 541       (background dark))
 542      (:foreground "SkyBlue" :italic t))
 543     (((class color)
 544       (background light))
 545      (:foreground "RoyalBlue" :italic t))
 546     (t
 547      (:italic t)))
 548   "Face used for low interest ancient articles.")
 549
 550 (defface gnus-summary-normal-ancient-face
 551   '((((class color)
 552       (background dark))
 553      (:foreground "SkyBlue"))
 554     (((class color)
 555       (background light))
 556      (:foreground "RoyalBlue"))
 557     (t
 558      ()))
 559   "Face used for normal interest ancient articles.")
 560
 561 (defface gnus-summary-high-unread-face
 562   '((t
 563      (:bold t)))
 564   "Face used for high interest unread articles.")
 565
 566 (defface gnus-summary-low-unread-face
 567   '((t
 568      (:italic t)))
 569   "Face used for low interest unread articles.")
 570
 571 (defface gnus-summary-normal-unread-face
 572   '((t
 573      ()))
 574   "Face used for normal interest unread articles.")
 575
 576 (defface gnus-summary-high-read-face
 577   '((((class color)
 578       (background dark))
 579      (:foreground "PaleGreen"
 580                   :bold t))
 581     (((class color)
 582       (background light))
 583      (:foreground "DarkGreen"
 584                   :bold t))
 585     (t
 586      (:bold t)))
 587   "Face used for high interest read articles.")
 588
 589 (defface gnus-summary-low-read-face
 590   '((((class color)
 591       (background dark))
 592      (:foreground "PaleGreen"
 593                   :italic t))
 594     (((class color)
 595       (background light))
 596      (:foreground "DarkGreen"
 597                   :italic t))
 598     (t
 599      (:italic t)))
 600   "Face used for low interest read articles.")
 601
 602 (defface gnus-summary-normal-read-face
 603   '((((class color)
 604       (background dark))
 605      (:foreground "PaleGreen"))