X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-cus.el;h=98c26a132e6c2b65006eb9b944cf6862175a6fe4;hb=4cacb5f23eb830e6950dba987063f413977708d7;hp=f9912976da431c2ea39ff74079f5202a3afa6346;hpb=49d38b41c190eaab2cb34294fac7302a9c9ea353;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-cus.el b/lisp/gnus-cus.el index f991297..98c26a1 100644 --- a/lisp/gnus-cus.el +++ b/lisp/gnus-cus.el @@ -1,7 +1,7 @@ ;;; 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 ;; Keywords: news @@ -20,8 +20,8 @@ ;; 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: @@ -67,7 +67,7 @@ if that value is non-nil." (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: @@ -204,8 +204,7 @@ Which articles to display on entering the group. 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" @@ -310,16 +309,26 @@ has been stored locally for at least this many days." 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) @@ -764,8 +773,8 @@ When called interactively, FILE defaults to the current score file. 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" @@ -879,16 +888,17 @@ articles in the thread. (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) @@ -906,7 +916,9 @@ articles in the thread. (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)) @@ -919,23 +931,24 @@ articles in the thread. (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." @@ -973,7 +986,7 @@ articles in the thread. (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) @@ -1002,34 +1015,42 @@ articles in the thread. ;; 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) + (widget-insert "\nVisual Settings ") + + (gnus-agent-cat-prepare-category-field agent-enable-undownloaded-faces) + (use-local-map widget-keymap) (widget-setup) (buffer-enable-undo))))