;;; gnus.el --- a newsreader for GNU Emacs
-;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, 1997,
-;; 1998, 2000, 2001, 2002, 2003, 2004, 2005 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
+;; 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.
+(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)
: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 "0.4"
+(defconst gnus-version-number "0.11"
"Version number for this version of Gnus.")
(defconst gnus-version (format "No Gnus v%s" gnus-version-number)
;; 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))
()))
"Level 1 newsgroup face."
:group 'gnus-group)
+;; backward-compatibility alias
+(put 'gnus-group-news-1-face 'face-alias 'gnus-group-news-1)
-(defface gnus-group-news-1-empty-face
+(defface gnus-group-news-1-empty
'((((class color)
(background dark))
(:foreground "PaleTurquoise"))
()))
"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)
-(defface gnus-group-news-2-face
+(defface gnus-group-news-2
'((((class color)
(background dark))
(:foreground "turquoise" :bold t))
()))
"Level 2 newsgroup face."
:group 'gnus-group)
+;; backward-compatibility alias
+(put 'gnus-group-news-2-face 'face-alias 'gnus-group-news-2)
-(defface gnus-group-news-2-empty-face
+(defface gnus-group-news-2-empty
'((((class color)
(background dark))
(:foreground "turquoise"))
()))
"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)
-(defface gnus-group-news-3-face
+(defface gnus-group-news-3
'((((class color)
(background dark))
(:bold t))
()))
"Level 3 newsgroup face."
:group 'gnus-group)
+;; backward-compatibility alias
+(put 'gnus-group-news-3-face 'face-alias 'gnus-group-news-3)
-(defface gnus-group-news-3-empty-face
+(defface gnus-group-news-3-empty
'((((class color)
(background dark))
())
()))
"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)
-(defface gnus-group-news-4-face
+(defface gnus-group-news-4
'((((class color)
(background dark))
(:bold t))
()))
"Level 4 newsgroup face."
:group 'gnus-group)
+;; backward-compatibility alias
+(put 'gnus-group-news-4-face 'face-alias 'gnus-group-news-4)
-(defface gnus-group-news-4-empty-face
+(defface gnus-group-news-4-empty
'((((class color)
(background dark))
())
()))
"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)
-(defface gnus-group-news-5-face
+(defface gnus-group-news-5
'((((class color)
(background dark))
(:bold t))
()))
"Level 5 newsgroup face."
:group 'gnus-group)
+;; backward-compatibility alias
+(put 'gnus-group-news-5-face 'face-alias 'gnus-group-news-5)
-(defface gnus-group-news-5-empty-face
+(defface gnus-group-news-5-empty
'((((class color)
(background dark))
())
()))
"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)
-(defface gnus-group-news-6-face
+(defface gnus-group-news-6
'((((class color)
(background dark))
(:bold t))
()))
"Level 6 newsgroup face."
:group 'gnus-group)
+;; backward-compatibility alias
+(put 'gnus-group-news-6-face 'face-alias 'gnus-group-news-6)
-(defface gnus-group-news-6-empty-face
+(defface gnus-group-news-6-empty
'((((class color)
(background dark))
())
()))
"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)
-(defface gnus-group-news-low-face
+(defface gnus-group-news-low
'((((class color)
(background dark))
(:foreground "DarkTurquoise" :bold t))
()))
"Low level newsgroup face."
:group 'gnus-group)
+;; backward-compatibility alias
+(put 'gnus-group-news-low-face 'face-alias 'gnus-group-news-low)
-(defface gnus-group-news-low-empty-face
+(defface gnus-group-news-low-empty
'((((class color)
(background dark))
(:foreground "DarkTurquoise"))
()))
"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)
-(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))
(:bold t)))
"Level 1 mailgroup face."
:group 'gnus-group)
+;; backward-compatibility alias
+(put 'gnus-group-mail-1-face 'face-alias 'gnus-group-mail-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"))
(:italic t :bold t)))
"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)
-(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))
(:bold t)))
"Level 2 mailgroup face."
:group 'gnus-group)
+;; backward-compatibility alias
+(put 'gnus-group-mail-2-face 'face-alias 'gnus-group-mail-2)
-(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"))
(:bold t)))
"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)
-(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))
(:bold t)))
"Level 3 mailgroup face."
:group 'gnus-group)
+;; backward-compatibility alias
+(put 'gnus-group-mail-3-face 'face-alias 'gnus-group-mail-3)
-(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"))
()))
"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)
-(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))
(:bold t)))
"Low level mailgroup face."
:group 'gnus-group)
+;; backward-compatibility alias
+(put 'gnus-group-mail-low-face 'face-alias 'gnus-group-mail-low)
-(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"))
(:bold t)))
"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)
;; Summary mode faces.
-(defface gnus-summary-selected-face '((t
- (:underline t)))
+(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)
-(defface gnus-summary-cancelled-face
+(defface gnus-summary-cancelled
'((((class color))
(:foreground "yellow" :background "black")))
"Face used for cancelled articles."
:group 'gnus-summary)
+;; backward-compatibility alias
+(put 'gnus-summary-cancelled-face 'face-alias 'gnus-summary-cancelled)
-(defface gnus-summary-high-ticked-face
+(defface gnus-summary-high-ticked
'((((class color)
(background dark))
(:foreground "pink" :bold t))
(:bold t)))
"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)
-(defface gnus-summary-low-ticked-face
+(defface gnus-summary-low-ticked
'((((class color)
(background dark))
(:foreground "pink" :italic t))
(:italic t)))
"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)
-(defface gnus-summary-normal-ticked-face
+(defface gnus-summary-normal-ticked
'((((class color)
(background dark))
(:foreground "pink"))
()))
"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)
-(defface gnus-summary-high-ancient-face
+(defface gnus-summary-high-ancient
'((((class color)
(background dark))
(:foreground "SkyBlue" :bold t))
(:bold t)))
"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)
-(defface gnus-summary-low-ancient-face
+(defface gnus-summary-low-ancient
'((((class color)
(background dark))
(:foreground "SkyBlue" :italic t))
(:italic t)))
"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)
-(defface gnus-summary-normal-ancient-face
+(defface gnus-summary-normal-ancient
'((((class color)
(background dark))
(:foreground "SkyBlue"))
()))
"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)
-(defface gnus-summary-high-undownloaded-face
+(defface gnus-summary-high-undownloaded
'((((class color)
(background light))
(:bold t :foreground "cyan4"))
(t (:inverse-video t :bold t)))
"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)
-(defface gnus-summary-low-undownloaded-face
+(defface gnus-summary-low-undownloaded
'((((class color)
(background light))
(:italic t :foreground "cyan4" :bold nil))
(t (:inverse-video t :italic t)))
"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)
-(defface gnus-summary-normal-undownloaded-face
+(defface gnus-summary-normal-undownloaded
'((((class color)
(background light))
(:foreground "cyan4" :bold nil))
(t (:inverse-video t)))
"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)
-(defface gnus-summary-high-unread-face
+(defface gnus-summary-high-unread
'((t
(:bold t)))
"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)
-(defface gnus-summary-low-unread-face
+(defface gnus-summary-low-unread
'((t
(:italic t)))
"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)
-(defface gnus-summary-normal-unread-face
+(defface gnus-summary-normal-unread
'((t
()))
"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)
-(defface gnus-summary-high-read-face
+(defface gnus-summary-high-read
'((((class color)
(background dark))
(:foreground "PaleGreen"
(:bold t)))
"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)
-(defface gnus-summary-low-read-face
+(defface gnus-summary-low-read
'((((class color)
(background dark))
(:foreground "PaleGreen"
(:italic t)))
"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)
-(defface gnus-summary-normal-read-face
+(defface gnus-summary-normal-read
'((((class color)
(background dark))
(:foreground "PaleGreen"))
()))
"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)
;;;
(defvar gnus-group-buffer "*Group*")
-(eval-and-compile
- (autoload 'gnus-play-jingle "gnus-audio"))
+(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."
- :group 'gnus)
+ :group 'gnus-start)
+;; backward-compatibility alias
+(put 'gnus-splash-face 'face-alias 'gnus-splash)
(defun gnus-splash ()
(save-excursion
(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)
+ ;; 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
("background" . ,(face-background 'default))))
(: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))
: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)
(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
(nconc
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-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 "23.1" ;; No Gnus
+ :group 'gnus-server
+ :group 'gnus-message
+ :type 'boolean)
+
(defcustom gnus-message-archive-group nil
"*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
(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)
:version "22.1"
:group 'gnus-group-various
:type '(repeat (cons (string :tag "Hierarchy") (sexp :tag "Form"))))
+(put 'gnus-group-charter-alist 'risky-local-variable t)
(defcustom gnus-group-fetch-control-use-browse-url nil
"*Non-nil means that control messages are displayed using `browse-url'.
(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)
: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.
:value t)))
(defcustom gnus-use-nocem nil
- "*If non-nil, Gnus will read NoCeM cancel messages."
+ "*If non-nil, Gnus will read NoCeM cancel messages.
+You can also set this variable to a positive number as a group level.
+In that case, Gnus scans NoCeM messages when checking new news if this
+value is not exceeding a group level that you specify as the prefix
+argument to some commands, e.g. `gnus', `gnus-group-get-new-news', etc.
+Otherwise, Gnus does not scan NoCeM messages if you specify a group
+level to those commands."
:group 'gnus-meta
- :type 'boolean)
+ :type '(choice
+ (const :tag "off" nil)
+ (const :tag "on" t)
+ (list :convert-widget
+ (lambda (widget)
+ (list 'integer :tag "group level"
+ :value (if (boundp 'gnus-level-default-subscribed)
+ gnus-level-default-subscribed
+ 3))))))
(defcustom gnus-suppress-duplicates nil
"*If non-nil, Gnus will mark duplicate copies of the same article as read."
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)
"*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)
"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.
;; 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
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
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-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))))
(nth 1 method))))
method)))
-(defsubst gnus-method-to-server (method)
+(defsubst gnus-method-to-server (method &optional nocache)
(catch 'server-name
(setq method (or method gnus-select-method))
;; Perhaps it is already in the cache.
- (mapc (lambda (name-method)
- (if (equal (cdr name-method) method)
- (throw 'server-name (car name-method))))
- gnus-server-method-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))
- (let ((alists (list gnus-server-alist
- gnus-predefined-server-alist)))
- (if gnus-select-method
- (push (list (cons "native" gnus-select-method)) alists))
- alists))
+ (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)))
+ (format "%s" (car method))
+ (format "%s:%s" (car method) (cadr method))))
+ (name-method (cons name method)))
(unless (member name-method gnus-server-method-cache)
- (push name-method gnus-server-method-cache))
+ (push name-method gnus-server-method-cache))
name)))
(defsubst gnus-server-to-method (server)
(cadar servers)))))
(pop servers))
(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 (match)
- (mapcar
- (lambda (info)
- (let ((info-method (gnus-info-method info)))
- (unless (stringp info-method)
- (let ((info-server (gnus-method-to-server info-method)))
- (when (equal server info-server)
- (setq match info-method))))))
- (cdr gnus-newsrc-alist))
- match))))
- (when result
- (push (cons server result) gnus-server-method-cache))
+ ;; 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)))
+ (setq match method
+ alist nil)))
+ match))))
+ (when result
+ (push (cons server result) gnus-server-method-cache))
result)))
(defsubst gnus-server-get-method (group 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) "*"))
(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
(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))
(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...
(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".
(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)
;;; Agent functions
-(defun gnus-agent-method-p (method)
+(defun gnus-agent-method-p (method-or-server)
"Say whether METHOD is covered by the agent."
- (or (eq (car gnus-agent-method-p-cache) method)
- (setq gnus-agent-method-p-cache
- (cons method
- (member (if (stringp method)
- method
- (gnus-method-to-server 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)
(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.
(provide 'gnus)
-;;; arch-tag: acebeeab-f331-4f8f-a7ea-89c58c84f636
+;; arch-tag: acebeeab-f331-4f8f-a7ea-89c58c84f636
;;; gnus.el ends here
projects / gnus / blobdiff