;;; 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, 2006, 2007 Free Software Foundation, Inc.
+;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
+;; 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
;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, 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)
(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)
:link '(custom-manual "(gnus)Exiting Gnus")
:group 'gnus)
-(defconst gnus-version-number "0.7"
+(defconst gnus-version-number "0.11"
"Version number for this version of Gnus.")
(defconst gnus-version (format "No Gnus v%s" gnus-version-number)
: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
'((((class color)
: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
'((((class color)
: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
'((((class color)
: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
'((((class color)
: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
'((((class color)
: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
'((((class color)
: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
'((((class color)
: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
'((((class color)
: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
'((((class color)
: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
'((((class color)
: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
'((((class color)
: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
'((((class color)
: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
'((((class color)
: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
'((((class color)
: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
'((((class color)
: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
'((((class color)
: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
'((((class color)
: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
'((((class color)
: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
'((((class color)
: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
'((((class color)
: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
'((((class color)
: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.
: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
'((((class color))
: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
'((((class color)
: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
'((((class color)
: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
'((((class color)
: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
'((((class color)
: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
'((((class color)
: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
'((((class color)
: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
'((((class color)
: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
'((((class color)
: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
'((((class color)
: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
'((t
: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
'((t
: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
'((t
: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
'((((class color)
: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
'((((class color)
: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
'((((class color)
: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"))
+(autoload 'gnus-play-jingle "gnus-audio")
(defface gnus-splash
'((((class color)
: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
(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))
(symbol-value 'image-load-path))
(t load-path)))
(image (find-image
- `((:type xpm :file "gnus.xpm"
+ `((:type svg :file "gnus.svg")
+ (:type png :file "gnus.png")
+ (:type xpm :file "gnus.xpm"
:color-symbols
(("thing" . ,(car gnus-logo-colors))
("shadow" . ,(cadr gnus-logo-colors))
(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
: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'.
: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.
(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)
+ ;; 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-audio" :interactive t gnus-audio-play)
("gnus-xmas" gnus-xmas-splash)
("gnus-soup" :interactive t
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
(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)
;; 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))
+ (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))
"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) "*"))
;;; 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)
(provide 'gnus)
-;;; arch-tag: acebeeab-f331-4f8f-a7ea-89c58c84f636
+;; arch-tag: acebeeab-f331-4f8f-a7ea-89c58c84f636
;;; gnus.el ends here
projects / gnus / blobdiff