;;; 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, 2008, 2009, 2010
+;; Copyright (C) 1987-1990, 1993-1998, 2000-2012
;; Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
(eval '(run-hooks 'gnus-load-hook))
-;; For Emacs < 22.2.
+;; For Emacs <22.2 and XEmacs.
(eval-and-compile
(unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
(require 'wid-edit)
(require 'mm-util)
(require 'nnheader)
+(require 'gnus-compat)
;; These are defined afterwards with gnus-define-group-parameter
(defvar gnus-ham-process-destinations)
(defgroup gnus-meta nil
"Meta variables controlling major portions of Gnus.
-In general, modifying these variables does not take affect until Gnus
+In general, modifying these variables does not take effect until Gnus
is restarted, and sometimes reloaded."
:group 'gnus)
:link '(custom-manual "(gnus)Exiting Gnus")
:group 'gnus)
-(defconst gnus-version-number "0.11"
+(defconst gnus-version-number "0.6"
"Version number for this version of Gnus.")
-(defconst gnus-version (format "No Gnus v%s" gnus-version-number)
+(defconst gnus-version (format "Ma Gnus v%s" gnus-version-number)
"Version string for this version of Gnus.")
(defcustom gnus-inhibit-startup-message nil
:group 'gnus-start
:type 'boolean)
-(unless (fboundp 'gnus-group-remove-excess-properties)
- (defalias 'gnus-group-remove-excess-properties 'ignore))
-
(unless (featurep 'gnus-xmas)
(defalias 'gnus-make-overlay 'make-overlay)
(defalias 'gnus-delete-overlay 'delete-overlay)
(list str))
line)))
(defalias 'gnus-mode-line-buffer-identification 'identity))
- (defalias 'gnus-characterp 'numberp)
(defalias 'gnus-deactivate-mark 'deactivate-mark)
(defalias 'gnus-window-edges 'window-edges)
(defalias 'gnus-key-press-event-p 'numberp)
(defface gnus-summary-cancelled
'((((class color))
(:foreground "yellow" :background "black")))
- "Face used for cancelled articles."
+ "Face used for canceled articles."
:group 'gnus-summary)
;; backward-compatibility alias
(put 'gnus-summary-cancelled-face 'face-alias 'gnus-summary-cancelled)
;;; Gnus buffers
;;;
-(defvar gnus-buffers nil)
+(defvar gnus-buffers nil
+ "List of buffers handled by Gnus.")
(defun gnus-get-buffer-create (name)
"Do the same as `get-buffer-create', but store the created buffer."
;;; Splash screen.
-(defvar gnus-group-buffer "*Group*")
+(defvar gnus-group-buffer "*Group*"
+ "Name of the Gnus group buffer.")
(defface gnus-splash
'((((class color)
(while (search-forward "\t" nil t)
(replace-match " " t t))))))
-(defvar gnus-simple-splash nil)
-
;;(format "%02x%02x%02x" 114 66 20) "724214"
(defvar gnus-logo-color-alist
(purp "#9999cc" "#666699")
(no "#ff0000" "#ffff00")
(neutral "#b4b4b4" "#878787")
+ (ma "#2020e0" "#8080ff")
(september "#bf9900" "#ffcc00"))
"Color alist used for the Gnus logo.")
-(defcustom gnus-logo-color-style 'no
+(defcustom gnus-logo-color-style 'ma
"*Color styles used for the Gnus logo."
:type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem)))
gnus-logo-color-alist))
"Insert startup message in current buffer."
;; Insert the message.
(erase-buffer)
- (cond
- ((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
- (("thing" . ,(car gnus-logo-colors))
- ("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)
- :foreground ,(face-background 'default))
- (:type xbm :file "gnus.xbm"
- ;; Account for the xbm's blackground.
- :background ,(face-foreground 'gnus-splash)
- :foreground ,(face-background 'default))))))
- (when image
- (let ((size (image-size image)))
- (insert-char ?\n (max 0 (round (- (window-height)
- (or y (cdr size)) 1) 2)))
- (insert-char ?\ (max 0 (round (- (window-width)
- (or x (car size))) 2)))
- (insert-image image))
- (setq gnus-simple-splash nil)
- t))))
- (t
+ (unless (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 (gnus-splash-svg-color-symbols (find-image
+ `((:type svg :file "gnus.svg"
+ :color-symbols
+ (("#bf9900" . ,(car gnus-logo-colors))
+ ("#ffcc00" . ,(cadr gnus-logo-colors))))
+ (:type xpm :file "gnus.xpm"
+ :color-symbols
+ (("thing" . ,(car gnus-logo-colors))
+ ("shadow" . ,(cadr gnus-logo-colors))))
+ (:type png :file "gnus.png")
+ (:type pbm :file "gnus.pbm"
+ ;; Account for the pbm's background.
+ :background ,(face-foreground 'gnus-splash)
+ :foreground ,(face-background 'default))
+ (:type xbm :file "gnus.xbm"
+ ;; Account for the xbm's background.
+ :background ,(face-foreground 'gnus-splash)
+ :foreground ,(face-background 'default)))))))
+ (when image
+ (let ((size (image-size image)))
+ (insert-char ?\n (max 0 (round (- (window-height)
+ (or y (cdr size)) 1) 2)))
+ (insert-char ?\ (max 0 (round (- (window-width)
+ (or x (car size))) 2)))
+ (insert-image image))
+ (goto-char (point-min))
+ t)))
(insert
- (format " %s
+ (format "
_ ___ _ _
_ ___ __ ___ __ _ ___
__ _ ___ __ ___
_
__
-"
- ""))
+"))
;; And then hack it.
(gnus-indent-rigidly (point-min) (point-max)
(/ (max (- (window-width) (or x 46)) 0) 2))
(insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
;; Fontify some.
(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))
- (set-buffer-modified-p t))
+ (goto-char (point-min))
+ (setq mode-line-buffer-identification (concat " " gnus-version))
+ (set-buffer-modified-p t)))
+
+(defun gnus-splash-svg-color-symbols (list)
+ "Do color-symbol search-and-replace in svg file."
+ (let ((type (plist-get (cdr list) :type))
+ (file (plist-get (cdr list) :file))
+ (color-symbols (plist-get (cdr list) :color-symbols)))
+ (if (string= type "svg")
+ (let ((data (with-temp-buffer (insert-file-contents file)
+ (buffer-string))))
+ (mapc (lambda (rule)
+ (setq data (replace-regexp-in-string
+ (concat "fill:" (car rule))
+ (concat "fill:" (cdr rule)) data)))
+ color-symbols)
+ (cons (car list) (list :type type :data data)))
+ list)))
(eval-when (load)
(let ((command (format "%s" this-command)))
(defcustom gnus-home-directory "~/"
"Directory variable that specifies the \"home\" directory.
-All other Gnus file and directory variables are initialized from this variable."
+All other Gnus file and directory variables are initialized from this variable.
+
+Note that Gnus is mostly loaded when the `.gnus.el' file is read.
+This means that other directory variables that are initialized
+from this variable won't be set properly if you set this variable
+in `.gnus.el'. Set this variable in `.emacs' instead."
:group 'gnus-files
:type 'directory)
:type '(choice (const :tag "current" nil)
directory))
-;; Site dependent variables. These variables should be defined in
-;; paths.el.
-
-(defvar gnus-default-nntp-server nil
- "Specify a default NNTP server.
-This variable should be defined in paths.el, and should never be set
-by the user.
-If you want to change servers, you should use `gnus-select-method'.
-See the documentation to that variable.")
+;; Site dependent variables.
-;; Don't touch this variable.
-(defvar gnus-nntp-service "nntp"
- "NNTP service name (\"nntp\" or 119).
-This is an obsolete variable, which is scarcely used. If you use an
-nntp server for your newsgroup and want to change the port number
-used to 899, you would say something along these lines:
+;; Should this be obsolete?
+(defcustom gnus-default-nntp-server nil
+ "The hostname of the default NNTP server.
+The empty string, or nil, means to use the local host.
+You may wish to set this on a site-wide basis.
- (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))")
+If you want to change servers, you should use `gnus-select-method'."
+ :group 'gnus-server
+ :type '(choice (const :tag "local host" nil)
+ (string :tag "host name")))
(defcustom gnus-nntpserver-file "/etc/nntpserver"
"A file with only the name of the nntp server in it."
;;;###autoload (custom-autoload 'gnus-select-method "gnus"))
(defcustom gnus-select-method
- (condition-case nil
- (nconc
- (list 'nntp (or (condition-case nil
- (gnus-getenv-nntpserver)
- (error nil))
- (when (and gnus-default-nntp-server
- (not (string= gnus-default-nntp-server "")))
- gnus-default-nntp-server)
- "news"))
- (if (or (null gnus-nntp-service)
- (equal gnus-nntp-service "nntp"))
- nil
- (list gnus-nntp-service)))
- (error nil))
+ (list 'nntp (or (gnus-getenv-nntpserver)
+ (when (and gnus-default-nntp-server
+ (not (string= gnus-default-nntp-server "")))
+ gnus-default-nntp-server)
+ "news"))
"Default method for selecting a newsgroup.
This variable should be a list, where the first element is how the
news is to be fetched, the second is the address.
There is a lot more to know about select methods and virtual servers -
see the manual for details."
+ ;; Emacs has set-after since 22.1.
+ ;set-after '(gnus-default-nntp-server)
:group 'gnus-server
:group 'gnus-start
:initialize 'custom-initialize-default
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
+ :version "23.1"
:group 'gnus-server
:group 'gnus-message
:type 'boolean)
-(defcustom gnus-message-archive-group nil
+(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
However, you may wish to store the message on some other server. In
that case, just return a fully prefixed name of the group --
\"nnml+private:mail.misc\", for instance."
+ :version "24.1"
: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))
non-numeric prefix - `C-u M-x gnus', in short."
:group 'gnus-server
:type '(repeat 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'
-variable instead."
- :group 'gnus-server
- :type '(choice (const :tag "disable" nil)
- string))
+(make-obsolete-variable 'gnus-secondary-servers 'gnus-select-method "24.1")
(defcustom gnus-secondary-select-methods nil
"A list of secondary methods that will be used for reading news.
:group 'gnus-server
:type '(repeat gnus-select-method))
-(defvar gnus-backup-default-subscribed-newsgroups
- '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus")
- "Default default new newsgroups the first time Gnus is run.
-Should be set in paths.el, and shouldn't be touched by the user.")
-
(defcustom gnus-local-domain nil
"Local domain name without a host name.
The DOMAINNAME environment variable is used instead if it is defined.
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.
-Obsolete variable; use `message-user-organization' instead.")
-
;; Customization variables
(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
-nntp method, you might get acceptable results.
-
The value of this variable must be a valid select method as discussed
in the documentation of `gnus-select-method'.
(const current)
(const :tag "Google" (nnweb "refer" (nnweb-type google)))
gnus-select-method
+ sexp
(repeat :menu-tag "Try multiple"
:tag "Multiple"
:value (current (nnweb "refer" (nnweb-type google)))
(nnweb "refer" (nnweb-type google)))
gnus-select-method))))
-(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
integer))
(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.
+ "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.
If this variable is a list, and the list contains the element
will not be used for kill files.
Note that the default for this variable varies according to what system
-type you're using. On `usg-unix-v' and `xenix' this variable defaults
-to nil while on all other systems it defaults to t."
+type you're using. On `usg-unix-v' this variable defaults to nil while
+on all other systems it defaults to t."
:group 'gnus-start
:type '(radio (sexp :format "Non-nil\n"
:match (lambda (widget value)
:type 'boolean)
(defcustom gnus-interactive-exit t
- "*If non-nil, require your confirmation when exiting Gnus."
+ "*If non-nil, require your confirmation when exiting Gnus.
+If `quiet', update any active summary buffers automatically
+first before exiting."
:group 'gnus-exit
- :type 'boolean)
+ :type '(choice boolean
+ (const quiet)))
(defcustom gnus-extract-address-components 'gnus-extract-address-components
"*Function for extracting address components from a From header.
("nnweb" none)
("nnrss" none)
("nnagent" post-mail)
- ("nnimap" post-mail address prompt-address physical-address)
- ("nnmaildir" mail respool address)
+ ("nnimap" post-mail address prompt-address physical-address respool
+ server-marks)
+ ("nnmaildir" mail respool address server-marks)
("nnnil" none))
"*An alist of valid select methods.
The first element of each list lists should be a string with the name
(const :format "%v " mail)
(const :format "%v " none)
(const post-mail))
- (checklist :inline t
+ (checklist :inline t :greedy t
(const :format "%v " address)
(const :format "%v " prompt-address)
(const :format "%v " physical-address)
- (const :format "%v " virtual)
- (const respool))))
+ (const virtual)
+ (const :format "%v " respool)
+ (const server-marks))))
:version "24.1")
(defun gnus-redefine-select-method-widget ()
:function-document
"Whether this group should be ignored by the registry."
:variable gnus-registry-ignored-groups
- :variable-default nil
+ :variable-default (mapcar
+ (lambda (g) (list g t))
+ '("delayed$" "drafts$" "queue$" "INBOX$"
+ "^nnmairix:" "^nnir:" "archive"))
:variable-document
"*Groups in which the registry should be turned off."
:variable-group gnus-registry
(defvar gnus-server-method-cache nil)
(defvar gnus-extended-servers nil)
+;; The carpal mode has been removed, but define the variable for
+;; backwards compatibility.
+(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.")
(scored . score) (saved . save)
(cached . cache) (downloadable . download)
(unsendable . unsend) (forwarded . forward)
- (recent . recent) (seen . seen)))
+ (seen . seen) (unexist . unexist)))
(defconst gnus-article-special-mark-lists
'((seen range)
+ (unexist range)
(killed range)
(bookmark tuple)
(uid tuple)
;; `score' is not a proper mark
;; `bookmark': don't propagated it, or fix the bug in update-mark.
(defconst gnus-article-unpropagated-mark-lists
- '(seen cache download unsend score bookmark)
+ '(seen cache download unsend score bookmark unexist)
"Marks that shouldn't be propagated to back ends.
Typical marks are those that make no sense in a standalone back end,
such as a mark that says whether an article is stored in the cache
(defvar gnus-have-read-active-file nil)
(defconst gnus-maintainer
- "bugs@gnus.org (The Gnus Bugfixing Girls + Boys)"
+ "submit@debbugs.gnu.org (The Gnus Bugfixing Girls + Boys)"
"The mail address of the Gnus maintainers.")
+(defconst gnus-bug-package
+ "gnus"
+ "The package to use in the bug submission.")
+
(defvar gnus-info-nodes
'((gnus-group-mode "(gnus)Group Buffer")
(gnus-summary-mode "(gnus)Summary Buffer")
gnus-newsrc-last-checked-date
gnus-newsrc-alist gnus-server-alist
gnus-killed-list gnus-zombie-list
- gnus-topic-topology gnus-topic-alist
- gnus-format-specs)
+ gnus-topic-topology gnus-topic-alist)
"Gnus variables saved in the quick startup file.")
(defvar gnus-newsrc-alist nil
("gnus-cite" :interactive t
gnus-article-highlight-citation gnus-article-hide-citation-maybe
gnus-article-hide-citation gnus-article-fill-cited-article
- gnus-article-hide-citation-in-followups)
+ gnus-article-hide-citation-in-followups
+ gnus-article-fill-cited-long-lines)
("gnus-kill" gnus-kill gnus-apply-kill-file-internal
gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author
gnus-execute gnus-expunge gnus-batch-kill gnus-batch-score)
+ ("gnus-registry" gnus-try-warping-via-registry
+ gnus-registry-handle-action)
("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers
gnus-cache-possibly-remove-articles gnus-cache-request-article
gnus-cache-retrieve-headers gnus-cache-possibly-alter-active
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)
+ gnus-agent-request-article gnus-agent-retrieve-headers
+ gnus-agent-store-article gnus-agent-group-covered-p)
("gnus-agent" :interactive t
gnus-unplugged gnus-agentize gnus-agent-batch)
("gnus-vm" :interactive t gnus-summary-save-in-vm
It works along the same lines as a normal formatting string,
with some simple extensions.
-%N Article number, left padded with spaces (string)
-%S Subject (string)
-%s Subject if it is at the root of a thread, and \"\" otherwise (string)
-%n Name of the poster (string)
-%a Extracted name of the poster (string)
-%A Extracted address of the poster (string)
-%F Contents of the From: header (string)
-%f Contents of the From: or To: headers (string)
-%x Contents of the Xref: header (string)
-%D Date of the article (string)
-%d Date of the article (string) in DD-MMM format
-%o Date of the article (string) in YYYYMMDD`T'HHMMSS format
-%M Message-id of the article (string)
-%r References of the article (string)
-%c Number of characters in the article (integer)
-%k Pretty-printed version of the above (string)
- For example, \"1.2k\" or \"0.4M\".
-%L Number of lines in the article (integer)
-%I Indentation based on thread level (a string of spaces)
-%B A complex trn-style thread tree (string)
- The variables `gnus-sum-thread-*' can be used for customization.
-%T A string with two possible values: 80 spaces if the article
- is on thread level two or larger and 0 spaces on level one
-%R \"A\" if this article has been replied to, \" \" otherwise (character)
-%U Status of this article (character, \"R\", \"K\", \"-\" or \" \")
-%[ Opening bracket (character, \"[\" or \"<\")
-%] Closing bracket (character, \"]\" or \">\")
-%> Spaces of length thread-level (string)
-%< Spaces of length (- 20 thread-level) (string)
-%i Article score (number)
-%z Article zcore (character)
-%t Number of articles under the current thread (number).
-%e Whether the thread is empty or not (character).
-%V Total thread score (number).
-%P The line number (number).
-%O Download mark (character).
-%* If present, indicates desired cursor position
- (instead of after first colon).
-%u User defined specifier. The next character in the format string should
- be a letter. Gnus will call the function gnus-user-format-function-X,
- where X is the letter following %u. The function will be passed the
- current header as argument. The function should return a string, which
- will be inserted into the summary just like information from any other
- summary specifier.
+%N Article number, left padded with spaces (string)
+%S Subject (string)
+%s Subject if it is at the root of a thread, and \"\"
+ otherwise (string)
+%n Name of the poster (string)
+%a Extracted name of the poster (string)
+%A Extracted address of the poster (string)
+%F Contents of the From: header (string)
+%f Contents of the From: or To: headers (string)
+%x Contents of the Xref: header (string)
+%D Date of the article (string)
+%d Date of the article (string) in DD-MMM format
+%o Date of the article (string) in YYYYMMDD`T'HHMMSS
+ format
+%M Message-id of the article (string)
+%r References of the article (string)
+%c Number of characters in the article (integer)
+%k Pretty-printed version of the above (string)
+ For example, \"1.2k\" or \"0.4M\".
+%L Number of lines in the article (integer)
+%I Indentation based on thread level (a string of
+ spaces)
+%B A complex trn-style thread tree (string)
+ The variables `gnus-sum-thread-*' can be used for
+ customization.
+%T A string with two possible values: 80 spaces if the
+ article is on thread level two or larger and 0 spaces
+ on level one
+%R \"A\" if this article has been replied to, \" \"
+ otherwise (character)
+%U \"Read\" status of this article.
+ See Info node `(gnus)Marking Articles'
+%[ Opening bracket (character, \"[\" or \"<\")
+%] Closing bracket (character, \"]\" or \">\")
+%> Spaces of length thread-level (string)
+%< Spaces of length (- 20 thread-level) (string)
+%i Article score (number)
+%z Article zcore (character)
+%t Number of articles under the current thread (number).
+%e Whether the thread is empty or not (character).
+%V Total thread score (number).
+%P The line number (number).
+%O Download mark (character).
+%* If present, indicates desired cursor position
+ (instead of after first colon).
+%u User defined specifier. The next character in the
+ format string should be a letter. Gnus will call the
+ function gnus-user-format-function-X, where X is the
+ letter following %u. The function will be passed the
+ current header as argument. The function should
+ return a string, which will be inserted into the
+ summary just like information from any other summary
+ specifier.
+&user-date; Age sensitive date format. Various date format is
+ defined in `gnus-summary-user-date-format-alist'.
+
The %U (status), %R (replied) and %z (zcore) specs have to be handled
with care. For reasons of efficiency, Gnus will compute what column
(defmacro gnus-get-info (group)
`(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb)))
+(defun gnus-set-info (group info)
+ (setcar (nthcdr 2 (gnus-gethash group gnus-newsrc-hashtb))
+ info))
+
;;; Load the compatibility functions.
(require 'gnus-ems)
((= c ?d)
(point))
((= c ?D)
- (read-file-name prompt nil default-directory 'lambda))
+ (read-directory-name prompt nil default-directory 'lambda))
((= c ?f)
(read-file-name prompt nil nil 'lambda))
((= c ?F)
(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.
-;; Returns a list of writable groups.
-(defun gnus-writable-groups ()
- (let ((alist gnus-newsrc-alist)
- groups group)
- (while (setq group (car (pop alist)))
- (unless (gnus-group-read-only-p group)
- (push group groups)))
- (nreverse groups)))
-
;; Check whether to use long file names.
(defun gnus-use-long-file-name (symbol)
;; The variable has to be set...
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.
+ ;; Check parameters for sloppy equality.
(let ((p1 (copy-sequence (cddr m1)))
(p2 (copy-sequence (cddr m2)))
e1 e2)
;; If p2 now is empty, they were equal.
(null p2))))
+(defun gnus-method-ephemeral-p (method)
+ (let ((equal nil))
+ (dolist (ephemeral gnus-ephemeral-servers)
+ (when (gnus-sloppily-equal-method-parameters method ephemeral)
+ (setq equal t)))
+ equal))
+
+(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))))
+
(defun gnus-server-equal (m1 m2)
"Say whether two methods are equal."
(let ((m1 (cond ((null m1) gnus-select-method)
group
(concat (gnus-method-to-server-name method) ":" group)))
-(defun gnus-group-guess-prefixed-name (group)
- "Guess the whole name from GROUP and METHOD."
- (gnus-group-prefixed-name group (gnus-find-method-for-group
- group)))
-
(defun gnus-group-full-name (group method)
"Return the full name from GROUP and METHOD, even if the method is native."
(gnus-group-prefixed-name group method t))
-(defun gnus-group-guess-full-name (group)
- "Guess the full name from GROUP, even if the method is native."
- (if (gnus-group-prefixed-p group)
- group
- (gnus-group-full-name group (gnus-find-method-for-group group))))
-
(defun gnus-group-guess-full-name-from-command-method (group)
"Guess the full name from GROUP, even if the method is native."
(if (gnus-group-prefixed-p group)
(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."
;; The car is regexp matching for matching the group name.
(when (string-match (car head) group)
;; The cdr is the parameters.
- (setq result (gnus-group-parameter-value (cdr head)
- symbol allow-list))
- (when result
- ;; Expand if necessary.
- (if (and (stringp result) (string-match "\\\\[0-9&]" result))
- (setq result (gnus-expand-group-parameter (car head)
- result group))))))
+ (let ((this-result
+ (gnus-group-parameter-value (cdr head) symbol allow-list t)))
+ (when this-result
+ (setq result (car this-result))
+ ;; Expand if necessary.
+ (if (and (stringp result) (string-match "\\\\[0-9&]" result))
+ (setq result (gnus-expand-group-parameter
+ (car head) result group)))))))
;; Done.
result))))
If you call this function inside a loop, consider using the faster
`gnus-group-fast-parameter' instead."
- (with-current-buffer gnus-group-buffer
+ (with-current-buffer (if (buffer-live-p (get-buffer gnus-group-buffer))
+ gnus-group-buffer
+ (current-buffer))
(if symbol
(gnus-group-fast-parameter group symbol allow-list)
(nconc
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)
(if (or (not (inline (gnus-similar-server-opened method)))
(not (cddr method)))
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))
+ (let ((address-slot
+ (intern (format "%s-address" (car method)))))
+ (setq method
+ (if (assq address-slot (cddr method))
+ `(,(car method) ,(concat (cadr method) "+" group)
+ ,@(cddr method))
+ `(,(car method) ,(concat (cadr method) "+" group)
+ (,address-slot ,(cadr method))
+ ,@(cddr method))))
+ (push method gnus-extended-servers)
+ method)))
(defun gnus-server-status (method)
"Return the status of METHOD."
(switch-to-buffer gnus-group-buffer)
(funcall gnus-other-frame-function arg)
(add-hook 'gnus-exit-gnus-hook
- '(lambda nil
- (when (and (frame-live-p gnus-other-frame-object)
- (cdr (frame-list)))
- (delete-frame gnus-other-frame-object))
- (setq gnus-other-frame-object nil)))))))
+ (lambda nil
+ (when (and (frame-live-p gnus-other-frame-object)
+ (cdr (frame-list)))
+ (delete-frame gnus-other-frame-object))
+ (setq gnus-other-frame-object nil)))))))
;;;###autoload
(defun gnus (&optional arg dont-connect slave)
(gnus-1 arg dont-connect slave)
(gnus-final-warning)))
+(eval-and-compile
+ (unless (fboundp 'debbugs-gnu)
+ (autoload 'debbugs-gnu "debbugs-gnu" "List all outstanding Emacs bugs." t)))
+(defun gnus-list-debbugs ()
+ "List all open Gnus bug reports."
+ (interactive)
+ (debbugs-gnu nil "gnus"))
+
;; Allow redefinition of Gnus functions.
(gnus-ems-redefine)