;; 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.
(eval '(run-hooks 'gnus-load-hook))
+(eval-when-compile (require 'cl))
+
(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")
:link '(custom-manual "(gnus)Various Summary Stuff")
:group 'gnus-summary)
-;; Belongs to to gnus-uu.el
+(defgroup gnus-summary-pick nil
+ "Pick mode in the summary buffer."
+ :link '(custom-manual "(gnus)Pick and Read")
+ :prefix "gnus-pick-"
+ :group 'gnus-summary)
+
+(defgroup gnus-summary-tree nil
+ "Tree display of threads in the summary buffer."
+ :link '(custom-manual "(gnus)Tree Display")
+ :prefix "gnus-tree-"
+ :group 'gnus-summary)
+
+;; Belongs to gnus-uu.el
(defgroup gnus-extract-view nil
"Viewing extracted files."
:link '(custom-manual "(gnus)Viewing Files")
:group 'gnus-extract)
-;; Other
+;; Belongs to gnus-score.el
(defgroup gnus-score nil
"Score and kill file handling."
- :group 'gnus )
+ :group 'gnus)
-(defgroup gnus-exit nil
- "Exiting gnus."
- :link '(custom-manual "(gnus)Exiting Gnus")
+(defgroup gnus-score-kill nil
+ "Kill files."
+ :group 'gnus-score)
+
+(defgroup gnus-score-adapt nil
+ "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
+ :group 'gnus-files)
+
+(defgroup gnus-score-various nil
+ "Various scoring and killing options."
+ :group 'gnus-score)
+
+;; Other
+(defgroup gnus-visual nil
+ "Options controling the visual fluff."
+ :group 'gnus
+ :group 'faces)
+
+(defgroup gnus-agent nil
+ "Offline support for Gnus."
+ :group 'gnus)
+
+(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)
+
+(defgroup gnus-message '((message custom-group))
+ "Composing replies and followups in Gnus."
+ :group 'gnus)
+
+(defgroup gnus-meta nil
+ "Meta variables controling major portions of Gnus.
+In general, modifying these variables does not take affect until Gnus
+is restarted, and sometimes reloaded."
:group 'gnus)
(defgroup gnus-various nil
:link '(custom-manual "(gnus)Various Various")
:group 'gnus)
-(defconst gnus-version-number "5.4.5"
+(defgroup gnus-exit nil
+ "Exiting gnus."
+ :link '(custom-manual "(gnus)Exiting Gnus")
+ :group 'gnus)
+
+(defconst gnus-version-number "0.12"
"Version number for this version of Gnus.")
-(defconst gnus-version (format "Gnus v%s" gnus-version-number)
+(defconst gnus-version (format "Quassia Gnus v%s" gnus-version-number)
"Version string for this version of Gnus.")
(defcustom gnus-inhibit-startup-message nil
(defalias 'gnus-extent-start-open 'ignore)
(defalias 'gnus-set-text-properties 'set-text-properties)
(defalias 'gnus-group-remove-excess-properties 'ignore)
- (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)
(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))
-;; The XEmacs people think this is evil, so it must go.
-(defun custom-face-lookup (&optional fg bg stipple bold italic underline)
- "Lookup or create a face with specified attributes."
- (let ((name (intern (format "custom-face-%s-%s-%s-%S-%S-%S"
- (or fg "default")
- (or bg "default")
- (or stipple "default")
- bold italic underline))))
- (if (and (custom-facep name)
- (fboundp 'make-face))
- ()
- (copy-face 'default name)
- (when (and fg
- (not (string-equal fg "default")))
- (ignore-errors
- (set-face-foreground name fg)))
- (when (and bg
- (not (string-equal bg "default")))
- (ignore-errors
- (set-face-background name bg)))
- (when (and stipple
- (not (string-equal stipple "default"))
- (not (eq stipple 'custom:asis))
- (fboundp 'set-face-stipple))
- (set-face-stipple name stipple))
- (when (and bold
- (not (eq bold 'custom:asis)))
- (ignore-errors
- (make-face-bold name)))
- (when (and italic
- (not (eq italic 'custom:asis)))
- (ignore-errors
- (make-face-italic name)))
- (when (and underline
- (not (eq underline 'custom:asis)))
- (ignore-errors
- (set-face-underline-p name t))))
- name))
-
;; 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"))
+ (:foreground "ForestGreen"))
(((class color)
(background light))
- (:foreground "red"))
+ (:foreground "ForestGreen"))
(t
()))
"Level 1 newsgroup face.")
(defun gnus-splash ()
(save-excursion
- (switch-to-buffer gnus-group-buffer)
+ (switch-to-buffer (get-buffer-create gnus-group-buffer))
(let ((buffer-read-only nil))
(erase-buffer)
(unless gnus-inhibit-startup-message
(save-excursion
(save-restriction
(narrow-to-region start end)
- (indent-rigidly start end arg)
- ;; We translate tabs into spaces -- not everybody uses
- ;; an 8-character tab.
- (goto-char (point-min))
- (while (search-forward "\t" nil t)
- (replace-match " " t t)))))
+ (let ((tab-width 8))
+ (indent-rigidly start end arg)
+ ;; We translate tabs into spaces -- not everybody uses
+ ;; an 8-character tab.
+ (goto-char (point-min))
+ (while (search-forward "\t" nil t)
+ (replace-match " " t t))))))
(defvar gnus-simple-splash nil)
(require 'gnus-util)
(require 'nnheader)
-(defgroup gnus-meta nil
- "Meta variables controling major portions of Gnus.
-In general, modifying these variables does not take affect until Gnus
-is restarted, and sometimes reloaded."
- :group 'gnus)
+(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") "~/News/")
+(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-meta
+ :group 'gnus-files
:type 'directory)
(defcustom gnus-default-directory nil
"*Default directory for all Gnus buffers."
- :group 'gnus-start
+ :group 'gnus-files
:type '(choice (const :tag "current" nil)
directory))
(defcustom gnus-nntpserver-file "/etc/nntpserver"
"A file with only the name of the nntp server in it."
- :group 'gnus-start
+ :group 'gnus-files
+ :group 'gnus-server
:type 'file)
;; This function is used to check both the environment variable
(kill-buffer (current-buffer))))))))
(defcustom gnus-select-method
- (ignore-errors
+ (condition-case nil
(nconc
- (list 'nntp (or (ignore-errors
- (gnus-getenv-nntpserver))
+ (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)
- (system-name)))
+ "news"))
(if (or (null gnus-nntp-service)
(equal gnus-nntp-service "nntp"))
nil
- (list gnus-nntp-service))))
+ (list gnus-nntp-service)))
+ (error nil))
"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."
- :group 'gnus-start
+ :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))
It's probably not a very effective to change this variable once you've
run Gnus once. After doing that, you must edit this server from the
server buffer."
- :group 'gnus-start
+ :group 'gnus-server
+ :group 'gnus-message
:type 'gnus-select-method)
-(defgroup gnus-message '((message custom-group))
- "Interface from gnus to message mode."
- :group 'gnus)
-
(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
"List of NNTP servers that the user can choose between interactively.
To make Gnus query you for a server, you have to give `gnus' a
non-numeric prefix - `C-u M-x gnus', in short."
- :group 'gnus-start
+ :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-start
+ :group 'gnus-server
:type '(choice (const :tag "disable" nil)
string))
you could set this variable:
\(setq gnus-secondary-select-methods '((nnml \"\")))"
-:group 'gnus-start
+:group 'gnus-server
:type '(repeat gnus-select-method))
(defvar gnus-backup-default-subscribed-newsgroups
The DOMAINNAME environment variable is used instead if it is defined.
If the `system-name' function returns the full Internet name, there is
no need to set this variable."
- :group 'gnus-start
+ :group 'gnus-message
: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-start
- :type '(choice (const :tag "default" nil)
- string))
+Obsolete variable; use `message-user-organization' instead.")
;; Customization variables
The value of this variable must be a valid select method as discussed
in the documentation of `gnus-select-method'."
- :group 'gnus-start
+ :group 'gnus-server
:type '(choice (const :tag "default" nil)
gnus-select-method))
If nil, ignore cross references. If t, mark articles as read in
subscribed newsgroups. If neither t nor nil, mark as read in all
newsgroups."
- :group 'gnus-start
+ :group 'gnus-server
:type '(choice (const :tag "off" nil)
(const :tag "subscribed" t)
(sexp :format "all"
(defcustom gnus-process-mark ?#
"*Process mark."
- :group 'gnus-start
+ :group 'gnus-group-visual
+ :group 'gnus-summary-marks
:type 'character)
(defcustom gnus-asynchronous nil
"*If non-nil, Gnus will supply backends with data needed for async article fetching."
- :group 'gnus-start
+ :group 'gnus-asynchronous
:type 'boolean)
(defcustom gnus-large-newsgroup 200
(defcustom gnus-kill-files-directory gnus-directory
"*Name of the directory where kill files will be stored (default \"~/News\")."
- :group 'gnus-score
+ :group 'gnus-score-files
+ :group 'gnus-score-kill
:type 'directory)
(defcustom gnus-save-score nil
"*If non-nil, save group scoring info."
- :group 'gnus-score
+ :group 'gnus-score-various
:group 'gnus-start
:type 'boolean)
former will perform adaption on individual words in the subject
header while `line' will perform adaption on several headers."
:group 'gnus-meta
+ :group 'gnus-score-adapt
:type '(set (const word) (const line)))
(defcustom gnus-use-cache 'passive
: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."
which is the default, quite fast, and too simplistic solution, and
`mail-extract-address-components', which works much better, but is
slower."
- :group 'gnus-start
+ :group 'gnus-summary-format
:type '(radio (function-item gnus-extract-address-components)
(function-item mail-extract-address-components)
(function :tag "Other")))
(defcustom gnus-shell-command-separator ";"
"String used to separate to shell commands."
- :group 'gnus-start
+ :group 'gnus-files
:type 'string)
(defcustom gnus-valid-select-methods
("nndraft" post-mail)
("nnfolder" mail respool address)
("nngateway" none address prompt-address physical-address)
- ("nnweb" none))
+ ("nnweb" none)
+ ("nnagent" post-mail))
"An alist of valid select methods.
The first element of each list lists should be a string with the name
of the select method. The other elements may be the category of
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."
- :group 'gnus-start
+ :group 'gnus-server
:type '(repeat (group (string :tag "Name")
(radio-button-choice (const :format "%v " post)
(const :format "%v " mail)
(checklist :inline t
(const :format "%v " address)
(const :format "%v " prompt-address)
+ (const :format "%v " physical-address)
(const :format "%v " virtual)
(const respool)))))
(string :tag "Address")
(editable-list :inline t
(list :format "%v"
- variable
+ variable
(sexp :tag "Value")))))
(defcustom gnus-updated-mode-lines '(group article summary tree)
`summary'. If the corresponding symbol is present, Gnus will keep
that mode line updated with information that may be pertinent.
If this variable is nil, screen refresh may be quicker."
- :group 'gnus-start
+ :group 'gnus-various
:type '(set (const group)
(const article)
(const summary)
(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."
- :group 'gnus-start
+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
+ :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
+ :group 'nnmail-expire
:type '(choice (const nil)
regexp))
(cond ((string-match \"control\" gnus-newsgroup-name)
(gnus-kill \"Subject\" \"rmgroup\")
(gnus-expunge \"X\"))))))"
- :group 'gnus-score
+ :group 'gnus-score-kill
:options '(gnus-apply-kill-file)
:type 'hook)
(defcustom gnus-group-change-level-function nil
"Function run when a group level is changed.
It is called with three parameters -- GROUP, LEVEL and OLDLEVEL."
- :group 'gnus-start
+ :group 'gnus-group-level
:type 'function)
;;; Face thingies.
-(defgroup gnus-visual nil
- "Options controling the visual fluff."
- :group 'gnus)
-
-(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
"Enable visual features.
If `visual' is disabled, there will be no menus and few faces. Most of
the visual customization options below will be ignored. Gnus will use
-less space and be faster as a result."
+less space and be faster as a result.
+
+This variable can also be a list of visual elements to switch on. For
+instance, to switch off all visual things except menus, you can say:
+
+ (setq gnus-visual '(menu))
+
+Valid elements include `summary-highlight', `group-highlight',
+`article-highlight', `mouse-face', `summary-menu', `group-menu',
+`article-menu', `tree-highlight', `menu', `highlight', `browse-menu',
+`server-menu', `page-marker', `tree-menu', `binary-menu', `pick-menu',
+and `grouplens-menu'."
:group 'gnus-meta
:group 'gnus-visual
:type '(set (const summary-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)
+
+(defvar gnus-plugged t
+ "Whether Gnus is plugged or not.")
\f
;;; Internal variables
(defvar gnus-original-article-buffer " *Original Article*")
(defvar gnus-newsgroup-name nil)
+(defvar gnus-agent nil
+ "Whether we want to use the Gnus agent or not.")
+
+(defvar gnus-command-method nil
+ "Dynamically bound variable that says what the current backend is.")
+
(defvar gnus-current-select-method nil
"The current method for selecting a newsgroup.")
(expirable . expire) (killed . killed)
(bookmarks . bookmark) (dormant . dormant)
(scored . score) (saved . save)
- (cached . cache)))
+ (cached . cache) (downloadable . download)
+ (unsendable . unsend)))
(defvar gnus-headers-retrieved-by nil)
(defvar gnus-article-reply nil)
(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-tree-open gnus-tree-close gnus-carpal-setup-buffer)
("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close
gnus-nocem-unwanted-article-p)
- ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info)
+ ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info
+ gnus-server-server-name)
("gnus-srvr" gnus-browse-foreign-server)
("gnus-cite" :interactive t
gnus-article-highlight-citation gnus-article-hide-citation-maybe
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-hack-decode-rfc1522)
("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)
("gnus-async" gnus-async-request-fetched-article gnus-async-prefetch-next
gnus-async-prefetch-article gnus-async-prefetch-remove-group
gnus-async-halt-prefetch)
+ ("gnus-agent" gnus-open-agent gnus-agent-get-function
+ gnus-agent-save-groups gnus-agent-save-active gnus-agent-method-p
+ gnus-agent-get-undownloaded-list)
+ ("gnus-agent" :interactive t
+ gnus-unplugged gnus-agentize)
("gnus-vm" :interactive t gnus-summary-save-in-vm
- gnus-summary-save-article-vm))))
+ gnus-summary-save-article-vm)
+ ("gnus-draft" :interactive t gnus-draft-mode gnus-group-send-drafts))))
;;; gnus-sum.el thingies
%l GroupLens score (string).
%V Total thread score (number).
%P The line number (number).
+%O Download mark (character).
%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
(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))))
-(defvar gnus-article-mode-map (make-keymap))
-(gnus-suppress-keymap gnus-article-mode-map)
-(defvar gnus-summary-mode-map (make-keymap))
-(gnus-suppress-keymap gnus-summary-mode-map)
-(defvar gnus-group-mode-map (make-keymap))
-(gnus-suppress-keymap gnus-group-mode-map)
+(defvar gnus-article-mode-map
+ (let ((keymap (make-keymap)))
+ (gnus-suppress-keymap keymap)
+ keymap))
+(defvar gnus-summary-mode-map
+ (let ((keymap (make-keymap)))
+ (gnus-suppress-keymap keymap)
+ keymap))
+(defvar gnus-group-mode-map
+ (let ((keymap (make-keymap)))
+ (gnus-suppress-keymap keymap)
+ keymap))
\f
;;; Gnus Utility Functions
;;;
+(defmacro gnus-string-or (&rest strings)
+ "Return the first element of STRINGS that is a non-blank string.
+STRINGS will be evaluated in normal `or' order."
+ `(gnus-string-or-1 ',strings))
+
+(defun gnus-string-or-1 (strings)
+ (let (string)
+ (while strings
+ (setq string (eval (pop strings)))
+ (if (string-match "^[ \t]*$" string)
+ (setq string nil)
+ (setq strings nil)))
+ string))
+
;; Add the current buffer to the list of buffers to be killed on exit.
(defun gnus-add-current-to-buffer-list ()
(or (memq (current-buffer) gnus-buffer-list)
(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"))
(setq gnus-info-buffer (current-buffer))
(gnus-configure-windows 'info)))
+;;;
+;;; gnus-interactive
+;;;
+
+(defvar gnus-current-prefix-symbol nil
+ "Current prefix symbol.")
+
+(defvar gnus-current-prefix-symbols nil
+ "List of current prefix symbols.")
+
+(defun gnus-interactive (string &optional params)
+ "Return a list that can be fed to `interactive'.
+See `interactive' for full documentation.
+
+Adds the following specs:
+
+y -- The current symbolic prefix.
+Y -- A list of the current symbolic prefix(es).
+A -- Article number.
+H -- Article header.
+g -- Group name."
+ (let ((i 0)
+ out c prompt)
+ (while (< i (length string))
+ (string-match ".\\([^\n]*\\)\n?" string i)
+ (setq c (aref string i))
+ (when (match-end 1)
+ (setq prompt (match-string 1 string)))
+ (setq i (match-end 0))
+ ;; We basically emulate just about everything that
+ ;; `interactive' does, but adds the "g" and "G" specs.
+ (push
+ (cond
+ ((= c ?a)
+ (completing-read prompt obarray 'fboundp t))
+ ((= c ?b)
+ (read-buffer prompt (current-buffer) t))
+ ((= c ?B)
+ (read-buffer prompt (other-buffer (current-buffer))))
+ ((= c ?c)
+ (read-char))
+ ((= c ?C)
+ (completing-read prompt obarray 'commandp t))
+ ((= c ?d)
+ (point))
+ ((= c ?D)
+ (read-file-name prompt nil default-directory 'lambda))
+ ((= c ?f)
+ (read-file-name prompt nil nil 'lambda))
+ ((= c ?F)
+ (read-file-name prompt))
+ ((= c ?k)
+ (read-key-sequence prompt))
+ ((= c ?K)
+ (error "Not implemented spec"))
+ ((= c ?e)
+ (error "Not implemented spec"))
+ ((= c ?m)
+ (mark))
+ ((= c ?N)
+ (error "Not implemented spec"))
+ ((= c ?n)
+ (string-to-number (read-from-minibuffer prompt)))
+ ((= c ?p)
+ (prefix-numeric-value current-prefix-arg))
+ ((= c ?P)
+ current-prefix-arg)
+ ((= c ?r)
+ 'gnus-prefix-nil)
+ ((= c ?s)
+ (read-string prompt))
+ ((= c ?S)
+ (intern (read-string prompt)))
+ ((= c ?v)
+ (read-variable prompt))
+ ((= c ?x)
+ (read-minibuffer prompt))
+ ((= c ?x)
+ (eval-minibuffer prompt))
+ ;; And here the new specs come.
+ ((= c ?y)
+ gnus-current-prefix-symbol)
+ ((= c ?Y)
+ gnus-current-prefix-symbols)
+ ((= c ?g)
+ (gnus-group-group-name))
+ ((= c ?A)
+ (gnus-summary-article-number))
+ ((= c ?H)
+ (gnus-summary-article-header))
+ (t
+ (error "Not implemented spec")))
+ out)
+ (cond
+ ((= c ?r)
+ (push (if (< (point) (mark) (point) (mark))) out)
+ (push (if (> (point) (mark) (point) (mark))) out))))
+ (setq out (delq 'gnus-prefix-nil out))
+ (nreverse out)))
+
+(defun gnus-symbolic-argument (&optional arg)
+ "Read a symbolic argument and a command, and then execute command."
+ (interactive "P")
+ (let* ((in-command (this-command-keys))
+ (command in-command)
+ gnus-current-prefix-symbols
+ gnus-current-prefix-symbol
+ syms)
+ (while (equal in-command command)
+ (message "%s-" (key-description (this-command-keys)))
+ (push (intern (char-to-string (read-char))) syms)
+ (setq command (read-key-sequence nil t)))
+ (setq gnus-current-prefix-symbols (nreverse syms)
+ gnus-current-prefix-symbol (car gnus-current-prefix-symbols))
+ (call-interactively (key-binding command t))))
+
;;; More various functions.
+(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
+ (let ((method (if (stringp group)
+ (car (gnus-find-method-for-group group))
+ group)))
+ (unless (featurep method)
+ (require method))
+ (fboundp (intern (format "%s-%s" method func))))))
+
(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
(string-match gnus-total-expirable-newsgroups group)))))
(defun gnus-group-auto-expirable-p (group)
- "Check whether GROUP is total-expirable or not."
+ "Check whether GROUP is auto-expirable or not."
(let ((params (gnus-group-find-parameter group))
val)
(cond
(defun gnus-simplify-mode-line ()
"Make mode lines a bit simpler."
- (setq mode-line-modified "-- ")
+ (setq mode-line-modified (cdr gnus-mode-line-modified))
(when (listp mode-line-format)
(make-local-variable 'mode-line-format)
(setq mode-line-format (copy-sequence mode-line-format))
(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)
(setq methods (cdr methods)))
methods))
+(defun gnus-groups-from-server (server)
+ "Return a list of all groups that are fetched from SERVER."
+ (let ((alist (cdr gnus-newsrc-alist))
+ info groups)
+ (while (setq info (pop alist))
+ (when (gnus-server-equal (gnus-info-method info) server)
+ (push (gnus-info-group info) groups)))
+ (sort groups 'string<)))
+
(defun gnus-group-foreign-p (group)
"Say whether a group is foreign or not."
(and (not (gnus-group-native-p group))
(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.
(defcustom gnus-kill-file-name "KILL"
"Suffix of the kill files."
- :group 'gnus-score
+ :group 'gnus-score-kill
+ :group 'gnus-score-files
:type 'string)
(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)
- "Check whether GROUP supports function FUNC.
-GROUP can either be a string (a group name) or a select method."
- (ignore-errors
- (let ((method (if (stringp group)
- (car (gnus-find-method-for-group group))
- group)))
- (unless (featurep method)
- (require method))
- (fboundp (intern (format "%s-%s" method func))))))
-
(defun gnus-methods-using (feature)
"Find all methods that have FEATURE."
(let ((valids gnus-valid-select-methods)
(setq valids (cdr valids)))
outs))
-(defun gnus-read-group (prompt)
+(defun gnus-read-group (prompt &optional default)
"Prompt the user for a group name.
Disallow illegal group names."
(let ((prefix "")
(when (string-match
"[: `'\"/]\\|^$"
(setq group (read-string (concat prefix prompt)
- "" 'gnus-group-history)))
+ (cons (or default "") 0)
+ 'gnus-group-history)))
(setq prefix (format "Illegal group name: \"%s\". " group)
group nil)))
group))
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)