;;; gnus.el --- a newsreader for GNU Emacs
-;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, 1997,
-;; 1998, 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
+;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, 1997, 1998,
+;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+;; Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(eval '(run-hooks 'gnus-load-hook))
+;; For Emacs <22.2 and XEmacs.
+(eval-and-compile
+ (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
+
(eval-when-compile (require 'cl))
(require 'wid-edit)
(require 'mm-util)
(require 'nnheader)
+;; These are defined afterwards with gnus-define-group-parameter
+(defvar gnus-ham-process-destinations)
+(defvar gnus-parameter-ham-marks-alist)
+(defvar gnus-parameter-spam-marks-alist)
+(defvar gnus-spam-autodetect)
+(defvar gnus-spam-autodetect-methods)
+(defvar gnus-spam-newsgroup-contents)
+(defvar gnus-spam-process-destinations)
+(defvar gnus-spam-resend-to)
+(defvar gnus-ham-resend-to)
+(defvar gnus-spam-process-newsgroups)
+
+
(defgroup gnus nil
"The coffee-brewing, all singing, all dancing, kitchen sink newsreader."
:group 'news
:group 'mail)
+(defgroup gnus-start nil
+ "Starting your favorite newsreader."
+ :group 'gnus)
+
(defgroup gnus-format nil
"Dealing with formatting issues."
:group 'gnus)
"Article Registry."
:group 'gnus)
-(defgroup gnus-start nil
- "Starting your favorite newsreader."
- :group 'gnus)
-
(defgroup gnus-start-server nil
"Server options at startup."
:group 'gnus-start)
;; These belong to gnus-group.el.
(defgroup gnus-group nil
"Group buffers."
- :link '(custom-manual "(gnus)The Group Buffer")
+ :link '(custom-manual "(gnus)Group Buffer")
:group 'gnus)
(defgroup gnus-group-foreign nil
;; These belong to gnus-sum.el.
(defgroup gnus-summary nil
"Summary buffers."
- :link '(custom-manual "(gnus)The Summary Buffer")
+ :link '(custom-manual "(gnus)Summary Buffer")
:group 'gnus)
(defgroup gnus-summary-exit nil
(defgroup gnus-summary-sort nil
"Sorting the summary buffer."
- :link '(custom-manual "(gnus)Sorting")
+ :link '(custom-manual "(gnus)Sorting the Summary Buffer")
:group 'gnus-summary)
(defgroup gnus-summary-visual nil
:link '(custom-manual "(gnus)Various Various")
:group 'gnus)
-(defgroup gnus-mime nil
- "Variables for controlling the Gnus MIME interface."
- :group 'gnus)
-
(defgroup gnus-exit nil
- "Exiting gnus."
+ "Exiting Gnus."
:link '(custom-manual "(gnus)Exiting Gnus")
:group 'gnus)
:link '(custom-manual "(gnus)Exiting Gnus")
:group 'gnus)
-(defconst gnus-version-number "5.10.3"
+(defconst gnus-version-number "0.11"
"Version number for this version of Gnus.")
-(defconst gnus-version (format "Gnus v%s" gnus-version-number)
+(defconst gnus-version (format "No Gnus v%s" gnus-version-number)
"Version string for this version of Gnus.")
(defcustom gnus-inhibit-startup-message nil
:group 'gnus-start
:type 'boolean)
-(defcustom gnus-play-startup-jingle nil
- "If non-nil, play the Gnus jingle at startup."
- :group 'gnus-start
- :type 'boolean)
-
(unless (fboundp 'gnus-group-remove-excess-properties)
(defalias 'gnus-group-remove-excess-properties 'ignore))
-(unless (fboundp 'gnus-set-text-properties)
- (defalias 'gnus-set-text-properties 'set-text-properties))
-
(unless (featurep 'gnus-xmas)
(defalias 'gnus-make-overlay 'make-overlay)
(defalias 'gnus-delete-overlay 'delete-overlay)
+ (defalias 'gnus-overlay-get 'overlay-get)
(defalias 'gnus-overlay-put 'overlay-put)
(defalias 'gnus-move-overlay 'move-overlay)
(defalias 'gnus-overlay-buffer 'overlay-buffer)
(defalias 'gnus-overlay-start 'overlay-start)
(defalias 'gnus-overlay-end 'overlay-end)
+ (defalias 'gnus-overlays-in 'overlays-in)
(defalias 'gnus-extent-detached-p 'ignore)
(defalias 'gnus-extent-start-open 'ignore)
- (defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window)
(defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names)
(defalias 'gnus-character-to-event 'identity)
(defalias 'gnus-assq-delete-all 'assq-delete-all)
(defvar gnus-mode-line-image-cache t)
(if (fboundp 'find-image)
(defun gnus-mode-line-buffer-identification (line)
- (let ((str (car-safe line)))
+ (let ((str (car-safe line))
+ (load-path (mm-image-load-path)))
(if (and (stringp str)
(string-match "^Gnus:" str))
(progn (add-text-properties
(:type xbm :file "gnus-pointer.xbm"
:ascent center))))
gnus-mode-line-image-cache)
- 'help-echo "This is Gnus")
+ 'help-echo (format
+ "This is %s, %s."
+ gnus-version (gnus-emacs-version)))
str)
(list str))
line)))
;; We define these group faces here to avoid the display
;; update forced when creating new faces.
-(defface gnus-group-news-1-face
+(defface gnus-group-news-1
'((((class color)
(background dark))
(:foreground "PaleTurquoise" :bold t))
(:foreground "ForestGreen" :bold t))
(t
()))
- "Level 1 newsgroup face.")
+ "Level 1 newsgroup face."
+ :group 'gnus-group)
+;; backward-compatibility alias
+(put 'gnus-group-news-1-face 'face-alias 'gnus-group-news-1)
+(put 'gnus-group-news-1-face 'obsolete-face "22.1")
-(defface gnus-group-news-1-empty-face
+(defface gnus-group-news-1-empty
'((((class color)
(background dark))
(:foreground "PaleTurquoise"))
(:foreground "ForestGreen"))
(t
()))
- "Level 1 empty newsgroup face.")
+ "Level 1 empty newsgroup face."
+ :group 'gnus-group)
+;; backward-compatibility alias
+(put 'gnus-group-news-1-empty-face 'face-alias 'gnus-group-news-1-empty)
+(put 'gnus-group-news-1-empty-face 'obsolete-face "22.1")
-(defface gnus-group-news-2-face
+(defface gnus-group-news-2
'((((class color)
(background dark))
(:foreground "turquoise" :bold t))
(:foreground "CadetBlue4" :bold t))
(t
()))
- "Level 2 newsgroup face.")
+ "Level 2 newsgroup face."
+ :group 'gnus-group)
+;; backward-compatibility alias
+(put 'gnus-group-news-2-face 'face-alias 'gnus-group-news-2)
+(put 'gnus-group-news-2-face 'obsolete-face "22.1")
-(defface gnus-group-news-2-empty-face
+(defface gnus-group-news-2-empty
'((((class color)
(background dark))
(:foreground "turquoise"))
(:foreground "CadetBlue4"))
(t
()))
- "Level 2 empty newsgroup face.")
+ "Level 2 empty newsgroup face."
+ :group 'gnus-group)
+;; backward-compatibility alias
+(put 'gnus-group-news-2-empty-face 'face-alias 'gnus-group-news-2-empty)
+(put 'gnus-group-news-2-empty-face 'obsolete-face "22.1")
-(defface gnus-group-news-3-face
+(defface gnus-group-news-3
'((((class color)
(background dark))
(:bold t))
(:bold t))
(t
()))
- "Level 3 newsgroup face.")
+ "Level 3 newsgroup face."
+ :group 'gnus-group)
+;; backward-compatibility alias
+(put 'gnus-group-news-3-face 'face-alias 'gnus-group-news-3)
+(put 'gnus-group-news-3-face 'obsolete-face "22.1")
-(defface gnus-group-news-3-empty-face
+(defface gnus-group-news-3-empty
'((((class color)
(background dark))
())
())
(t
()))
- "Level 3 empty newsgroup face.")
+ "Level 3 empty newsgroup face."
+ :group 'gnus-group)
+;; backward-compatibility alias
+(put 'gnus-group-news-3-empty-face 'face-alias 'gnus-group-news-3-empty)
+(put 'gnus-group-news-3-empty-face 'obsolete-face "22.1")
-(defface gnus-group-news-4-face
+(defface gnus-group-news-4
'((((class color)
(background dark))
(:bold t))
(:bold t))
(t
()))
- "Level 4 newsgroup face.")
+ "Level 4 newsgroup face."
+ :group 'gnus-group)
+;; backward-compatibility alias
+(put 'gnus-group-news-4-face 'face-alias 'gnus-group-news-4)
+(put 'gnus-group-news-4-face 'obsolete-face "22.1")
-(defface gnus-group-news-4-empty-face
+(defface gnus-group-news-4-empty
'((((class color)
(background dark))
())
())
(t
()))
- "Level 4 empty newsgroup face.")
+ "Level 4 empty newsgroup face."
+ :group 'gnus-group)
+;; backward-compatibility alias
+(put 'gnus-group-news-4-empty-face 'face-alias 'gnus-group-news-4-empty)
+(put 'gnus-group-news-4-empty-face 'obsolete-face "22.1")
-(defface gnus-group-news-5-face
+(defface gnus-group-news-5
'((((class color)
(background dark))
(:bold t))
(:bold t))
(t
()))
- "Level 5 newsgroup face.")
+ "Level 5 newsgroup face."
+ :group 'gnus-group)
+;; backward-compatibility alias
+(put 'gnus-group-news-5-face 'face-alias 'gnus-group-news-5)
+(put 'gnus-group-news-5-face 'obsolete-face "22.1")
-(defface gnus-group-news-5-empty-face
+(defface gnus-group-news-5-empty
'((((class color)
(background dark))
())
())
(t
()))
- "Level 5 empty newsgroup face.")
+ "Level 5 empty newsgroup face."
+ :group 'gnus-group)
+;; backward-compatibility alias
+(put 'gnus-group-news-5-empty-face 'face-alias 'gnus-group-news-5-empty)
+(put 'gnus-group-news-5-empty-face 'obsolete-face "22.1")
-(defface gnus-group-news-6-face
+(defface gnus-group-news-6
'((((class color)
(background dark))
(:bold t))
(:bold t))
(t
()))
- "Level 6 newsgroup face.")
+ "Level 6 newsgroup face."
+ :group 'gnus-group)
+;; backward-compatibility alias
+(put 'gnus-group-news-6-face 'face-alias 'gnus-group-news-6)
+(put 'gnus-group-news-6-face 'obsolete-face "22.1")
-(defface gnus-group-news-6-empty-face
+(defface gnus-group-news-6-empty
'((((class color)
(background dark))
())
())
(t
()))
- "Level 6 empty newsgroup face.")
+ "Level 6 empty newsgroup face."
+ :group 'gnus-group)
+;; backward-compatibility alias
+(put 'gnus-group-news-6-empty-face 'face-alias 'gnus-group-news-6-empty)
+(put 'gnus-group-news-6-empty-face 'obsolete-face "22.1")
-(defface gnus-group-news-low-face
+(defface gnus-group-news-low
'((((class color)
(background dark))
(:foreground "DarkTurquoise" :bold t))
(:foreground "DarkGreen" :bold t))
(t
()))
- "Low level newsgroup face.")
+ "Low level newsgroup face."
+ :group 'gnus-group)
+;; backward-compatibility alias
+(put 'gnus-group-news-low-face 'face-alias 'gnus-group-news-low)
+(put 'gnus-group-news-low-face 'obsolete-face "22.1")
-(defface gnus-group-news-low-empty-face
+(defface gnus-group-news-low-empty
'((((class color)
(background dark))
(:foreground "DarkTurquoise"))
(:foreground "DarkGreen"))
(t
()))
- "Low level empty newsgroup face.")
+ "Low level empty newsgroup face."
+ :group 'gnus-group)
+;; backward-compatibility alias
+(put 'gnus-group-news-low-empty-face 'face-alias 'gnus-group-news-low-empty)
+(put 'gnus-group-news-low-empty-face 'obsolete-face "22.1")
-(defface gnus-group-mail-1-face
+(defface gnus-group-mail-1
'((((class color)
(background dark))
- (:foreground "aquamarine1" :bold t))
+ (:foreground "#e1ffe1" :bold t))
(((class color)
(background light))
(:foreground "DeepPink3" :bold t))
(t
(:bold t)))
- "Level 1 mailgroup face.")
+ "Level 1 mailgroup face."
+ :group 'gnus-group)
+;; backward-compatibility alias
+(put 'gnus-group-mail-1-face 'face-alias 'gnus-group-mail-1)
+(put 'gnus-group-mail-1-face 'obsolete-face "22.1")
-(defface gnus-group-mail-1-empty-face
+(defface gnus-group-mail-1-empty
'((((class color)
(background dark))
- (:foreground "aquamarine1"))
+ (:foreground "#e1ffe1"))
(((class color)
(background light))
(:foreground "DeepPink3"))
(t
(:italic t :bold t)))
- "Level 1 empty mailgroup face.")
+ "Level 1 empty mailgroup face."
+ :group 'gnus-group)
+;; backward-compatibility alias
+(put 'gnus-group-mail-1-empty-face 'face-alias 'gnus-group-mail-1-empty)
+(put 'gnus-group-mail-1-empty-face 'obsolete-face "22.1")
-(defface gnus-group-mail-2-face
+(defface gnus-group-mail-2
'((((class color)
(background dark))
- (:foreground "aquamarine2" :bold t))
+ (:foreground "DarkSeaGreen1" :bold t))
(((class color)
(background light))
(:foreground "HotPink3" :bold t))
(t
(:bold t)))
- "Level 2 mailgroup face.")
+ "Level 2 mailgroup face."
+ :group 'gnus-group)
+;; backward-compatibility alias
+(put 'gnus-group-mail-2-face 'face-alias 'gnus-group-mail-2)
+(put 'gnus-group-mail-2-face 'obsolete-face "22.1")
-(defface gnus-group-mail-2-empty-face
+(defface gnus-group-mail-2-empty
'((((class color)
(background dark))
- (:foreground "aquamarine2"))
+ (:foreground "DarkSeaGreen1"))
(((class color)
(background light))
(:foreground "HotPink3"))
(t
(:bold t)))
- "Level 2 empty mailgroup face.")
+ "Level 2 empty mailgroup face."
+ :group 'gnus-group)
+;; backward-compatibility alias
+(put 'gnus-group-mail-2-empty-face 'face-alias 'gnus-group-mail-2-empty)
+(put 'gnus-group-mail-2-empty-face 'obsolete-face "22.1")
-(defface gnus-group-mail-3-face
+(defface gnus-group-mail-3
'((((class color)
(background dark))
- (:foreground "aquamarine3" :bold t))
+ (:foreground "aquamarine1" :bold t))
(((class color)
(background light))
(:foreground "magenta4" :bold t))
(t
(:bold t)))
- "Level 3 mailgroup face.")
+ "Level 3 mailgroup face."
+ :group 'gnus-group)
+;; backward-compatibility alias
+(put 'gnus-group-mail-3-face 'face-alias 'gnus-group-mail-3)
+(put 'gnus-group-mail-3-face 'obsolete-face "22.1")
-(defface gnus-group-mail-3-empty-face
+(defface gnus-group-mail-3-empty
'((((class color)
(background dark))
- (:foreground "aquamarine3"))
+ (:foreground "aquamarine1"))
(((class color)
(background light))
(:foreground "magenta4"))
(t
()))
- "Level 3 empty mailgroup face.")
+ "Level 3 empty mailgroup face."
+ :group 'gnus-group)
+;; backward-compatibility alias
+(put 'gnus-group-mail-3-empty-face 'face-alias 'gnus-group-mail-3-empty)
+(put 'gnus-group-mail-3-empty-face 'obsolete-face "22.1")
-(defface gnus-group-mail-low-face
+(defface gnus-group-mail-low
'((((class color)
(background dark))
- (:foreground "aquamarine4" :bold t))
+ (:foreground "aquamarine2" :bold t))
(((class color)
(background light))
(:foreground "DeepPink4" :bold t))
(t
(:bold t)))
- "Low level mailgroup face.")
+ "Low level mailgroup face."
+ :group 'gnus-group)
+;; backward-compatibility alias
+(put 'gnus-group-mail-low-face 'face-alias 'gnus-group-mail-low)
+(put 'gnus-group-mail-low-face 'obsolete-face "22.1")
-(defface gnus-group-mail-low-empty-face
+(defface gnus-group-mail-low-empty
'((((class color)
(background dark))
- (:foreground "aquamarine4"))
+ (:foreground "aquamarine2"))
(((class color)
(background light))
(:foreground "DeepPink4"))
(t
(:bold t)))
- "Low level empty mailgroup face.")
+ "Low level empty mailgroup face."
+ :group 'gnus-group)
+;; backward-compatibility alias
+(put 'gnus-group-mail-low-empty-face 'face-alias 'gnus-group-mail-low-empty)
+(put 'gnus-group-mail-low-empty-face 'obsolete-face "22.1")
;; Summary mode faces.
-(defface gnus-summary-selected-face '((t
- (:underline t)))
- "Face used for selected articles.")
+(defface gnus-summary-selected '((t (:underline t)))
+ "Face used for selected articles."
+ :group 'gnus-summary)
+;; backward-compatibility alias
+(put 'gnus-summary-selected-face 'face-alias 'gnus-summary-selected)
+(put 'gnus-summary-selected-face 'obsolete-face "22.1")
-(defface gnus-summary-cancelled-face
+(defface gnus-summary-cancelled
'((((class color))
(:foreground "yellow" :background "black")))
- "Face used for cancelled articles.")
+ "Face used for cancelled articles."
+ :group 'gnus-summary)
+;; backward-compatibility alias
+(put 'gnus-summary-cancelled-face 'face-alias 'gnus-summary-cancelled)
+(put 'gnus-summary-cancelled-face 'obsolete-face "22.1")
-(defface gnus-summary-high-ticked-face
+(defface gnus-summary-high-ticked
'((((class color)
(background dark))
(:foreground "pink" :bold t))
(:foreground "firebrick" :bold t))
(t
(:bold t)))
- "Face used for high interest ticked articles.")
+ "Face used for high interest ticked articles."
+ :group 'gnus-summary)
+;; backward-compatibility alias
+(put 'gnus-summary-high-ticked-face 'face-alias 'gnus-summary-high-ticked)
+(put 'gnus-summary-high-ticked-face 'obsolete-face "22.1")
-(defface gnus-summary-low-ticked-face
+(defface gnus-summary-low-ticked
'((((class color)
(background dark))
(:foreground "pink" :italic t))
(:foreground "firebrick" :italic t))
(t
(:italic t)))
- "Face used for low interest ticked articles.")
+ "Face used for low interest ticked articles."
+ :group 'gnus-summary)
+;; backward-compatibility alias
+(put 'gnus-summary-low-ticked-face 'face-alias 'gnus-summary-low-ticked)
+(put 'gnus-summary-low-ticked-face 'obsolete-face "22.1")
-(defface gnus-summary-normal-ticked-face
+(defface gnus-summary-normal-ticked
'((((class color)
(background dark))
(:foreground "pink"))
(:foreground "firebrick"))
(t
()))
- "Face used for normal interest ticked articles.")
+ "Face used for normal interest ticked articles."
+ :group 'gnus-summary)
+;; backward-compatibility alias
+(put 'gnus-summary-normal-ticked-face 'face-alias 'gnus-summary-normal-ticked)
+(put 'gnus-summary-normal-ticked-face 'obsolete-face "22.1")
-(defface gnus-summary-high-ancient-face
+(defface gnus-summary-high-ancient
'((((class color)
(background dark))
(:foreground "SkyBlue" :bold t))
(:foreground "RoyalBlue" :bold t))
(t
(:bold t)))
- "Face used for high interest ancient articles.")
+ "Face used for high interest ancient articles."
+ :group 'gnus-summary)
+;; backward-compatibility alias
+(put 'gnus-summary-high-ancient-face 'face-alias 'gnus-summary-high-ancient)
+(put 'gnus-summary-high-ancient-face 'obsolete-face "22.1")
-(defface gnus-summary-low-ancient-face
+(defface gnus-summary-low-ancient
'((((class color)
(background dark))
(:foreground "SkyBlue" :italic t))
(:foreground "RoyalBlue" :italic t))
(t
(:italic t)))
- "Face used for low interest ancient articles.")
+ "Face used for low interest ancient articles."
+ :group 'gnus-summary)
+;; backward-compatibility alias
+(put 'gnus-summary-low-ancient-face 'face-alias 'gnus-summary-low-ancient)
+(put 'gnus-summary-low-ancient-face 'obsolete-face "22.1")
-(defface gnus-summary-normal-ancient-face
+(defface gnus-summary-normal-ancient
'((((class color)
(background dark))
(:foreground "SkyBlue"))
(:foreground "RoyalBlue"))
(t
()))
- "Face used for normal interest ancient articles.")
+ "Face used for normal interest ancient articles."
+ :group 'gnus-summary)
+;; backward-compatibility alias
+(put 'gnus-summary-normal-ancient-face 'face-alias 'gnus-summary-normal-ancient)
+(put 'gnus-summary-normal-ancient-face 'obsolete-face "22.1")
-(defface gnus-summary-high-undownloaded-face
+(defface gnus-summary-high-undownloaded
'((((class color)
(background light))
(:bold t :foreground "cyan4"))
(((class color) (background dark))
(:bold t :foreground "LightGray"))
(t (:inverse-video t :bold t)))
- "Face used for high interest uncached articles.")
+ "Face used for high interest uncached articles."
+ :group 'gnus-summary)
+;; backward-compatibility alias
+(put 'gnus-summary-high-undownloaded-face 'face-alias 'gnus-summary-high-undownloaded)
+(put 'gnus-summary-high-undownloaded-face 'obsolete-face "22.1")
-(defface gnus-summary-low-undownloaded-face
+(defface gnus-summary-low-undownloaded
'((((class color)
(background light))
(:italic t :foreground "cyan4" :bold nil))
(((class color) (background dark))
(:italic t :foreground "LightGray" :bold nil))
(t (:inverse-video t :italic t)))
- "Face used for low interest uncached articles.")
+ "Face used for low interest uncached articles."
+ :group 'gnus-summary)
+;; backward-compatibility alias
+(put 'gnus-summary-low-undownloaded-face 'face-alias 'gnus-summary-low-undownloaded)
+(put 'gnus-summary-low-undownloaded-face 'obsolete-face "22.1")
-(defface gnus-summary-normal-undownloaded-face
+(defface gnus-summary-normal-undownloaded
'((((class color)
(background light))
(:foreground "cyan4" :bold nil))
(((class color) (background dark))
(:foreground "LightGray" :bold nil))
(t (:inverse-video t)))
- "Face used for normal interest uncached articles.")
+ "Face used for normal interest uncached articles."
+ :group 'gnus-summary)
+;; backward-compatibility alias
+(put 'gnus-summary-normal-undownloaded-face 'face-alias 'gnus-summary-normal-undownloaded)
+(put 'gnus-summary-normal-undownloaded-face 'obsolete-face "22.1")
-(defface gnus-summary-high-unread-face
+(defface gnus-summary-high-unread
'((t
(:bold t)))
- "Face used for high interest unread articles.")
+ "Face used for high interest unread articles."
+ :group 'gnus-summary)
+;; backward-compatibility alias
+(put 'gnus-summary-high-unread-face 'face-alias 'gnus-summary-high-unread)
+(put 'gnus-summary-high-unread-face 'obsolete-face "22.1")
-(defface gnus-summary-low-unread-face
+(defface gnus-summary-low-unread
'((t
(:italic t)))
- "Face used for low interest unread articles.")
+ "Face used for low interest unread articles."
+ :group 'gnus-summary)
+;; backward-compatibility alias
+(put 'gnus-summary-low-unread-face 'face-alias 'gnus-summary-low-unread)
+(put 'gnus-summary-low-unread-face 'obsolete-face "22.1")
-(defface gnus-summary-normal-unread-face
+(defface gnus-summary-normal-unread
'((t
()))
- "Face used for normal interest unread articles.")
+ "Face used for normal interest unread articles."
+ :group 'gnus-summary)
+;; backward-compatibility alias
+(put 'gnus-summary-normal-unread-face 'face-alias 'gnus-summary-normal-unread)
+(put 'gnus-summary-normal-unread-face 'obsolete-face "22.1")
-(defface gnus-summary-high-read-face
+(defface gnus-summary-high-read
'((((class color)
(background dark))
(:foreground "PaleGreen"
:bold t))
(t
(:bold t)))
- "Face used for high interest read articles.")
+ "Face used for high interest read articles."
+ :group 'gnus-summary)
+;; backward-compatibility alias
+(put 'gnus-summary-high-read-face 'face-alias 'gnus-summary-high-read)
+(put 'gnus-summary-high-read-face 'obsolete-face "22.1")
-(defface gnus-summary-low-read-face
+(defface gnus-summary-low-read
'((((class color)
(background dark))
(:foreground "PaleGreen"
:italic t))
(t
(:italic t)))
- "Face used for low interest read articles.")
+ "Face used for low interest read articles."
+ :group 'gnus-summary)
+;; backward-compatibility alias
+(put 'gnus-summary-low-read-face 'face-alias 'gnus-summary-low-read)
+(put 'gnus-summary-low-read-face 'obsolete-face "22.1")
-(defface gnus-summary-normal-read-face
+(defface gnus-summary-normal-read
'((((class color)
(background dark))
(:foreground "PaleGreen"))
(:foreground "DarkGreen"))
(t
()))
- "Face used for normal interest read articles.")
+ "Face used for normal interest read articles."
+ :group 'gnus-summary)
+;; backward-compatibility alias
+(put 'gnus-summary-normal-read-face 'face-alias 'gnus-summary-normal-read)
+(put 'gnus-summary-normal-read-face 'obsolete-face "22.1")
;;;
(defvar gnus-group-buffer "*Group*")
-(eval-and-compile
- (autoload 'gnus-play-jingle "gnus-audio"))
-
-(defface gnus-splash-face
+(defface gnus-splash
'((((class color)
(background dark))
- (:foreground "#888888"))
+ (:foreground "#cccccc"))
(((class color)
(background light))
(:foreground "#888888"))
(t
()))
- "Face for the splash screen.")
+ "Face for the splash screen."
+ :group 'gnus-start)
+;; backward-compatibility alias
+(put 'gnus-splash-face 'face-alias 'gnus-splash)
+(put 'gnus-splash-face 'obsolete-face "22.1")
(defun gnus-splash ()
(save-excursion
(erase-buffer)
(unless gnus-inhibit-startup-message
(gnus-group-startup-message)
- (sit-for 0)
- (when gnus-play-startup-jingle
- (gnus-play-jingle))))))
+ (sit-for 0)))))
(defun gnus-indent-rigidly (start end arg)
"Indent rigidly using only spaces and no tabs."
(storm "#666699" "#99ccff")
(pdino "#9999cc" "#99ccff")
(purp "#9999cc" "#666699")
- (no "#000000" "#ff0000")
+ (no "#ff0000" "#ffff00")
(neutral "#b4b4b4" "#878787")
(september "#bf9900" "#ffcc00"))
"Color alist used for the Gnus logo.")
-(defcustom gnus-logo-color-style 'oort
+(defcustom gnus-logo-color-style 'no
"*Color styles used for the Gnus logo."
:type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem)))
gnus-logo-color-alist))
(cdr (assq gnus-logo-color-style gnus-logo-color-alist))
"Colors used for the Gnus logo.")
+(declare-function image-size "image.c" (spec &optional pixels frame))
+
(defun gnus-group-startup-message (&optional x y)
"Insert startup message in current buffer."
;; Insert the message.
((and
(fboundp 'find-image)
(display-graphic-p)
- (let* ((data-directory (nnheader-find-etc-directory "gnus"))
+ ;; Make sure the library defining `image-load-path' is loaded
+ ;; (`find-image' is autoloaded) (and discard the result). Else, we may
+ ;; get "defvar ignored because image-load-path is let-bound" when calling
+ ;; `find-image' below.
+ (or (find-image '(nil (:type xpm :file "gnus.xpm"))) t)
+ (let* ((data-directory (nnheader-find-etc-directory "images/gnus"))
+ (image-load-path (cond (data-directory
+ (list data-directory))
+ ((boundp 'image-load-path)
+ (symbol-value 'image-load-path))
+ (t load-path)))
(image (find-image
`((:type xpm :file "gnus.xpm"
:color-symbols
("shadow" . ,(cadr gnus-logo-colors))
("oort" . "#eeeeee")
("background" . ,(face-background 'default))))
+ (:type svg :file "gnus.svg")
+ (:type png :file "gnus.png")
(:type pbm :file "gnus.pbm"
;; Account for the pbm's blackground.
- :background ,(face-foreground 'gnus-splash-face)
+ :background ,(face-foreground 'gnus-splash)
:foreground ,(face-background 'default))
(:type xbm :file "gnus.xbm"
;; Account for the xbm's blackground.
- :background ,(face-foreground 'gnus-splash-face)
+ :background ,(face-foreground 'gnus-splash)
:foreground ,(face-background 'default))))))
(when image
(let ((size (image-size image)))
(t
(insert
(format " %s
- _ ___ _ _
- _ ___ __ ___ __ _ ___
- __ _ ___ __ ___
- _ ___ _
- _ _ __ _
- ___ __ _
- __ _
- _ _ _
- _ _ _
- _ _ _
- __ ___
- _ _ _ _
- _ _
- _ _
- _ _
- _
- __
+ _ ___ _ _
+ _ ___ __ ___ __ _ ___
+ __ _ ___ __ ___
+ _ ___ _
+ _ _ __ _
+ ___ __ _
+ __ _
+ _ _ _
+ _ _ _
+ _ _ _
+ __ ___
+ _ _ _ _
+ _ _
+ _ _
+ _ _
+ _
+ __
"
""))
(rest (- wheight pheight)))
(insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
;; Fontify some.
- (put-text-property (point-min) (point-max) 'face 'gnus-splash-face)
+ (put-text-property (point-min) (point-max) 'face 'gnus-splash)
(setq gnus-simple-splash t)))
(goto-char (point-min))
(setq mode-line-buffer-identification (concat " " gnus-version))
(eval-when (load)
(let ((command (format "%s" this-command)))
- (if (and (string-match "gnus" command)
- (not (string-match "gnus-other-frame" command)))
- (gnus-splash)
- (gnus-get-buffer-create gnus-group-buffer))))
+ (when (string-match "gnus" command)
+ (if (string-match "gnus-other-frame" command)
+ (gnus-get-buffer-create gnus-group-buffer)
+ (gnus-splash)))))
;;; Do the rest.
(\"mail\\\\.me\" (gnus-use-scoring t))
(\"list\\\\..*\" (total-expire . t)
(broken-reply-to . t)))"
+ :version "22.1"
:group 'gnus-group-various
:type '(repeat (cons regexp
(repeat sexp))))
+(defcustom gnus-parameters-case-fold-search 'default
+ "If it is t, ignore case of group names specified in `gnus-parameters'.
+If it is nil, don't ignore case. If it is `default', which is for the
+backward compatibility, use the value of `case-fold-search'."
+ :version "22.1"
+ :group 'gnus-group-various
+ :type '(choice :format "%{%t%}:\n %[Value Menu%] %v"
+ (const :tag "Use `case-fold-search'" default)
+ (const nil)
+ (const t)))
+
(defvar gnus-group-parameters-more nil)
(defmacro gnus-define-group-parameter (param &rest rest)
(and (file-readable-p gnus-nntpserver-file)
(with-temp-buffer
(insert-file-contents gnus-nntpserver-file)
- (let ((name (buffer-string)))
- (unless (string-match "\\`[ \t\n]*$" name)
- name))))))
+ (when (re-search-forward "[^ \t\n\r]+" nil t)
+ (match-string 0))))))
+
+;; `M-x customize-variable RET gnus-select-method RET' should work without
+;; starting or even loading Gnus.
+;;;###autoload(when (fboundp 'custom-autoload)
+;;;###autoload (custom-autoload 'gnus-select-method "gnus"))
(defcustom gnus-select-method
(condition-case nil
There is a lot more to know about select methods and virtual servers -
see the manual for details."
:group 'gnus-server
+ :group 'gnus-start
+ :initialize 'custom-initialize-default
:type 'gnus-select-method)
(defcustom gnus-message-archive-method "archive"
"*Method used for archiving messages you've sent.
-This should be a mail method."
+This should be a mail method.
+
+See also `gnus-update-message-archive-method'."
:group 'gnus-server
:group 'gnus-message
:type '(choice (const :tag "Default archive method" "archive")
gnus-select-method))
-(defcustom gnus-message-archive-group nil
+(defcustom gnus-update-message-archive-method nil
+ "Non-nil means always update the saved \"archive\" method.
+
+The archive method is initially set according to the value of
+`gnus-message-archive-method' and is saved in the \"~/.newsrc.eld\" file
+so that it may be used as a real method of the server which is named
+\"archive\" ever since. If it once has been saved, it will never be
+updated if the value of this variable is nil, even if you change the
+value of `gnus-message-archive-method' afterward. If you want the
+saved \"archive\" method to be updated whenever you change the value of
+`gnus-message-archive-method', set this variable to a non-nil value."
+ :version "24.1"
+ :group 'gnus-server
+ :group 'gnus-message
+ :type 'boolean)
+
+(defcustom gnus-message-archive-group '((format-time-string "sent.%Y-%m"))
"*Name of the group in which to save the messages you've written.
This can either be a string; a list of strings; or an alist
of regexps/functions/forms to be evaluated to return a string (or a list
\"nnml+private:mail.misc\", for instance."
:group 'gnus-message
:type '(choice (const :tag "none" nil)
+ (const :tag "Weekly" ((format-time-string "sent.%Yw%U")))
+ (const :tag "Monthly" ((format-time-string "sent.%Y-%m")))
+ (const :tag "Yearly" ((format-time-string "sent.%Y")))
function
sexp
string))
(defcustom gnus-nntp-server nil
"*The name of the host running the NNTP server.
-This variable is semi-obsolete. Use the `gnus-select-method'
+This variable is semi-obsolete. Use the `gnus-select-method'
variable instead."
:group 'gnus-server
:type '(choice (const :tag "disable" nil)
:group 'gnus-message
:type '(choice (const :tag "default" nil)
string))
+(make-obsolete-variable 'gnus-local-domain nil "Emacs 24.1")
(defvar gnus-local-organization nil
"String with a description of what organization (if any) the user belongs to.
;; Customization variables
-(defcustom gnus-refer-article-method nil
+(defcustom gnus-refer-article-method 'current
"Preferred method for fetching an article by Message-ID.
If you are reading news from the local spool (with nnspool), fetching
articles by Message-ID is painfully slow. By setting this method to an
It can also be a list of select methods, as well as the special symbol
`current', which means to use the current select method. If it is a
list, Gnus will try all the methods in the list until it finds a match."
+ :version "24.1"
:group 'gnus-server
:type '(choice (const :tag "default" nil)
(const current)
(nnweb "refer" (nnweb-type google)))
gnus-select-method))))
-(defcustom gnus-group-faq-directory
- '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/"
- "/ftp@sunsite.doc.ic.ac.uk:/pub/usenet/news-faqs/"
- "/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/"
- "/ftp@ftp.seas.gwu.edu:/pub/rtfm/"
- "/ftp@ftp.pasteur.fr:/pub/FAQ/"
- "/ftp@rtfm.mit.edu:/pub/usenet/"
- "/ftp@ftp.uni-paderborn.de:/pub/FAQ/"
- "/ftp@ftp.sunet.se:/pub/usenet/"
- "/ftp@nctuccca.nctu.edu.tw:/pub/Documents/rtfm/usenet-by-group/"
- "/ftp@hwarang.postech.ac.kr:/pub/usenet/"
- "/ftp@ftp.hk.super.net:/mirror/faqs/")
- "*Directory where the group FAQs are stored.
-This will most commonly be on a remote machine, and the file will be
-fetched by ange-ftp.
-
-This variable can also be a list of directories. In that case, the
-first element in the list will be used by default. The others can
-be used when being prompted for a site.
-
-Note that Gnus uses an aol machine as the default directory. If this
-feels fundamentally unclean, just think of it as a way to finally get
-something of value back from them.
-
-If the default site is too slow, try one of these:
-
- North America: mirrors.aol.com /pub/rtfm/usenet
- ftp.seas.gwu.edu /pub/rtfm
- rtfm.mit.edu /pub/usenet
- Europe: ftp.uni-paderborn.de /pub/FAQ
- src.doc.ic.ac.uk /usenet/news-FAQS
- ftp.sunet.se /pub/usenet
- ftp.pasteur.fr /pub/FAQ
- Asia: nctuccca.nctu.edu.tw /pub/Documents/rtfm/usenet-by-group/
- hwarang.postech.ac.kr /pub/usenet
- ftp.hk.super.net /mirror/faqs"
- :group 'gnus-group-various
- :type '(choice directory
- (repeat directory)))
-
-(defcustom gnus-group-charter-alist
- '(("no" . (concat "http://no.news-admin.org/charter/" name ".txt"))
- ("de" . (concat "http://purl.net/charta/" name ".html"))
- ("dk" . (concat "http://www.usenet.dk/grupper.pl?get=" name))
- ("england" . (concat "http://england.news-admin.org/charters/" name))
- ("fr" . (concat "http://www.usenet-fr.net/fur/chartes/" name ".html"))
- ("europa" . (concat "http://www.europa.usenet.eu.org/chartas/charta-en-"
- (gnus-replace-in-string name "europa\\." "") ".html"))
- ("nl" . (concat "http://www.xs4all.nl/~sister/usenet/charters/" name))
- ("aus" . (concat "http://aus.news-admin.org/groupinfo.cgi/" name))
- ("pl" . (concat "http://www.usenet.pl/opisy/" name))
- ("ch" . (concat "http://www.use-net.ch/Usenet/charter.html#" name))
- ("at" . (concat "http://www.usenet.at/chartas/" name "/charta"))
- ("uk" . (concat "http://www.usenet.org.uk/" name ".html"))
- ("dfw" . (concat "http://www.cirr.com/dfw/charters/" name ".html"))
- ("se" . (concat "http://www.usenet-se.net/Reglementen/"
- (gnus-replace-in-string name "\\." "_") ".html"))
- ("milw" . (concat "http://usenet.mil.wi.us/"
- (gnus-replace-in-string name "milw\\." "") "-charter"))
- ("ca" . (concat "http://www.sbay.org/ca/charter-" name ".html"))
- ("netins" . (concat "http://www.netins.net/usenet/charter/"
- (gnus-replace-in-string name "\\." "-") "-charter.html")))
- "*An alist of (HIERARCHY . FORM) pairs used to construct the URL of a charter.
-When FORM is evaluated `name' is bound to the name of the group."
- :group 'gnus-group-various
- :type '(repeat (cons (string :tag "Hierarchy") (sexp :tag "Form"))))
-
(defcustom gnus-group-fetch-control-use-browse-url nil
"*Non-nil means that control messages are displayed using `browse-url'.
Otherwise they are fetched with ange-ftp and displayed in an ephemeral
group."
+ :version "22.1"
:group 'gnus-group-various
:type 'boolean)
(defcustom gnus-use-cross-reference t
"*Non-nil means that cross referenced articles will be marked as read.
If nil, ignore cross references. If t, mark articles as read in
-subscribed newsgroups. If neither t nor nil, mark as read in all
+subscribed newsgroups. If neither t nor nil, mark as read in all
newsgroups."
:group 'gnus-server
:type '(choice (const :tag "off" nil)
"*The number of articles which indicates a large newsgroup.
If the number of articles in a newsgroup is greater than this value,
confirmation is required for selecting the newsgroup.
-If it is nil, no confirmation is required."
+If it is nil, no confirmation is required.
+
+Also see `gnus-large-ephemeral-newsgroup'."
:group 'gnus-group-select
:type '(choice (const :tag "No limit" nil)
integer))
-(defcustom gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix)))
+(defcustom gnus-use-long-file-name (not (memq system-type '(usg-unix-v)))
"*Non-nil means that the default name of a file to save articles in is the group name.
If it's nil, the directory form of the group name is used instead.
:group 'gnus-meta
:type 'boolean)
-(defcustom gnus-use-grouplens nil
- "*If non-nil, use GroupLens ratings."
- :group 'gnus-meta
- :type 'boolean)
-
(defcustom gnus-keep-backlog 20
"*If non-nil, Gnus will keep read articles for later re-retrieval.
If it is a number N, then Gnus will only keep the last N articles
(sexp :format "all"
:value t)))
-(defcustom gnus-use-nocem nil
- "*If non-nil, Gnus will read NoCeM cancel messages."
- :group 'gnus-meta
- :type 'boolean)
-
(defcustom gnus-suppress-duplicates nil
"*If non-nil, Gnus will mark duplicate copies of the same article as read."
:group 'gnus-meta
(function-item mail-extract-address-components)
(function :tag "Other")))
-(defcustom gnus-carpal nil
- "*If non-nil, display clickable icons."
- :group 'gnus-meta
- :type 'boolean)
-
(defcustom gnus-shell-command-separator ";"
"String used to separate shell commands."
:group 'gnus-files
("nneething" none address prompt-address physical-address)
("nndoc" none address prompt-address)
("nnbabyl" mail address respool)
- ("nnkiboze" post virtual)
- ("nnsoup" post-mail address)
("nndraft" post-mail)
("nnfolder" mail respool address)
("nngateway" post-mail address prompt-address physical-address)
("nnweb" none)
- ("nngoogle" post)
- ("nnslashdot" post)
- ("nnultimate" none)
("nnrss" none)
- ("nnwfm" none)
- ("nnwarchive" none)
- ("nnlistserv" none)
("nnagent" post-mail)
("nnimap" post-mail address prompt-address physical-address)
("nnmaildir" mail respool address)
this method (i. e., `post', `mail', `none' or whatever) or other
properties that this method has (like being respoolable).
If you implement a new select method, all you should have to change is
-this variable. I think."
+this variable. I think."
:group 'gnus-server
:type '(repeat (group (string :tag "Name")
(radio-button-choice (const :format "%v " post)
(const :format "%v " prompt-address)
(const :format "%v " physical-address)
(const :format "%v " virtual)
- (const respool)))))
+ (const respool))))
+ :version "24.1")
(defun gnus-redefine-select-method-widget ()
"Recomputes the select-method widget based on the value of
(const summary)
(const tree)))
-;; Added by Keinonen Kari <kk85613@cs.tut.fi>.
-(defcustom gnus-mode-non-string-length nil
+(defcustom gnus-mode-non-string-length 30
"*Max length of mode-line non-string contents.
If this is nil, Gnus will take space as is needed, leaving the rest
-of the mode line intact. Note that the default of nil is unlikely
-to be desirable; see the manual for further details."
+of the mode line intact."
+ :version "24.1"
:group 'gnus-various
:type '(choice (const nil)
integer))
"Return GROUP's to-address."
:variable-document
"*Alist of group regexps and correspondent to-addresses."
+ :variable-group gnus-group-parameter
:parameter-type '(gnus-email-address :tag "To Address")
:parameter-document "\
This will be used when doing followups and posts.
"Return GROUP's to-list."
:variable-document
"*Alist of group regexps and correspondent to-lists."
+ :variable-group gnus-group-parameter
:parameter-type '(gnus-email-address :tag "To List")
:parameter-document "\
This address will be used when doing a `a' in the group.
"Return GROUP's subscription status."
:variable-document
"*Groups which are automatically considered subscribed."
+ :variable-group gnus-group-parameter
:parameter-type '(const :tag "Subscribed" t)
:parameter-document "\
Gnus assumed that you are subscribed to the To/List address.
"*Groups in which to perform expiry of all read articles.
Use with extreme caution. All groups that match this regexp will be
expiring - which means that all read articles will be deleted after
-\(say) one week. (This only goes for mail groups and the like, of
+\(say) one week. (This only goes for mail groups and the like, of
course.)"
:variable-group nnmail-expire
:variable-type '(choice (const nil)
"Return GROUP's initial input of the number of articles."
:variable-document
"*Alist of group regexps and its initial input of the number of articles."
+ :variable-group gnus-group-parameter
:parameter-type '(choice :tag "Initial Input for Large Newsgroup"
(const :tag "All" nil)
(integer))
(list
(regexp :tag "Group Name Regular Expression")
(boolean :tag "Ignored")))
-
+
:parameter-type '(boolean :tag "Group Ignored by the Registry")
:parameter-document
"Whether the Gnus Registry should ignore this group.")
(defcustom gnus-install-group-spam-parameters t
"*Disable the group parameters for spam detection.
Enable if `G c' in XEmacs is giving you trouble, and make sure to submit a bug report."
+ :version "22.1"
:type 'boolean
:group 'gnus-start)
:variable gnus-spam-newsgroup-contents
:variable-default nil
:variable-document
- "*Groups in which to automatically mark new articles as spam on
-summary entry. If non-nil, this should be a list of group name
-regexps that should match all groups in which to do automatic spam
-tagging, associated with a classification (spam, ham, or neither).
-This only makes sense for mail groups."
+ "*Group classification (spam, ham, or neither). Only
+meaningful when spam.el is loaded. If non-nil, this should be a
+list of group name regexps associated with a classification for
+each one. In spam groups, new articles are marked as spam on
+summary entry. There is other behavior associated with ham and
+no classification when spam.el is loaded - see the manual."
:variable-group spam
:variable-type '(repeat
(list :tag "Group contents spam/ham classification"
(const :tag "Unclassified" nil)))
:parameter-document
"The spam classification (spam, ham, or neither) of this group.
-When a spam group is entered, all unread articles are marked as spam.")
+When a spam group is entered, all unread articles are marked as
+spam. There is other behavior associated with ham and no
+classification when spam.el is loaded - see the manual.")
+
+ (gnus-define-group-parameter
+ spam-resend-to
+ :type list
+ :function-document
+ "The address to get spam resent (through spam-report-resend)."
+ :variable gnus-spam-resend-to
+ :variable-default nil
+ :variable-document
+ "The address to get spam resent (through spam-report-resend)."
+ :variable-group spam
+ :variable-type '(repeat
+ (list :tag "Group address for resending spam"
+ (regexp :tag "Group")
+ (string :tag "E-mail address for resending spam (requires the spam-use-resend exit processor)")))
+ :parameter-type 'string :tag "E-mail address for resending spam (requires the spam-use-resend exit processor)"
+ :parameter-document
+ "The address to get spam resent (through spam-report-resend).")
+
+ (gnus-define-group-parameter
+ ham-resend-to
+ :type list
+ :function-document
+ "The address to get ham resent (through spam-report-resend)."
+ :variable gnus-ham-resend-to
+ :variable-default nil
+ :variable-document
+ "The address to get ham resent (through spam-report-resend)."
+ :variable-group spam
+ :variable-type '(repeat
+ (list :tag "Group address for resending ham"
+ (regexp :tag "Group")
+ (string :tag "E-mail address for resending ham (requires the spam-use-resend exit processor)")))
+ :parameter-type 'string :tag "E-mail address for resending ham (requires the spam-use-resend exit processor)"
+ :parameter-document
+ "The address to get ham resent (through spam-report-resend).")
(defvar gnus-group-spam-exit-processor-ifile "ifile"
- "The ifile summary exit spam processor.")
+ "OBSOLETE: The ifile summary exit spam processor.")
(defvar gnus-group-spam-exit-processor-stat "stat"
- "The spam-stat summary exit spam processor.")
+ "OBSOLETE: The spam-stat summary exit spam processor.")
(defvar gnus-group-spam-exit-processor-bogofilter "bogofilter"
- "The Bogofilter summary exit spam processor.")
+ "OBSOLETE: The Bogofilter summary exit spam processor.")
(defvar gnus-group-spam-exit-processor-blacklist "blacklist"
- "The Blacklist summary exit spam processor.")
+ "OBSOLETE: The Blacklist summary exit spam processor.")
(defvar gnus-group-spam-exit-processor-report-gmane "report-gmane"
- "The Gmane reporting summary exit spam processor.
+ "OBSOLETE: The Gmane reporting summary exit spam processor.
Only applicable to NNTP groups with articles from Gmane. See spam-report.el")
(defvar gnus-group-spam-exit-processor-spamoracle "spamoracle-spam"
- "The spamoracle summary exit spam processor.")
+ "OBSOLETE: The spamoracle summary exit spam processor.")
(defvar gnus-group-ham-exit-processor-ifile "ifile-ham"
- "The ifile summary exit ham processor.
+ "OBSOLETE: The ifile summary exit ham processor.
Only applicable to non-spam (unclassified and ham) groups.")
(defvar gnus-group-ham-exit-processor-bogofilter "bogofilter-ham"
- "The Bogofilter summary exit ham processor.
+ "OBSOLETE: The Bogofilter summary exit ham processor.
Only applicable to non-spam (unclassified and ham) groups.")
(defvar gnus-group-ham-exit-processor-stat "stat-ham"
- "The spam-stat summary exit ham processor.
+ "OBSOLETE: The spam-stat summary exit ham processor.
Only applicable to non-spam (unclassified and ham) groups.")
(defvar gnus-group-ham-exit-processor-whitelist "whitelist"
- "The whitelist summary exit ham processor.
+ "OBSOLETE: The whitelist summary exit ham processor.
Only applicable to non-spam (unclassified and ham) groups.")
(defvar gnus-group-ham-exit-processor-BBDB "bbdb"
- "The BBDB summary exit ham processor.
+ "OBSOLETE: The BBDB summary exit ham processor.
Only applicable to non-spam (unclassified and ham) groups.")
(defvar gnus-group-ham-exit-processor-copy "copy"
- "The ham copy exit ham processor.
+ "OBSOLETE: The ham copy exit ham processor.
Only applicable to non-spam (unclassified and ham) groups.")
(defvar gnus-group-ham-exit-processor-spamoracle "spamoracle-ham"
- "The spamoracle summary exit ham processor.
+ "OBSOLETE: The spamoracle summary exit ham processor.
Only applicable to non-spam (unclassified and ham) groups.")
(gnus-define-group-parameter
spam-process
:type list
- :parameter-type
- '(choice
+ :parameter-type
+ '(choice
:tag "Spam Summary Exit Processor"
:value nil
(list :tag "Spam Summary Exit Processor Choices"
(set
+ (const :tag "Spam: Bogofilter" (spam spam-use-bogofilter))
+ (const :tag "Spam: Blacklist" (spam spam-use-blacklist))
+ (const :tag "Spam: Bsfilter" (spam spam-use-bsfilter))
+ (const :tag "Spam: Gmane Report" (spam spam-use-gmane))
+ (const :tag "Spam: Resend Message"(spam spam-use-resend))
+ (const :tag "Spam: ifile" (spam spam-use-ifile))
+ (const :tag "Spam: Spam Oracle" (spam spam-use-spamoracle))
+ (const :tag "Spam: Spam-stat" (spam spam-use-stat))
+ (const :tag "Spam: SpamAssassin" (spam spam-use-spamassassin))
+ (const :tag "Spam: CRM114" (spam spam-use-crm114))
+ (const :tag "Ham: BBDB" (ham spam-use-BBDB))
+ (const :tag "Ham: Bogofilter" (ham spam-use-bogofilter))
+ (const :tag "Ham: Bsfilter" (ham spam-use-bsfilter))
+ (const :tag "Ham: Copy" (ham spam-use-ham-copy))
+ (const :tag "Ham: Resend Message" (ham spam-use-resend))
+ (const :tag "Ham: ifile" (ham spam-use-ifile))
+ (const :tag "Ham: Spam Oracle" (ham spam-use-spamoracle))
+ (const :tag "Ham: Spam-stat" (ham spam-use-stat))
+ (const :tag "Ham: SpamAssassin" (ham spam-use-spamassassin))
+ (const :tag "Ham: CRM114" (ham spam-use-crm114))
+ (const :tag "Ham: Whitelist" (ham spam-use-whitelist))
(variable-item gnus-group-spam-exit-processor-ifile)
(variable-item gnus-group-spam-exit-processor-stat)
(variable-item gnus-group-spam-exit-processor-bogofilter)
(variable-item gnus-group-spam-exit-processor-blacklist)
- (variable-item gnus-group-spam-exit-processor-report-gmane)
(variable-item gnus-group-spam-exit-processor-spamoracle)
+ (variable-item gnus-group-spam-exit-processor-report-gmane)
(variable-item gnus-group-ham-exit-processor-bogofilter)
(variable-item gnus-group-ham-exit-processor-ifile)
(variable-item gnus-group-ham-exit-processor-stat)
(variable-item gnus-group-ham-exit-processor-whitelist)
(variable-item gnus-group-ham-exit-processor-BBDB)
- (variable-item gnus-group-ham-exit-processor-copy)
- (variable-item gnus-group-ham-exit-processor-spamoracle))))
+ (variable-item gnus-group-ham-exit-processor-spamoracle)
+ (variable-item gnus-group-ham-exit-processor-copy))))
:function-document
"Which spam or ham processors will be applied when the summary is exited."
:variable gnus-spam-process-newsgroups
name regexps that should match all groups in which to do automatic
spam processing, associated with the appropriate processor."
:variable-group spam
- :variable-type
+ :variable-type
'(repeat :tag "Spam/Ham Processors"
(list :tag "Spam Summary Exit Processor Choices"
(regexp :tag "Group Regexp")
- (set
+ (set
:tag "Spam/Ham Summary Exit Processor"
+ (const :tag "Spam: Bogofilter" (spam spam-use-bogofilter))
+ (const :tag "Spam: Blacklist" (spam spam-use-blacklist))
+ (const :tag "Spam: Bsfilter" (spam spam-use-bsfilter))
+ (const :tag "Spam: Gmane Report" (spam spam-use-gmane))
+ (const :tag "Spam: Resend Message"(spam spam-use-resend))
+ (const :tag "Spam: ifile" (spam spam-use-ifile))
+ (const :tag "Spam: Spam-stat" (spam spam-use-stat))
+ (const :tag "Spam: Spam Oracle" (spam spam-use-spamoracle))
+ (const :tag "Spam: SpamAssassin" (spam spam-use-spamassassin))
+ (const :tag "Spam: CRM114" (spam spam-use-crm114))
+ (const :tag "Ham: BBDB" (ham spam-use-BBDB))
+ (const :tag "Ham: Bogofilter" (ham spam-use-bogofilter))
+ (const :tag "Ham: Bsfilter" (ham spam-use-bsfilter))
+ (const :tag "Ham: Copy" (ham spam-use-ham-copy))
+ (const :tag "Ham: Resend Message" (ham spam-use-resend))
+ (const :tag "Ham: ifile" (ham spam-use-ifile))
+ (const :tag "Ham: Spam-stat" (ham spam-use-stat))
+ (const :tag "Ham: Spam Oracle" (ham spam-use-spamoracle))
+ (const :tag "Ham: SpamAssassin" (ham spam-use-spamassassin))
+ (const :tag "Ham: CRM114" (ham spam-use-crm114))
+ (const :tag "Ham: Whitelist" (ham spam-use-whitelist))
(variable-item gnus-group-spam-exit-processor-ifile)
(variable-item gnus-group-spam-exit-processor-stat)
(variable-item gnus-group-spam-exit-processor-bogofilter)
(variable-item gnus-group-ham-exit-processor-BBDB)
(variable-item gnus-group-ham-exit-processor-spamoracle)
(variable-item gnus-group-ham-exit-processor-copy))))
+
:parameter-document
"Which spam or ham processors will be applied when the summary is exited.")
+ (gnus-define-group-parameter
+ spam-autodetect
+ :type list
+ :parameter-type
+ '(boolean :tag "Spam autodetection")
+ :function-document
+ "Should spam be autodetected (with spam-split) in this group?"
+ :variable gnus-spam-autodetect
+ :variable-default nil
+ :variable-document
+ "*Groups in which spam should be autodetected when they are entered.
+ Only unseen articles will be examined, unless
+ spam-autodetect-recheck-messages is set."
+ :variable-group spam
+ :variable-type
+ '(repeat
+ :tag "Autodetection setting"
+ (list
+ (regexp :tag "Group Regexp")
+ boolean))
+ :parameter-document
+ "Spam autodetection.
+Only unseen articles will be examined, unless
+spam-autodetect-recheck-messages is set.")
+
+ (gnus-define-group-parameter
+ spam-autodetect-methods
+ :type list
+ :parameter-type
+ '(choice :tag "Spam autodetection-specific methods"
+ (const none)
+ (const default)
+ (set :tag "Use specific methods"
+ (variable-item spam-use-blacklist)
+ (variable-item spam-use-gmane-xref)
+ (variable-item spam-use-regex-headers)
+ (variable-item spam-use-regex-body)
+ (variable-item spam-use-whitelist)
+ (variable-item spam-use-BBDB)
+ (variable-item spam-use-ifile)
+ (variable-item spam-use-spamoracle)
+ (variable-item spam-use-crm114)
+ (variable-item spam-use-spamassassin)
+ (variable-item spam-use-spamassassin-headers)
+ (variable-item spam-use-bsfilter)
+ (variable-item spam-use-bsfilter-headers)
+ (variable-item spam-use-stat)
+ (variable-item spam-use-blackholes)
+ (variable-item spam-use-hashcash)
+ (variable-item spam-use-bogofilter-headers)
+ (variable-item spam-use-bogofilter)))
+ :function-document
+ "Methods to be used for autodetection in each group"
+ :variable gnus-spam-autodetect-methods
+ :variable-default nil
+ :variable-document
+ "*Methods for autodetecting spam per group.
+Requires the spam-autodetect parameter. Only unseen articles
+will be examined, unless spam-autodetect-recheck-messages is
+set."
+ :variable-group spam
+ :variable-type
+ '(repeat
+ :tag "Autodetection methods"
+ (list
+ (regexp :tag "Group Regexp")
+ (choice
+ (const none)
+ (const default)
+ (set :tag "Use specific methods"
+ (variable-item spam-use-blacklist)
+ (variable-item spam-use-gmane-xref)
+ (variable-item spam-use-regex-headers)
+ (variable-item spam-use-regex-body)
+ (variable-item spam-use-whitelist)
+ (variable-item spam-use-BBDB)
+ (variable-item spam-use-ifile)
+ (variable-item spam-use-spamoracle)
+ (variable-item spam-use-crm114)
+ (variable-item spam-use-stat)
+ (variable-item spam-use-blackholes)
+ (variable-item spam-use-hashcash)
+ (variable-item spam-use-spamassassin)
+ (variable-item spam-use-spamassassin-headers)
+ (variable-item spam-use-bsfilter)
+ (variable-item spam-use-bsfilter-headers)
+ (variable-item spam-use-bogofilter-headers)
+ (variable-item spam-use-bogofilter)))))
+ :parameter-document
+ "Spam autodetection methods.
+Requires the spam-autodetect parameter. Only unseen articles
+will be examined, unless spam-autodetect-recheck-messages is
+set.")
+
(gnus-define-group-parameter
spam-process-destination
:type list
- :parameter-type
+ :parameter-type
'(choice :tag "Destination for spam-processed articles at summary exit"
(string :tag "Move to a group")
(repeat :tag "Move to multiple groups"
group or nil for explicit expiration. This only makes sense for
mail groups."
:variable-group spam
- :variable-type
+ :variable-type
'(repeat
:tag "Spam-processed articles destination"
(list
(const :tag "Expire" nil))))
:parameter-document
"Where spam-processed articles will go at summary exit.")
-
+
(gnus-define-group-parameter
ham-process-destination
:type list
- :parameter-type
+ :parameter-type
'(choice
:tag "Destination for ham articles at summary exit from a spam group"
(string :tag "Move to a group")
group or nil for explicit ignoring. This only makes sense for
mail groups, and only works in spam groups."
:variable-group spam
- :variable-type
+ :variable-type
'(repeat
:tag "Ham articles destination"
(list
"Function run when a group level is changed.
It is called with three parameters -- GROUP, LEVEL and OLDLEVEL."
:group 'gnus-group-levels
- :type 'function)
+ :type '(choice (const nil)
+ function))
;;; Face thingies.
summary-menu group-menu article-menu
tree-highlight menu highlight
browse-menu server-menu
- page-marker tree-menu binary-menu pick-menu
- grouplens-menu)
+ page-marker tree-menu binary-menu pick-menu)
"*Enable visual features.
If `visual' is disabled, there will be no menus and few faces. Most of
the visual customization options below will be ignored. Gnus will use
Valid elements include `summary-highlight', `group-highlight',
`article-highlight', `mouse-face', `summary-menu', `group-menu',
`article-menu', `tree-highlight', `menu', `highlight', `browse-menu',
-`server-menu', `page-marker', `tree-menu', `binary-menu', `pick-menu',
-and `grouplens-menu'."
+`server-menu', `page-marker', `tree-menu', `binary-menu', and`pick-menu'."
:group 'gnus-meta
:group 'gnus-visual
:type '(set (const summary-highlight)
(const page-marker)
(const tree-menu)
(const binary-menu)
- (const pick-menu)
- (const grouplens-menu)))
+ (const pick-menu)))
;; Byte-compiler warning.
(defvar gnus-visual)
When set, Gnus will prefer using the locally stored content rather
than re-fetching it from the server. You also need to enable
`gnus-agent' for this to have any affect."
- :version "21.3"
+ :version "22.1"
:group 'gnus-agent
:type 'boolean)
You may customize gnus-agent to disable its use. However, some
back ends have started to use the agent as a client-side cache.
Disabling the agent may result in noticeable loss of performance."
- :version "21.3"
+ :version "22.1"
:group 'gnus-agent
:type 'boolean)
(symbol :tag "Parameter")
(sexp :tag "Value")))))
+(defcustom gnus-user-agent '(emacs gnus type)
+ "Which information should be exposed in the User-Agent header.
+
+Can be a list of symbols or a string. Valid symbols are `gnus'
+\(show Gnus version\) and `emacs' \(show Emacs version\). In
+addition to the Emacs version, you can add `codename' \(show
+\(S\)XEmacs codename\) or either `config' \(show system
+configuration\) or `type' \(show system type\). If you set it to
+a string, be sure to use a valid format, see RFC 2616."
+
+ :version "22.1"
+ :group 'gnus-message
+ :type '(choice (list (set :inline t
+ (const gnus :tag "Gnus version")
+ (const emacs :tag "Emacs version")
+ (choice :tag "system"
+ (const type :tag "system type")
+ (const config :tag "system configuration"))
+ (const codename :tag "Emacs codename")))
+ (string)))
+
+;; Convert old (< 2005-01-10) symbol type values:
+(when (symbolp gnus-user-agent)
+ (setq gnus-user-agent
+ (cond ((eq gnus-user-agent 'emacs-gnus-config)
+ '(emacs gnus config))
+ ((eq gnus-user-agent 'emacs-gnus-type)
+ '(emacs gnus type))
+ ((eq gnus-user-agent 'emacs-gnus)
+ '(emacs gnus))
+ ((eq gnus-user-agent 'gnus)
+ '(gnus))
+ (t gnus-user-agent)))
+ (gnus-message 1 "Converted `gnus-user-agent' to `%s'." gnus-user-agent)
+ (sit-for 1)
+ (if (get 'gnus-user-agent 'saved-value)
+ (customize-save-variable 'gnus-user-agent gnus-user-agent)
+ (gnus-message 1 "Edit your init file to make this change permanent.")
+ (sit-for 2)))
+
\f
;;; Internal variables
(defvar gnus-agent-gcc-header "X-Gnus-Agent-Gcc")
(defvar gnus-agent-meta-information-header "X-Gnus-Agent-Meta-Information")
+(defvar gnus-agent-method-p-cache nil
+ ; Reset each time gnus-agent-covered-methods is changed else
+ ; gnus-agent-method-p may mis-report a methods status.
+ )
(defvar gnus-agent-target-move-group-header "X-Gnus-Agent-Move-To")
(defvar gnus-draft-meta-information-header "X-Draft-From")
(defvar gnus-group-get-parameter-function 'gnus-group-get-parameter)
(defvar gnus-newsgroup-name nil)
(defvar gnus-ephemeral-servers nil)
(defvar gnus-server-method-cache nil)
+(defvar gnus-extended-servers nil)
+
+;; The carpal mode has been removed, but define the variable for
+;; backwards compatability.
+(defvar gnus-carpal nil)
+(make-obsolete-variable 'gnus-carpal nil "Emacs 24.1")
(defvar gnus-agent-fetching nil
"Whether Gnus agent is in fetching mode.")
-(defvar gnus-agent-covered-methods nil)
+(defvar gnus-agent-covered-methods nil
+ "A list of servers, NOT methods, showing which servers are covered by the agent.")
(defvar gnus-command-method nil
"Dynamically bound variable that says what the current back end is.")
(defvar gnus-tree-buffer "*Tree*"
"Buffer where Gnus thread trees are displayed.")
-;; Dummy variable.
-(defvar gnus-use-generic-from nil)
-
;; Variable holding the user answers to all method prompts.
(defvar gnus-method-history nil)
,(nnheader-concat gnus-cache-directory "active"))))
"List of predefined (convenience) servers.")
-(defvar gnus-topic-indentation "") ;; Obsolete variable.
-
(defconst gnus-article-mark-lists
'((marked . tick) (replied . reply)
(expirable . expire) (killed . killed)
'((seen range)
(killed range)
(bookmark tuple)
+ (uid tuple)
+ (active tuple)
(score tuple)))
;; Propagate flags to server, with the following exceptions:
(defvar gnus-headers-retrieved-by nil)
(defvar gnus-article-reply nil)
(defvar gnus-override-method nil)
-(defvar gnus-article-check-size nil)
(defvar gnus-opened-servers nil)
(defvar gnus-current-kill-article nil)
gnus-newsrc-alist gnus-server-alist
gnus-killed-list gnus-zombie-list
gnus-topic-topology gnus-topic-alist
- gnus-agent-covered-methods gnus-format-specs)
+ gnus-format-specs)
"Gnus variables saved in the quick startup file.")
(defvar gnus-newsrc-alist nil
(defvar gnus-reffed-article-number nil)
-;;; Let the byte-compiler know that we know about this variable.
-(defvar rmail-default-rmail-file)
-
(defvar gnus-dead-summary nil)
(defvar gnus-invalid-group-regexp "[: `'\"/]\\|^$"
;; This little mapcar goes through the list below and marks the
;; symbols in question as autoloaded functions.
- (mapcar
+ (mapc
(lambda (package)
(let ((interactive (nth 1 (memq ':interactive package))))
(mapcar
("babel" babel-as-string)
("nnmail" nnmail-split-fancy nnmail-article-group)
("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers)
- ("rmailout" rmail-output rmail-output-to-rmail-file)
- ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages
- rmail-show-message rmail-summary-exists
- rmail-select-summary rmail-update-summary)
- ("gnus-audio" :interactive t gnus-audio-play)
+ ;; This is only used in message.el, which has an autoload.
+ ("rmailout" rmail-output)
+ ;; Next two used in gnus-util, which has autoloads, and contrib/sendmail.
+ ("rmail" rmail-count-new-messages rmail-show-message
+ ;; Next two only used in gnus-util.
+ rmail-summary-exists rmail-select-summary)
+ ;; Only used in gnus-util, which has an autoload.
+ ("rmailsum" rmail-update-summary)
("gnus-xmas" gnus-xmas-splash)
- ("gnus-soup" :interactive t
- gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article
- gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet)
- ("nnsoup" nnsoup-pack-replies)
("score-mode" :interactive t gnus-score-mode)
("gnus-mh" gnus-summary-save-article-folder
gnus-Folder-save-name gnus-folder-save-name)
("gnus-mh" :interactive t gnus-summary-save-in-folder)
- ("gnus-demon" gnus-demon-add-nocem gnus-demon-add-scanmail
+ ("gnus-demon" gnus-demon-add-scanmail
gnus-demon-add-rescan gnus-demon-add-scan-timestamps
gnus-demon-add-disconnection gnus-demon-add-handler
gnus-demon-remove-handler)
gnus-convert-image-to-gray-x-face gnus-convert-face-to-png
gnus-face-from-file)
("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree
- gnus-tree-open gnus-tree-close gnus-carpal-setup-buffer)
- ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close
- gnus-nocem-unwanted-article-p)
+ gnus-tree-open gnus-tree-close)
("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info
gnus-server-server-name)
("gnus-srvr" gnus-browse-foreign-server)
gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view
gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view
gnus-uu-decode-binhex-view gnus-uu-unmark-thread
- gnus-uu-mark-over gnus-uu-post-news)
+ gnus-uu-mark-over gnus-uu-post-news gnus-uu-invert-processable)
("gnus-uu" gnus-uu-delete-work-dir gnus-uu-unmark-thread)
("gnus-msg" (gnus-summary-send-map keymap)
gnus-article-mail gnus-copy-article-buffer gnus-extended-version)
gnus-summary-post-forward gnus-summary-wide-reply-with-original
gnus-summary-post-forward)
("gnus-picon" :interactive t gnus-treat-from-picon)
- ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p
- gnus-grouplens-mode)
("smiley" :interactive t smiley-region)
("gnus-win" gnus-configure-windows gnus-add-configuration)
("gnus-sum" gnus-summary-insert-line gnus-summary-read-group
gnus-article-hide-pem gnus-article-hide-signature
gnus-article-strip-leading-blank-lines gnus-article-date-local
gnus-article-date-original gnus-article-date-lapsed
-;; gnus-article-show-all-headers
+ ;;gnus-article-show-all-headers
gnus-article-edit-mode gnus-article-edit-article
gnus-article-edit-done gnus-article-decode-encoded-words
gnus-start-date-timer gnus-stop-date-timer
gnus-mime-view-all-parts)
("gnus-int" gnus-request-type)
+ ("gnus-html" gnus-html-show-images)
("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1
- gnus-dribble-enter gnus-read-init-file gnus-dribble-touch)
+ gnus-dribble-enter gnus-read-init-file gnus-dribble-touch
+ gnus-check-reasonable-setup)
("gnus-dup" gnus-dup-suppress-articles gnus-dup-unsuppress-article
gnus-dup-enter-articles)
("gnus-range" gnus-copy-sequence)
("gnus-eform" gnus-edit-form)
- ("gnus-move" :interactive t
- gnus-group-move-group-to-server gnus-change-server)
("gnus-logic" gnus-score-advanced)
("gnus-undo" gnus-undo-mode gnus-undo-register)
("gnus-async" gnus-async-request-fetched-article gnus-async-prefetch-next
gnus-async-prefetch-article gnus-async-prefetch-remove-group
gnus-async-halt-prefetch)
("gnus-agent" gnus-open-agent gnus-agent-get-function
- gnus-agent-save-groups gnus-agent-save-active gnus-agent-method-p
+ gnus-agent-save-active gnus-agent-method-p
gnus-agent-get-undownloaded-list gnus-agent-fetch-session
gnus-summary-set-agent-mark gnus-agent-save-group-info
gnus-agent-request-article gnus-agent-retrieve-headers)
%z Article zcore (character)
%t Number of articles under the current thread (number).
%e Whether the thread is empty or not (character).
-%l GroupLens score (string).
%V Total thread score (number).
%P The line number (number).
%O Download mark (character).
The %U (status), %R (replied) and %z (zcore) specs have to be handled
with care. For reasons of efficiency, Gnus will compute what column
these characters will end up in, and \"hard-code\" that. This means that
-it is invalid to have these specs after a variable-length spec. Well,
+it is invalid to have these specs after a variable-length spec. Well,
you might not be arrested, but your summary buffer will look strange,
which is bad enough.
(defun gnus-shutdown (symbol)
"Shut down everything that waits for SYMBOL."
- (let ((alist gnus-shutdown-alist)
- entry)
- (while (setq entry (pop alist))
- (when (memq symbol (cdr entry))
- (funcall (car entry))))))
+ (dolist (entry gnus-shutdown-alist)
+ (when (memq symbol (cdr entry))
+ (funcall (car entry)))))
\f
;;;
(defmacro gnus-string-or (&rest strings)
"Return the first element of STRINGS that is a non-blank string.
STRINGS will be evaluated in normal `or' order."
- `(gnus-string-or-1 ',strings))
+ `(gnus-string-or-1 (list ,@strings)))
(defun gnus-string-or-1 (strings)
(let (string)
(while strings
- (setq string (eval (pop strings)))
+ (setq string (pop strings))
(if (string-match "^[ \t]*$" string)
(setq string nil)
(setq strings nil)))
(defun gnus-continuum-version (&optional version)
"Return VERSION as a floating point number."
- (interactive)
(unless version
(setq version gnus-version))
(when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version)
(defun gnus-group-read-only-p (&optional group)
"Check whether GROUP supports editing or not.
-If GROUP is nil, `gnus-newsgroup-name' will be checked instead. Note
+If GROUP is nil, `gnus-newsgroup-name' will be checked instead. Note
that that variable is buffer-local to the summary buffers."
(let ((group (or group gnus-newsgroup-name)))
(not (gnus-check-backend-function 'request-replace-article group))))
(defun gnus-news-group-p (group &optional article)
"Return non-nil if GROUP (and ARTICLE) come from a news server."
(cond ((gnus-member-of-valid 'post group) ;Ordinary news group
- t) ;is news of course.
+ t) ;is news of course.
((not (gnus-member-of-valid 'post-mail group)) ;Non-combined.
nil) ;must be mail then.
((vectorp article) ;Has header info.
(eq (gnus-request-type group (mail-header-id article)) 'news))
- ((null article) ;Hasn't header info
+ ((null article) ;Hasn't header info
(eq (gnus-request-type group) 'news)) ;(unknown ==> mail)
- ((< article 0) ;Virtual message
+ ((< article 0) ;Virtual message
nil) ;we don't know, guess mail.
(t ;Has positive number
(eq (gnus-request-type group article) 'news)))) ;use it.
(defun gnus-generate-new-group-name (leaf)
(let ((name leaf)
(num 0))
- (while (gnus-gethash name gnus-newsrc-hashtb)
+ (while (gnus-group-entry name)
(setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">")))
name))
(nth 1 method))))
method)))
+(defsubst gnus-method-to-server (method &optional nocache no-enter-cache)
+ (catch 'server-name
+ (setq method (or method gnus-select-method))
+
+ ;; Perhaps it is already in the cache.
+ (unless nocache
+ (mapc (lambda (name-method)
+ (if (equal (cdr name-method) method)
+ (throw 'server-name (car name-method))))
+ gnus-server-method-cache))
+
+ (mapc
+ (lambda (server-alist)
+ (mapc (lambda (name-method)
+ (when (gnus-methods-equal-p (cdr name-method) method)
+ (unless (member name-method gnus-server-method-cache)
+ (push name-method gnus-server-method-cache))
+ (throw 'server-name (car name-method))))
+ server-alist))
+ (list gnus-server-alist
+ gnus-predefined-server-alist))
+
+ (let* ((name (if (member (cadr method) '(nil ""))
+ (format "%s" (car method))
+ (format "%s:%s" (car method) (cadr method))))
+ (name-method (cons name method)))
+ (when (and (not (member name-method gnus-server-method-cache))
+ (not no-enter-cache)
+ (not (assoc (car name-method) gnus-server-method-cache)))
+ (push name-method gnus-server-method-cache))
+ name)))
+
(defsubst gnus-server-to-method (server)
"Map virtual server names to select methods."
(or (and server (listp server) server)
(not (equal server (format "%s:%s" (caar servers)
(cadar servers)))))
(pop servers))
- (car servers)))))
- (push (cons server result) gnus-server-method-cache)
+ (car servers))
+ ;; This could be some sort of foreign server that I
+ ;; simply haven't opened (yet). Do a brute-force scan
+ ;; of the entire gnus-newsrc-alist for the server name
+ ;; of every method. As a side-effect, loads the
+ ;; gnus-server-method-cache so this only happens once,
+ ;; if at all.
+ (let ((alist (cdr gnus-newsrc-alist))
+ method match)
+ (while alist
+ (setq method (gnus-info-method (pop alist)))
+ (when (and (not (stringp method))
+ (equal server
+ (gnus-method-to-server method nil t)))
+ (setq match method
+ alist nil)))
+ match))))
+ (when (and result
+ (not (assoc server gnus-server-method-cache)))
+ (push (cons server result) gnus-server-method-cache))
result)))
(defsubst gnus-server-get-method (group method)
gnus-valid-select-methods)))
(equal (nth 1 m1) (nth 1 m2)))))))
+(defun gnus-methods-sloppily-equal (m1 m2)
+ ;; Same method.
+ (or
+ (eq m1 m2)
+ ;; Type and name are equal.
+ (and
+ (eq (car m1) (car m2))
+ (equal (cadr m1) (cadr m2))
+ (gnus-sloppily-equal-method-parameters m1 m2))))
+
+(defsubst gnus-sloppily-equal-method-parameters (m1 m2)
+ ;; Check parameters for sloppy equalness.
+ (let ((p1 (copy-sequence (cddr m1)))
+ (p2 (copy-sequence (cddr m2)))
+ e1 e2)
+ (block nil
+ (while (setq e1 (pop p1))
+ (unless (setq e2 (assq (car e1) p2))
+ ;; The parameter doesn't exist in p2.
+ (return nil))
+ (setq p2 (delq e2 p2))
+ (unless (equal e1 e2)
+ (if (not (and (stringp (cadr e1))
+ (stringp (cadr e2))))
+ (return nil)
+ ;; Special-case string parameter comparison so that we
+ ;; can uniquify them.
+ (let ((s1 (cadr e1))
+ (s2 (cadr e2)))
+ (when (string-match "/$" s1)
+ (setq s1 (directory-file-name s1)))
+ (when (string-match "/$" s2)
+ (setq s2 (directory-file-name s2)))
+ (unless (equal s1 s2)
+ (return nil))))))
+ ;; If p2 now is empty, they were equal.
+ (null p2))))
+
(defun gnus-server-equal (m1 m2)
"Say whether two methods are equal."
(let ((m1 (cond ((null m1) gnus-select-method)
"Return the prefix of the current group name."
(< 0 (length (gnus-group-real-prefix group))))
+(declare-function gnus-group-decoded-name "gnus-group" (string))
+
(defun gnus-summary-buffer-name (group)
"Return the summary buffer name of GROUP."
(concat "*Summary " (gnus-group-decoded-name group) "*"))
(defsubst gnus-secondary-method-p (method)
"Return whether METHOD is a secondary select method."
(let ((methods gnus-secondary-select-methods)
- (gmethod (gnus-server-get-method nil method)))
+ (gmethod (inline (gnus-server-get-method nil method))))
(while (and methods
(not (gnus-method-equal
- (gnus-server-get-method nil (car methods))
+ (inline (gnus-server-get-method nil (car methods)))
gmethod)))
(setq methods (cdr methods)))
methods))
(defun gnus-parameters-get-parameter (group)
"Return the group parameters for GROUP from `gnus-parameters'."
- (let (params-list)
+ (let ((case-fold-search (if (eq gnus-parameters-case-fold-search 'default)
+ case-fold-search
+ gnus-parameters-case-fold-search))
+ params-list)
(dolist (elem gnus-parameters)
(when (string-match (car elem) group)
(setq params-list
(defun gnus-expand-group-parameter (match value group)
"Use MATCH to expand VALUE in GROUP."
- (with-temp-buffer
- (insert group)
- (goto-char (point-min))
- (while (re-search-forward match nil t)
- (replace-match value))
- (buffer-string)))
+ (let ((start (string-match match group)))
+ (if start
+ (let ((matched-string (substring group start (match-end 0))))
+ ;; Build match groups
+ (string-match match matched-string)
+ (replace-match value nil nil matched-string))
+ group)))
(defun gnus-expand-group-parameters (match parameters group)
"Go through PARAMETERS and expand them according to the match data."
(if simple-results
;; Found results; return them.
(car simple-results)
- ;; We didn't found it there, try `gnus-parameters'.
+ ;; We didn't find it there, try `gnus-parameters'.
(let ((result nil)
(head nil)
(tail gnus-parameters))
;; Expand if necessary.
(if (and (stringp result) (string-match "\\\\[0-9&]" result))
(setq result (gnus-expand-group-parameter (car head)
- result group)))
- ;; Exit the loop early.
- (setq tail nil))))
+ result group))))))
;; Done.
result))))
If you call this function inside a loop, consider using the faster
`gnus-group-fast-parameter' instead."
- (save-excursion
- (set-buffer gnus-group-buffer)
+ (with-current-buffer gnus-group-buffer
(if symbol
(gnus-group-fast-parameter group symbol allow-list)
(nconc
(defun gnus-group-get-parameter (group &optional symbol allow-list)
"Return the group parameters for GROUP.
If SYMBOL, return the value of that symbol in the group parameters.
+If ALLOW-LIST, also allow list as a result.
Most functions should use `gnus-group-find-parameter', which
also examines the topic parameters."
(let ((params (gnus-info-params (gnus-get-info group))))
(defun gnus-group-parameter-value (params symbol &optional
allow-list present-p)
- "Return the value of SYMBOL in group PARAMS."
+ "Return the value of SYMBOL in group PARAMS.
+If ALLOW-LIST, also allow list as a result."
;; We only wish to return group parameters (dotted lists) and
;; not local variables, which may have the same names.
;; But first we handle single elements...
group 'params))))
(defun gnus-group-set-parameter (group name value)
- "Set parameter NAME to VALUE in GROUP."
- (let ((info (gnus-get-info group)))
+ "Set parameter NAME to VALUE in GROUP.
+GROUP can also be an INFO structure."
+ (let ((info (if (listp group)
+ group
+ (gnus-get-info group))))
(when info
(gnus-group-remove-parameter group name)
(let ((old-params (gnus-info-params info))
(not (eq (caar old-params) name)))
(setq new-params (append new-params (list (car old-params)))))
(setq old-params (cdr old-params)))
- (gnus-group-set-info new-params group 'params)))))
+ (if (listp group)
+ (gnus-info-set-params info new-params t)
+ (gnus-group-set-info new-params (gnus-info-group info) 'params))))))
(defun gnus-group-remove-parameter (group name)
- "Remove parameter NAME from GROUP."
- (let ((info (gnus-get-info group)))
+ "Remove parameter NAME from GROUP.
+GROUP can also be an INFO structure."
+ (let ((info (if (listp group)
+ group
+ (gnus-get-info group))))
(when info
(let ((params (gnus-info-params info)))
(when params
(setq params (delq name params))
(while (assq name params)
- (gnus-pull name params))
+ (gnus-alist-pull name params))
(gnus-info-set-params info params))))))
(defun gnus-group-add-score (group &optional score)
(defun gnus-kill-save-kill-buffer ()
(let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name)))
(when (get-file-buffer file)
- (save-excursion
- (set-buffer (get-file-buffer file))
+ (with-current-buffer (get-file-buffer file)
(when (buffer-modified-p)
(save-buffer))
(kill-buffer (current-buffer))))))
gnus-valid-select-methods)))
(defun gnus-similar-server-opened (method)
- (let ((opened gnus-opened-servers))
+ "Return non-nil if we have a similar server opened.
+This is defined as a server with the same name, but different
+parameters."
+ (let ((opened gnus-opened-servers)
+ open)
(while (and method opened)
- (when (and (equal (cadr method) (cadaar opened))
- (equal (car method) (caaar opened))
- (not (equal method (caar opened))))
- (setq method nil))
- (pop opened))
+ (setq open (car (pop opened)))
+ ;; Type and name are the same...
+ (when (and (equal (car method) (car open))
+ (equal (cadr method) (cadr open))
+ ;; ... but the rest of the parameters differ.
+ (not (gnus-methods-sloppily-equal method open)))
+ (setq method nil)))
(not method)))
(defun gnus-server-extend-method (group method)
- ;; This function "extends" a virtual server. If the server is
+ ;; This function "extends" a virtual server. If the server is
;; "hello", and the select method is ("hello" (my-var "something"))
;; in the group "alt.alt", this will result in a new virtual server
;; called "hello+alt.alt".
(if (or (not (inline (gnus-similar-server-opened method)))
(not (cddr method)))
method
- `(,(car method) ,(concat (cadr method) "+" group)
- (,(intern (format "%s-address" (car method))) ,(cadr method))
- ,@(cddr method))))
+ (setq method
+ `(,(car method) ,(concat (cadr method) "+" group)
+ (,(intern (format "%s-address" (car method))) ,(cadr method))
+ ,@(cddr method)))
+ (push method gnus-extended-servers)
+ method))
(defun gnus-server-status (method)
"Return the status of METHOD."
(format "%s using %s" address (car server))
(format "%s" (car server)))))
+(defun gnus-same-method-different-name (method)
+ (let ((slot (intern (concat (symbol-name (car method)) "-address"))))
+ (unless (assq slot (cddr method))
+ (setq method
+ (append method (list (list slot (nth 1 method)))))))
+ (let ((methods gnus-extended-servers)
+ open found)
+ (while (and (not found)
+ (setq open (pop methods)))
+ (when (and (eq (car method) (car open))
+ (gnus-sloppily-equal-method-parameters method open))
+ (setq found open)))
+ found))
+
(defun gnus-find-method-for-group (group &optional info)
"Find the select method that GROUP uses."
(or gnus-override-method
(and (not group)
gnus-select-method)
- (and (not (gnus-group-entry group)) ;; a new group
- (gnus-group-name-to-method group))
+ (and (not (gnus-group-entry group))
+ ;; Killed or otherwise unknown group.
+ (or
+ ;; If we know a virtual server by that name, return its method.
+ (gnus-server-to-method (gnus-group-server group))
+ ;; Guess a new method as last resort.
+ (gnus-group-name-to-method group)))
(let ((info (or info (gnus-get-info group)))
method)
(if (or (not info)
(cond ((stringp method)
(inline (gnus-server-to-method method)))
((stringp (cadr method))
- (inline (gnus-server-extend-method group method)))
+ (or
+ (inline
+ (gnus-same-method-different-name method))
+ (inline (gnus-server-extend-method group method))))
(t
method)))
(cond ((equal (cadr method) "")
(setq valids (cdr valids)))
outs))
+(eval-and-compile
+ (autoload 'message-y-or-n-p "message" nil nil 'macro))
+
(defun gnus-read-group (prompt &optional default)
"Prompt the user for a group name.
Disallow invalid group names."
(cons (or default "") 0)
'gnus-group-history)))
(let ((match (match-string 0 group)))
- ;; `/' may be okay (e.g. for nnimap), so ask the user:
- (unless (and (string-match "/" match)
+ ;; Might be okay (e.g. for nnimap), so ask the user:
+ (unless (and (not (string-match "^$\\|:" match))
(message-y-or-n-p
"Proceed and create group anyway? " t
"The group name \"" group "\" contains a forbidden character: \"" match "\".
Usually, it's dangerous to create a group with this name, because it's not
-supported by all back ends and servers. On some IMAP servers, it's valid to
-use the character \"/\".
-
-If you are really sure, you can proceed anyway and create the group.
+supported by all back ends and servers. On IMAP servers it should work,
+though. If you are really sure, you can proceed anyway and create the group.
You may customize the variable `gnus-invalid-group-regexp', which currently is
set to \"" gnus-invalid-group-regexp
-"\", if you want to get rid of this query."))
+"\", if you want to get rid of this query permanently."))
(setq prefix (format "Invalid group name: \"%s\". " group)
group nil)))))
group))
gnus-predefined-server-alist
gnus-server-alist))
(method
- (completing-read
- prompt servers
- nil t nil 'gnus-method-history)))
+ (gnus-completing-read
+ prompt (mapcar 'car servers)
+ t nil 'gnus-method-history)))
(cond
((equal method "")
(setq method gnus-select-method))
;;; Agent functions
-(defun gnus-agent-method-p (method)
+(defun gnus-agent-method-p (method-or-server)
"Say whether METHOD is covered by the agent."
- (member method gnus-agent-covered-methods))
+ (or (eq (car gnus-agent-method-p-cache) method-or-server)
+ (let* ((method (if (stringp method-or-server)
+ (gnus-server-to-method method-or-server)
+ method-or-server))
+ (server (gnus-method-to-server method t)))
+ (setq gnus-agent-method-p-cache
+ (cons method-or-server
+ (member server gnus-agent-covered-methods)))))
+ (cdr gnus-agent-method-p-cache))
(defun gnus-online (method)
(not
(delete-frame gnus-other-frame-object))
(setq gnus-other-frame-object nil)))))))
-;;(setq thing ? ; this is a comment
-;; more 'yes)
-
;;;###autoload
(defun gnus (&optional arg dont-connect slave)
"Read network news.
If ARG is non-nil and a positive number, Gnus will use that as the
-startup level. If ARG is non-nil and not a positive number, Gnus will
+startup level. If ARG is non-nil and not a positive number, Gnus will
prompt the user for the name of an NNTP server to use."
(interactive "P")
+ ;; When using the development version of Gnus, load the gnus-load
+ ;; file.
+ (unless (string-match "^Gnus" gnus-version)
+ (load "gnus-load" nil t))
(unless (byte-code-function-p (symbol-function 'gnus))
(message "You should byte-compile Gnus")
(sit-for 2))
- (gnus-1 arg dont-connect slave))
+ (let ((gnus-action-message-log (list nil)))
+ (gnus-1 arg dont-connect slave)
+ (gnus-final-warning)))
;; Allow redefinition of Gnus functions.
projects / gnus / blobdiff