;;; 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 Free Software Foundation, Inc.
+;; 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
;; 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.6"
+(defconst gnus-version-number "0.11"
"Version number for this version of Gnus.")
(defconst gnus-version (format "No Gnus v%s" gnus-version-number)
(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))
(defface gnus-group-mail-1-empty
'((((class color)
(background dark))
- (:foreground "aquamarine1"))
+ (:foreground "#e1ffe1"))
(((class color)
(background light))
(:foreground "DeepPink3"))
(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))
(defface gnus-group-mail-2-empty
'((((class color)
(background dark))
- (:foreground "aquamarine2"))
+ (:foreground "DarkSeaGreen1"))
(((class color)
(background light))
(:foreground "HotPink3"))
(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))
(defface gnus-group-mail-3-empty
'((((class color)
(background dark))
- (:foreground "aquamarine3"))
+ (:foreground "aquamarine1"))
(((class color)
(background light))
(:foreground "magenta4"))
(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))
(defface gnus-group-mail-low-empty
'((((class color)
(background dark))
- (:foreground "aquamarine4"))
+ (:foreground "aquamarine2"))
(((class color)
(background light))
(:foreground "DeepPink4"))
(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)
(background dark))
- (:foreground "#888888"))
+ (:foreground "#cccccc"))
(((class color)
(background light))
(:foreground "#888888"))
(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))
(t
(insert
(format " %s
- _ ___ _ _
- _ ___ __ ___ __ _ ___
- __ _ ___ __ ___
- _ ___ _
- _ _ __ _
- ___ __ _
- __ _
- _ _ _
- _ _ _
- _ _ _
- __ ___
- _ _ _ _
- _ _
- _ _
- _ _
- _
- __
+ _ ___ _ _
+ _ ___ __ ___ __ _ ___
+ __ _ ___ __ ___
+ _ ___ _
+ _ _ __ _
+ ___ __ _
+ __ _
+ _ _ _
+ _ _ _
+ _ _ _
+ __ ___
+ _ _ _ _
+ _ _
+ _ _
+ _ _
+ _
+ __
"
""))
(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.
;; 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
(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))
+ (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) "*"))
(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))
(and (not group)
gnus-select-method)
(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)))
+ ;; 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)
(provide 'gnus)
-;;; arch-tag: acebeeab-f331-4f8f-a7ea-89c58c84f636
+;; arch-tag: acebeeab-f331-4f8f-a7ea-89c58c84f636
;;; gnus.el ends here
projects / gnus / blobdiff