;;; gnus-cus.el --- customization commands for Gnus
-;;
-;; Copyright (C) 1996, 1999, 2000, 2001, 2002, 2003
-;; Free Software Foundation, Inc.
+
+;; Copyright (C) 1996, 1999, 2000, 2001, 2002, 2003, 2004,
+;; 2005 Free Software Foundation, Inc.
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: news
;; 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., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Widgets:
+(defvar gnus-custom-map
+ (let ((map (make-keymap)))
+ (set-keymap-parent map widget-keymap)
+ (suppress-keymap map)
+ (define-key map [mouse-1] 'widget-move-and-invoke)
+ map)
+ "Keymap for editing Gnus customization buffers.")
+
(defun gnus-custom-mode ()
"Major mode for editing Gnus customization buffers.
(kill-all-local-variables)
(setq major-mode 'gnus-custom-mode
mode-name "Gnus Customize")
- (use-local-map widget-keymap)
+ (use-local-map gnus-custom-map)
;; Emacs 21 stuff:
(when (and (facep 'custom-button-face)
(facep 'custom-button-pressed-face))
(set (make-local-variable 'widget-push-button-suffix) "")
(set (make-local-variable 'widget-link-prefix) "")
(set (make-local-variable 'widget-link-suffix) ""))
- (gnus-run-hooks 'gnus-custom-mode-hook))
+ (gnus-run-mode-hooks 'gnus-custom-mode-hook))
;;; Group Customization:
An arbitrary comment on the group.")
(visible (const :tag "Permanently visible" t) "\
-Always display this group, even when there are no unread articles
-in it..")
+Always display this group, even when there are no unread articles in it.")
(highlight-words
(choice :tag "Highlight words"
gnus-agent-cat-days-until-old)
(agent-enable-expiration
(radio :tag "Expire in this Group or Topic" :value nil
-; (const :format "Inherit " nil)
(const :format "Enable " ENABLE)
(const :format "Disable " DISABLE))
"\nEnable, or disable, agent expiration in this group or topic."
- gnus-agent-cat-enable-expiration) )
+ gnus-agent-cat-enable-expiration)
+ (agent-enable-undownloaded-faces
+ (boolean :tag "Enable Agent Faces")
+ "Have the summary buffer use the agent's undownloaded faces.
+These faces, when enabled, act as a warning that an article has not
+been fetched into either the agent nor the cache. This is of most use
+to users who use the agent as a cache (i.e. they only operate on
+articles that have been downloaded). Leave disabled to display normal
+article faces even when the article hasn't been downloaded."
+gnus-agent-cat-enable-undownloaded-faces))
"Alist of group parameters that are not also topic parameters.
-Each entry has the form (NAME TYPE DOC), where NAME is the parameter
-itself (a symbol), TYPE is the parameters type (a sexp widget), and
-DOC is a documentation string for the parameter."))
+Each entry has the form (NAME TYPE DOC ACCESSOR), where NAME is the
+parameter itself (a symbol), TYPE is the parameters type (a sexp
+widget), DOC is a documentation string for the parameter, and ACCESSOR
+is a function (symbol) that extracts the current value from the
+category."))
(defvar gnus-custom-params)
(defvar gnus-custom-method)
(widget-create 'sexp
:tag "Method"
:value (gnus-info-method info))))
- (use-local-map widget-keymap)
+ (use-local-map gnus-custom-map)
(widget-setup)
(buffer-enable-undo)
(goto-char (point-min))))
This can be changed using the `\\[gnus-score-change-score-file]' command."
(interactive (list gnus-current-score-file))
(unless file
- (error (format "No score file for %s"
- (gnus-group-decoded-name gnus-newsgroup-name))))
+ (error "No score file for %s"
+ (gnus-group-decoded-name gnus-newsgroup-name)))
(let ((scores (gnus-score-load file))
(types (mapcar (lambda (entry)
`(group :format "%v%h\n"
'(repeat :inline t
:tag "Unknown entries"
sexp)))
- (use-local-map widget-keymap)
+ (use-local-map gnus-custom-map)
(widget-setup)))
(defun gnus-score-customize-done (&rest ignore)
(eval-when-compile
(defvar category-fields nil)
- (defvar gnus-agent-cat-predicate nil)
- (defvar gnus-agent-cat-score-file nil)
- (defvar gnus-agent-cat-length-when-short nil)
- (defvar gnus-agent-cat-length-when-long nil)
- (defvar gnus-agent-cat-low-score nil)
- (defvar gnus-agent-cat-high-score nil)
- (defvar gnus-agent-cat-groups nil)
- (defvar gnus-agent-cat-enable-expiration nil)
- (defvar gnus-agent-cat-days-until-old nil)
- (defvar gnus-agent-cat-name nil)
+ (defvar gnus-agent-cat-name)
+ (defvar gnus-agent-cat-score-file)
+ (defvar gnus-agent-cat-length-when-short)
+ (defvar gnus-agent-cat-length-when-long)
+ (defvar gnus-agent-cat-low-score)
+ (defvar gnus-agent-cat-high-score)
+ (defvar gnus-agent-cat-enable-expiration)
+ (defvar gnus-agent-cat-days-until-old)
+ (defvar gnus-agent-cat-predicate)
+ (defvar gnus-agent-cat-groups)
+ (defvar gnus-agent-cat-enable-undownloaded-faces)
)
(defun gnus-trim-whitespace (s)
(val (,field info))
(deflt (if (,field defaults)
(concat " [" (gnus-trim-whitespace
- (pp-to-string (,field defaults))) "]"))))
+ (gnus-pp-to-string (,field defaults)))
+ "]")))
+ symb)
(if (eq (car type) 'radio)
(let* ((rtype (nreverse type))
(if deflt
(let ((tag (cdr (memq :tag type))))
- (if (string-match "\n" deflt)
- (progn (while (progn (setq deflt (replace-match "\n " t t
- deflt))
- (string-match "\n" deflt (match-end 0))))
- (setq deflt (concat "\n" deflt))))
+ (when (string-match "\n" deflt)
+ (while (progn (setq deflt (replace-match "\n " t t
+ deflt))
+ (string-match "\n" deflt (match-end 0))))
+ (setq deflt (concat "\n" deflt)))
(setcar tag (concat (car tag) deflt))))
(widget-insert "\n")
- (set (make-local-variable ',field)
- (if val
- (widget-create type :value val)
- (widget-create type)))
- (widget-put ,field :default val)
- (widget-put ,field :accessor ',field)
- (push ,field category-fields))))
+ (setq val (if val
+ (widget-create type :value val)
+ (widget-create type))
+ symb (set (make-local-variable ',field) val))
+
+ (widget-put symb :default val)
+ (widget-put symb :accessor ',field)
+ (push symb category-fields))))
(defun gnus-agent-customize-category (category)
"Edit the CATEGORY."
(widgets category-fields))
(while widgets
(let* ((widget (pop widgets))
- (value (ignore-errors (widget-value widget))))
+ (value (condition-case nil (widget-value widget) (error))))
(eval `(setf (,(widget-get widget :accessor) ',info)
',value)))))
(gnus-category-write)
;; gnus-agent-cat-prepare-category-field as I don't want the
;; group list to appear when customizing a topic.
(widget-insert "\n")
- (set (make-local-variable 'gnus-agent-cat-groups)
- (widget-create
- `(choice
- :format "%[Select Member Groups%]\n%v" :value ignore
- (const :menu-tag "do not change" :tag "" :value ignore)
- (checklist :entry-format "%b %v"
- :menu-tag "display group selectors"
- :greedy t
- :value ,(delq nil
- (mapcar
- (lambda (newsrc)
- (car (member
- (gnus-info-group newsrc)
- (gnus-agent-cat-groups info))))
- (cdr gnus-newsrc-alist)))
- ,@(mapcar (lambda (newsrc)
- `(const ,(gnus-info-group newsrc)))
- (cdr gnus-newsrc-alist))))))
-
- (widget-put gnus-agent-cat-groups :default (gnus-agent-cat-groups info))
- (widget-put gnus-agent-cat-groups :accessor 'gnus-agent-cat-groups)
- (push gnus-agent-cat-groups category-fields)
+
+ (let ((symb
+ (set
+ (make-local-variable 'gnus-agent-cat-groups)
+ (widget-create
+ `(choice
+ :format "%[Select Member Groups%]\n%v" :value ignore
+ (const :menu-tag "do not change" :tag "" :value ignore)
+ (checklist :entry-format "%b %v"
+ :menu-tag "display group selectors"
+ :greedy t
+ :value
+ ,(delq nil
+ (mapcar
+ (lambda (newsrc)
+ (car (member
+ (gnus-info-group newsrc)
+ (gnus-agent-cat-groups info))))
+ (cdr gnus-newsrc-alist)))
+ ,@(mapcar (lambda (newsrc)
+ `(const ,(gnus-info-group newsrc)))
+ (cdr gnus-newsrc-alist))))))))
+
+ (widget-put symb :default (gnus-agent-cat-groups info))
+ (widget-put symb :accessor 'gnus-agent-cat-groups)
+ (push symb category-fields))
(widget-insert "\nExpiration Settings ")
(gnus-agent-cat-prepare-category-field agent-enable-expiration)
(gnus-agent-cat-prepare-category-field agent-days-until-old)
- (use-local-map widget-keymap)
+ (widget-insert "\nVisual Settings ")
+
+ (gnus-agent-cat-prepare-category-field agent-enable-undownloaded-faces)
+
+ (use-local-map gnus-custom-map)
(widget-setup)
(buffer-enable-undo))))
projects / elisp / gnus.git- / blobdiff