X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-cus.el;h=a5e09ca1f4b068457d4b22a1f0d13a92d9d296e5;hb=af7c9b7a83765ae38b534d33cec86176ad1cb6c6;hp=041af2faac1926a7b7e3730a79849f884edcdc6d;hpb=c8c6f0b46fd22b3ec8bb2bd8f86cfe038766999c;p=gnus diff --git a/lisp/gnus-cus.el b/lisp/gnus-cus.el index 041af2faa..a5e09ca1f 100644 --- a/lisp/gnus-cus.el +++ b/lisp/gnus-cus.el @@ -1,6 +1,6 @@ ;;; gnus-cus.el --- customization commands for Gnus ;; -;; Copyright (C) 1996, 1999, 2000, 2001, 2002, 2003 +;; Copyright (C) 1996, 1999, 2000, 2001, 2002, 2003, 2004 ;; Free Software Foundation, Inc. ;; Author: Per Abrahamsen @@ -159,7 +159,7 @@ days (not necessarily an integer) or the symbols `never' or string) "\ Where expired messages end up. -Overrides `nnmail-expiry-target', which see.") +Overrides `nnmail-expiry-target'.") (score-file (file :tag "Score File") "\ Make the specified file into the current score file. @@ -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" @@ -309,16 +308,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) @@ -392,24 +401,21 @@ DOC is a documentation string for the parameter.")) (widget-insert ".\n\n") (make-local-variable 'gnus-custom-params) - (let* ((values (if group - (gnus-info-params info) - (gnus-topic-parameters topic)))) + (let ((values (if group + (gnus-info-params info) + (gnus-topic-parameters topic)))) ;; The parameters in values may contain duplicates. This is ;; normally OK as assq returns the first. However, right here ;; every duplicate ends up being displayed. So, rather than ;; display them, remove them from the list. - (let (tmp) - (setq values (gnus-copy-sequence values) - tmp values) - - (while tmp - (setcdr tmp (delete-if (lambda (testing) (eq (caar tmp) - (car testing))) - (cdr tmp))) - (setq tmp (cdr tmp)))) + (let ((tmp (setq values (gnus-copy-sequence values))) + elem) + (while (cdr tmp) + (while (setq elem (assq (caar tmp) (cdr tmp))) + (delq elem tmp)) + (setq tmp (cdr tmp)))) (setq gnus-custom-params (apply 'widget-create 'group @@ -881,16 +887,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) @@ -908,7 +915,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)) @@ -921,23 +930,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." @@ -975,7 +985,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) @@ -1004,34 +1014,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)))) @@ -1040,4 +1058,5 @@ articles in the thread. (provide 'gnus-cus) +;;; arch-tag: a37c285a-49bc-4235-8244-804536effeaf ;;; gnus-cus.el ends here