;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: news
+;; Keywords: news, mail
;; This file is part of GNU Emacs.
(require 'custom)
(require 'gnus-load)
+(require 'message)
(defgroup gnus nil
"The coffee-brewing, all singing, all dancing, kitchen sink newsreader."
- :group 'emacs)
+ :group 'news
+ :group 'mail)
(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)Foreign Groups")
:group 'gnus-group)
+(defgroup gnus-group-new nil
+ "Automatic subscription of new groups."
+ :group 'gnus-group)
+
(defgroup gnus-group-levels nil
"Group levels."
:link '(custom-manual "(gnus)Group Levels")
"Adaptive score files."
:group 'gnus-score)
+(defgroup gnus-score-default nil
+ "Default values for score files."
+ :group 'gnus-score)
+
+(defgroup gnus-score-expire nil
+ "Expiring score rules."
+ :group 'gnus-score)
+
+(defgroup gnus-score-decay nil
+ "Decaying score rules."
+ :group 'gnus-score)
+
(defgroup gnus-score-files nil
"Score and kill file names."
:group 'gnus-score
;; Other
(defgroup gnus-visual nil
"Options controling the visual fluff."
- :group 'gnus)
-
-(defgroup gnus-mail-expire nil
- "Expiring articles in mail backends."
- :group 'gnus-mail)
+ :group 'gnus
+ :group 'faces)
(defgroup gnus-files nil
"Files used by Gnus."
:group 'gnus)
+(defgroup gnus-dribble-file nil
+ "Auto save file."
+ :link '(custom-manual "(gnus)Auto Save")
+ :group 'gnus-files)
+
+(defgroup gnus-newsrc nil
+ "Storing Gnus state."
+ :group 'gnus-files)
+
(defgroup gnus-server nil
"Options related to newsservers and other servers used by Gnus."
:group 'gnus)
:link '(custom-manual "(gnus)Exiting Gnus")
:group 'gnus)
-(defconst gnus-version-number "5.4.9"
+(defconst gnus-version-number "5.4.51"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Gnus v%s" gnus-version-number)
(defalias 'gnus-topic-remove-excess-properties 'ignore)
(defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window)
(defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names)
- (defalias 'gnus-make-local-hook 'make-local-hook)
- (defalias 'gnus-add-hook 'add-hook)
(defalias 'gnus-character-to-event 'identity)
(defalias 'gnus-add-text-properties 'add-text-properties)
(defalias 'gnus-put-text-property 'put-text-property)
;; 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-face
'((((class color)
(background dark))
(:foreground "PaleTurquoise" :bold t))
()))
"Level 1 empty newsgroup face.")
-(defface gnus-group-news-2-face
+(defface gnus-group-news-2-face
'((((class color)
(background dark))
(:foreground "turquoise" :bold t))
()))
"Level 2 empty newsgroup face.")
-(defface gnus-group-news-3-face
+(defface gnus-group-news-3-face
'((((class color)
(background dark))
(:bold t))
()))
"Level 3 empty newsgroup face.")
-(defface gnus-group-news-low-face
+(defface gnus-group-news-low-face
'((((class color)
(background dark))
(:foreground "DarkTurquoise" :bold t))
()))
"Low level empty newsgroup face.")
-(defface gnus-group-mail-1-face
+(defface gnus-group-mail-1-face
'((((class color)
(background dark))
(:foreground "aquamarine1" :bold t))
(:italic t :bold t)))
"Level 1 empty mailgroup face.")
-(defface gnus-group-mail-2-face
+(defface gnus-group-mail-2-face
'((((class color)
(background dark))
(:foreground "aquamarine2" :bold t))
(:bold t)))
"Level 2 empty mailgroup face.")
-(defface gnus-group-mail-3-face
+(defface gnus-group-mail-3-face
'((((class color)
(background dark))
(:foreground "aquamarine3" :bold t))
()))
"Level 3 empty mailgroup face.")
-(defface gnus-group-mail-low-face
+(defface gnus-group-mail-low-face
'((((class color)
(background dark))
(:foreground "aquamarine4" :bold t))
;; Summary mode faces.
-(defface gnus-summary-selected-face '((t
+(defface gnus-summary-selected-face '((t
(:underline t)))
"Face used for selected articles.")
-(defface gnus-summary-cancelled-face
+(defface gnus-summary-cancelled-face
'((((class color))
(:foreground "yellow" :background "black")))
"Face used for cancelled articles.")
(((class color)
(background light))
(:foreground "firebrick" :bold t))
- (t
+ (t
(:bold t)))
"Face used for high interest ticked articles.")
(((class color)
(background light))
(:foreground "firebrick" :italic t))
- (t
+ (t
(:italic t)))
"Face used for low interest ticked articles.")
(((class color)
(background light))
(:foreground "firebrick"))
- (t
+ (t
()))
"Face used for normal interest ticked articles.")
-
+
(defface gnus-summary-high-ancient-face
'((((class color)
(background dark))
(((class color)
(background light))
(:foreground "RoyalBlue" :bold t))
- (t
+ (t
(:bold t)))
"Face used for high interest ancient articles.")
(((class color)
(background light))
(:foreground "RoyalBlue" :italic t))
- (t
+ (t
(:italic t)))
"Face used for low interest ancient articles.")
(((class color)
(background light))
(:foreground "RoyalBlue"))
- (t
+ (t
()))
"Face used for normal interest ancient articles.")
-
+
(defface gnus-summary-high-unread-face
- '((t
+ '((t
(:bold t)))
"Face used for high interest unread articles.")
(defface gnus-summary-low-unread-face
- '((t
+ '((t
(:italic t)))
"Face used for low interest unread articles.")
(defface gnus-summary-normal-unread-face
- '((t
+ '((t
()))
"Face used for normal interest unread articles.")
-
+
(defface gnus-summary-high-read-face
'((((class color)
(background dark))
(background light))
(:foreground "DarkGreen"
:bold t))
- (t
+ (t
(:bold t)))
"Face used for high interest read articles.")
(background light))
(:foreground "DarkGreen"
:italic t))
- (t
+ (t
(:italic t)))
"Face used for low interest read articles.")
(((class color)
(background light))
(:foreground "DarkGreen"))
- (t
+ (t
()))
"Face used for normal interest read articles.")
(eval-and-compile
(autoload 'gnus-play-jingle "gnus-audio"))
-(defface gnus-splash-face
+(defface gnus-splash-face
'((((class color)
(background dark))
(:foreground "red"))
(require 'gnus-util)
(require 'nnheader)
-(defcustom gnus-directory (or (getenv "SAVEDIR") "~/News/")
+(defcustom gnus-home-directory "~/"
+ "Directory variable that specifies the \"home\" directory.
+All other Gnus path variables are initialized from this variable."
+ :group 'gnus-files
+ :type 'directory)
+
+(defcustom gnus-directory (or (getenv "SAVEDIR")
+ (nnheader-concat gnus-home-directory "News/"))
"Directory variable from which all other Gnus file variables are derived."
:group 'gnus-files
:type 'directory)
:group 'gnus-server
:type 'gnus-select-method)
-(defcustom gnus-message-archive-method
+(defcustom gnus-message-archive-method
`(nnfolder
"archive"
(nnfolder-directory ,(nnheader-concat message-directory "archive"))
- (nnfolder-active-file
+ (nnfolder-active-file
,(nnheader-concat message-directory "archive/active"))
(nnfolder-get-new-mail nil)
(nnfolder-inhibit-expiry t))
(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
+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
of strings). The functions are called with the name of the current
group (or nil) as a parameter.
If you want to save your mail in one group and the news articles you
write in another group, you could say something like:
- \(setq gnus-message-archive-group
+ \(setq gnus-message-archive-group
'((if (message-news-p)
- \"misc-news\"
+ \"misc-news\"
\"misc-mail\")))
Normally the group names returned by this variable should be
:type '(choice (const :tag "default" nil)
string))
-(defcustom gnus-local-organization nil
+(defvar gnus-local-organization nil
"String with a description of what organization (if any) the user belongs to.
-The ORGANIZATION environment variable is used instead if it is defined.
-If this variable contains a function, this function will be called
-with the current newsgroup name as the argument. The function should
-return a string.
-
-In any case, if the string (either in the variable, in the environment
-variable, or returned by the function) is a file name, the contents of
-this file will be used as the organization."
- :group 'gnus-message
- :type '(choice (const :tag "default" nil)
- string))
+Obsolete variable; use `message-user-organization' instead.")
;; Customization variables
:group 'gnus-meta
:type '(choice (const :tag "off" nil)
integer
- (sexp :format "all"
+ (sexp :format "all"
:value t)))
(defcustom gnus-use-nocem nil
:group 'gnus-meta
:type 'boolean)
-(defcustom gnus-summary-prepare-exit-hook
+(defcustom gnus-summary-prepare-exit-hook
'(gnus-summary-expire-articles)
"A hook called when preparing to exit from the summary buffer.
It calls `gnus-summary-expire-articles' by default."
(string :tag "Address")
(editable-list :inline t
(list :format "%v"
- variable
+ variable
(sexp :tag "Value")))))
(defcustom gnus-updated-mode-lines '(group article summary tree)
(defcustom gnus-mode-non-string-length nil
"*Max length of mode-line non-string contents.
If this is nil, Gnus will take space as is needed, leaving the rest
-of the modeline intact."
+of the modeline intact. Note that the default of nil is unlikely
+to be desirable; see the manual for further details."
:group 'gnus-various
:type '(choice (const nil)
integer))
"*Groups in which to automatically mark read articles as expirable.
If non-nil, this should be a regexp that should match all groups in
which to perform auto-expiry. This only makes sense for mail groups."
- :group 'gnus-mail-expire
+ :group 'nnmail-expire
:type '(choice (const nil)
regexp))
expiring - which means that all read articles will be deleted after
\(say) one week. (This only goes for mail groups and the like, of
course.)"
- :group 'gnus-mail-expire
+ :group 'nnmail-expire
:type '(choice (const nil)
regexp))
;;; Face thingies.
-(defcustom gnus-visual
- '(summary-highlight group-highlight article-highlight
+(defcustom gnus-visual
+ '(summary-highlight group-highlight article-highlight
mouse-face
summary-menu group-menu article-menu
tree-highlight menu highlight
gnus-article-fill-cited-article
gnus-article-remove-cr
gnus-article-de-quoted-unreadable
- gnus-article-display-x-face
gnus-summary-stop-page-breaking
;; gnus-summary-caesar-message
;; gnus-summary-verbose-headers
gnus-article-strip-multiple-blank-lines
gnus-article-strip-blank-lines
gnus-article-treat-overstrike
- ))
+ gnus-article-display-x-face
+ gnus-smiley-display))
+
+(defcustom gnus-article-save-directory gnus-directory
+ "*Name of the directory articles will be saved in (default \"~/News\")."
+ :group 'gnus-article-saving
+ :type 'directory)
\f
;;; Internal variables
(defvar gnus-have-read-active-file nil)
(defconst gnus-maintainer
- "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
+ "bugs@gnus.org (The Gnus Bugfixing Girls + Boys)"
"The mail address of the Gnus maintainers.")
(defvar gnus-info-nodes
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" gnus-uu-delete-work-dir)
+ ("gnus-uu" gnus-uu-delete-work-dir gnus-quote-arg-for-sh-or-csh)
("gnus-msg" (gnus-summary-send-map keymap)
gnus-article-mail gnus-copy-article-buffer gnus-extended-version)
("gnus-msg" :interactive t
("gnus-picon" :interactive t gnus-article-display-picons
gnus-group-display-picons gnus-picons-article-display-x-face
gnus-picons-display-x-face)
- ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p
+ ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p
gnus-grouplens-mode)
("smiley" :interactive t gnus-smiley-display)
("gnus-win" gnus-configure-windows gnus-add-configuration)
gnus-article-prepare gnus-article-set-window-start
gnus-article-next-page gnus-article-prev-page
gnus-request-article-this-buffer gnus-article-mode
- gnus-article-setup-buffer gnus-narrow-to-page)
+ gnus-article-setup-buffer gnus-narrow-to-page
+ gnus-article-delete-invisible-text)
("gnus-art" :interactive t
gnus-article-hide-headers gnus-article-hide-boring-headers
gnus-article-treat-overstrike gnus-article-word-wrap
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-decode-rfc1522 article-decode-rfc1522)
("gnus-int" gnus-request-type)
(defun gnus-suppress-keymap (keymap)
(suppress-keymap keymap)
- (let ((keys `([delete] "\177" "\M-u"))) ;gnus-mouse-2
+ (let ((keys `([delete] "\177" "\M-u"))) ;gnus-mouse-2
(while keys
(define-key keymap (pop keys) 'undefined))))
(let ((keymap (make-keymap)))
(gnus-suppress-keymap keymap)
keymap))
-(defvar gnus-summary-mode-map
+(defvar gnus-summary-mode-map
(let ((keymap (make-keymap)))
(gnus-suppress-keymap keymap)
keymap))
(string-to-number
(if (zerop major)
(format "%s00%02d%02d"
- (cond
+ (cond
((member alpha '("(ding)" "d")) "4.99")
((member alpha '("September" "s")) "5.01")
((member alpha '("Red" "r")) "5.03"))
(let ((method-name (symbol-name (car method))))
(if (and (memq 'address (assoc method-name gnus-valid-select-methods))
(not (assq (intern (concat method-name "-address")) method))
- (memq 'physical-address (assq (car method)
+ (memq 'physical-address (assq (car method)
gnus-valid-select-methods)))
(append method (list (list (intern (concat method-name "-address"))
(nth 1 method))))
(defun gnus-server-to-method (server)
"Map virtual server names to select methods."
- (or
+ (or
;; Is this a method, perhaps?
(and server (listp server) server)
;; Perhaps this is the native server?
(defun gnus-archive-server-wanted-p ()
"Say whether the user wants to use the archive server."
- (cond
+ (cond
((or (not gnus-message-archive-method)
(not gnus-message-archive-group))
nil)
(defun gnus-group-add-parameter (group param)
"Add parameter PARAM to GROUP."
(let ((info (gnus-get-info group)))
- (if (not info)
- () ; This is a dead group. We just ignore it.
+ (when info
+ (gnus-group-remove-parameter group (if (consp param) (car param) param))
;; Cons the new param to the old one and update.
(gnus-group-set-info (cons param (gnus-info-params info))
group 'params))))
(defun gnus-group-set-parameter (group name value)
"Set parameter NAME to VALUE in GROUP."
(let ((info (gnus-get-info group)))
- (if (not info)
- () ; This is a dead group. We just ignore it.
+ (when info
+ (gnus-group-remove-parameter group name)
(let ((old-params (gnus-info-params info))
(new-params (list (cons name value))))
(while old-params
(setq old-params (cdr old-params)))
(gnus-group-set-info new-params group 'params)))))
+(defun gnus-group-remove-parameter (group name)
+ "Remove parameter NAME from GROUP."
+ (let ((info (gnus-get-info group)))
+ (when info
+ (let ((params (gnus-info-params info)))
+ (when params
+ (setq params (delq name params))
+ (while (assq name params)
+ (setq params (delq (assq name params) params)))
+ (gnus-info-set-params info params))))))
+
(defun gnus-group-add-score (group &optional score)
"Add SCORE to the GROUP score.
If SCORE is nil, add 1 to the score of GROUP."
group nil)))
name))
+(defun gnus-narrow-to-body ()
+ "Narrow to the body of an article."
+ (narrow-to-region
+ (progn
+ (goto-char (point-min))
+ (or (search-forward "\n\n" nil t)
+ (point-max)))
+ (point-max)))
+
\f
;;;
;;; Kill file handling.
(defun gnus-newsgroup-kill-file (newsgroup)
"Return the name of a kill file name for NEWSGROUP.
If NEWSGROUP is nil, return the global kill file name instead."
- (cond
+ (cond
;; The global KILL file is placed at top of the directory.
((or (null newsgroup)
(string-equal newsgroup ""))
(memq option (assoc (format "%s" (car method))
gnus-valid-select-methods)))
+(defun gnus-similar-server-opened (method)
+ (let ((opened gnus-opened-servers))
+ (while (and method opened)
+ (when (and (equal (cadr method) (cadaar opened))
+ (not (equal method (caar opened))))
+ (setq method nil))
+ (pop opened))
+ (not method)))
+
(defun gnus-server-extend-method (group method)
;; 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".
- (let ((entry
- (gnus-copy-sequence
- (if (gnus-server-equal method gnus-select-method) gnus-select-method
- (cdr (assoc (car method) gnus-server-alist))))))
- (if (not entry)
- method
- (setcar (cdr entry) (concat (nth 1 entry) "+" group))
- (nconc entry (cdr method)))))
+ (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))))
(defun gnus-server-status (method)
"Return the status of METHOD."
gnus-select-method
(setq method
(cond ((stringp method)
- (gnus-server-to-method method))
- ((stringp (car method))
- (gnus-server-extend-method group method))
+ (inline (gnus-server-to-method method)))
+ ((stringp (cadr method))
+ (inline (gnus-server-extend-method group method)))
(t
method)))
(cond ((equal (cadr method) "")
(t
(gnus-server-add-address method)))))))
-(defun gnus-check-backend-function (func group)
+(defsubst gnus-check-backend-function (func group)
"Check whether GROUP supports function FUNC.
GROUP can either be a string (a group name) or a select method."
(ignore-errors
prompt (append gnus-valid-select-methods gnus-predefined-server-alist
gnus-server-alist)
nil t nil 'gnus-method-history)))
- (cond
+ (cond
((equal method "")
(setq method gnus-select-method))
((assoc method gnus-valid-select-methods)