/[emacs]/emacs/lisp/gnus/gnus-cus.el
ViewVC logotype

Diff of /emacs/lisp/gnus/gnus-cus.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.6.18.2 by miles, Tue Oct 14 23:34:50 2003 UTC revision 1.6.18.3 by miles, Thu Sep 16 00:12:15 2004 UTC
# Line 1  Line 1 
1  ;;; gnus-cus.el --- customization commands for Gnus  ;;; gnus-cus.el --- customization commands for Gnus
2  ;;  ;;
3  ;; Copyright (C) 1996,1999, 2000 Free Software Foundation, Inc.  ;; Copyright (C) 1996, 1999, 2000, 2001, 2002, 2003, 2004
4    ;;        Free Software Foundation, Inc.
5    
6  ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>  ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
7  ;; Keywords: news  ;; Keywords: news
# Line 27  Line 28 
28  ;;; Code:  ;;; Code:
29    
30  (require 'wid-edit)  (require 'wid-edit)
31    (require 'gnus)
32    (require 'gnus-agent)
33  (require 'gnus-score)  (require 'gnus-score)
34  (require 'gnus-topic)  (require 'gnus-topic)
35    (require 'gnus-art)
36    
37  ;;; Widgets:  ;;; Widgets:
38    
 ;; There should be special validation for this.  
 (define-widget 'gnus-email-address 'string  
   "An email address")  
   
39  (defun gnus-custom-mode ()  (defun gnus-custom-mode ()
40    "Major mode for editing Gnus customization buffers.    "Major mode for editing Gnus customization buffers.
41    
# Line 72  if that value is non-nil." Line 72  if that value is non-nil."
72  ;;; Group Customization:  ;;; Group Customization:
73    
74  (defconst gnus-group-parameters  (defconst gnus-group-parameters
75    '((to-address (gnus-email-address :tag "To Address") "\    '((extra-aliases (choice
 This will be used when doing followups and posts.  
   
 This is primarily useful in mail groups that represent closed  
 mailing lists--mailing lists where it's expected that everybody that  
 writes to the mailing list is subscribed to it.  Since using this  
 parameter ensures that the mail only goes to the mailing list itself,  
 it means that members won't receive two copies of your followups.  
   
 Using `to-address' will actually work whether the group is foreign or  
 not.  Let's say there's a group on the server that is called  
 `fa.4ad-l'.  This is a real newsgroup, but the server has gotten the  
 articles from a mail-to-news gateway.  Posting directly to this group  
 is therefore impossible--you have to send mail to the mailing list  
 address instead.  
   
 The gnus-group-split mail splitting mechanism will behave as if this  
 address was listed in gnus-group-split Addresses (see below).")  
   
     (to-list (gnus-email-address :tag "To List") "\  
 This address will be used when doing a `a' in the group.  
   
 It is totally ignored when doing a followup--except that if it is  
 present in a news group, you'll get mail group semantics when doing  
 `f'.  
   
 The gnus-group-split mail splitting mechanism will behave as if this  
 address was listed in gnus-group-split Addresses (see below).")  
   
     (extra-aliases (choice  
76                      :tag "Extra Aliases"                      :tag "Extra Aliases"
77                      (list                      (list
78                       :tag "List"                       :tag "List"
# Line 168  is present and a string, this string wil Line 139  is present and a string, this string wil
139  `gcc' header (this symbol takes precedence over any default `Gcc'  `gcc' header (this symbol takes precedence over any default `Gcc'
140  rules as described later).")  rules as described later).")
141    
     (banner (choice :tag "Banner"  
                     :value nil  
                     (const :tag "Remove signature" signature)  
                     (symbol :tag "Item in `gnus-article-banner-alist'" none)  
                     regexp  
                     (const :tag "None" nil)) "\  
 If non-nil, specify how to remove `banners' from articles.  
   
 Symbol `signature' means to remove signatures delimited by  
 `gnus-signature-separator'.  Any other symbol is used to look up a  
 regular expression to match the banner in `gnus-article-banner-alist'.  
 A string is used as a regular expression to match the banner  
 directly.")  
   
     (auto-expire (const :tag "Automatic Expire" t) "\  
 All articles that are read will be marked as expirable.")  
   
     (total-expire (const :tag "Total Expire" t) "\  
 All read articles will be put through the expiry process  
   
 This happens even if they are not marked as expirable.  
 Use with caution.")  
   
142      (expiry-wait (choice :tag  "Expire Wait"      (expiry-wait (choice :tag  "Expire Wait"
143                           :value never                           :value never
144                           (const never)                           (const never)
# Line 205  days (not necessarily an integer) or the Line 153  days (not necessarily an integer) or the
153  `immediate'.")  `immediate'.")
154    
155      (expiry-target (choice :tag "Expiry Target"      (expiry-target (choice :tag "Expiry Target"
156                             :value delete                             :value delete
157                             (const delete)                             (const delete)
158                             (function :format "%v" nnmail-)                             (function :format "%v" nnmail-)
159                             string) "\                             string) "\
160  Where expired messages end up.  Where expired messages end up.
161    
162  Overrides `nnmail-expiry-target', which see.")  Overrides `nnmail-expiry-target'.")
163    
164      (score-file (file :tag "Score File") "\      (score-file (file :tag "Score File") "\
165  Make the specified file into the current score file.  Make the specified file into the current score file.
# Line 232  you to put the admin address somewhere c Line 180  you to put the admin address somewhere c
180      (display (choice :tag "Display"      (display (choice :tag "Display"
181                       :value default                       :value default
182                       (const all)                       (const all)
183                       (const default)) "\                       (integer)
184                         (const default)
185                         (sexp  :tag "Other")) "\
186  Which articles to display on entering the group.  Which articles to display on entering the group.
187    
188  `all'  `all'
189       Display all articles, both read and unread.       Display all articles, both read and unread.
190    
191    `integer'
192         Display the last NUMBER articles in the group.  This is the same as
193         entering the group with C-u NUMBER.
194    
195  `default'  `default'
196       Display the default visible articles, which normally includes       Display the default visible articles, which normally includes
197       unread and ticked articles.")       unread and ticked articles.
198    
199    `Other'
200         Display the articles that satisfy the S-expression. The S-expression
201         should be in an array form.")
202    
203      (comment (string :tag  "Comment") "\      (comment (string :tag  "Comment") "\
204  An arbitrary comment on the group.")  An arbitrary comment on the group.")
205    
206      (visible (const :tag "Permanently visible" t) "\      (visible (const :tag "Permanently visible" t) "\
207  Always display this group, even when there are no unread articles  Always display this group, even when there are no unread articles in it.")
 in it..")  
   
     (charset (symbol :tag "Charset") "\  
 The default charset to use in the group.")  
   
     (ignored-charsets  
      (choice :tag "Ignored charsets"  
              :value nil  
              (repeat (symbol))) "\  
 List of charsets that should be ignored.  
   
 When these charsets are used in the \"charset\" parameter, the  
 default charset will be used instead.")  
208    
209      (highlight-words      (highlight-words
210       (choice :tag "Highlight words"       (choice :tag "Highlight words"
# Line 270  default charset will be used instead.") Line 215  default charset will be used instead.")
215                             (symbol :tag "Face"                             (symbol :tag "Face"
216                                     gnus-emphasis-highlight-words))))                                     gnus-emphasis-highlight-words))))
217       "highlight regexps.       "highlight regexps.
218  See gnus-emphasis-alist.")  See `gnus-emphasis-alist'.")
219    
220      (posting-style      (posting-style
221       (choice :tag "Posting style"       (choice :tag "Posting style"
222               :value nil               :value nil
223               (repeat (list               (repeat (list
224                        (choice :tag "Type"                        (choice :tag "Type"
225                                :value nil                                :value nil
226                                (const signature)                                (const signature)
227                                (const signature-file)                                (const signature-file)
228                                (const organization)                                (const organization)
229                                (const address)                                (const address)
230                                (const name)                                (const name)
231                                (const body))                                (const body))
232                        (string :format "%v"))))                        (string :format "%v"))))
233       "post style.       "post style.
234  See gnus-posting-styles."))  See `gnus-posting-styles'."))
235    "Alist of valid group or topic parameters.    "Alist of valid group or topic parameters.
236    
237  Each entry has the form (NAME TYPE DOC), where NAME is the parameter  Each entry has the form (NAME TYPE DOC), where NAME is the parameter
# Line 295  DOC is a documentation string for the pa Line 240  DOC is a documentation string for the pa
240    
241  (defconst gnus-extra-topic-parameters  (defconst gnus-extra-topic-parameters
242    '((subscribe (regexp :tag "Subscribe") "\    '((subscribe (regexp :tag "Subscribe") "\
243  If `gnus-subscribe-newsgroup-method' is set to  If `gnus-subscribe-newsgroup-method' or
244    `gnus-subscribe-options-newsgroup-method' is set to
245  `gnus-subscribe-topics', new groups that matches this regexp will  `gnus-subscribe-topics', new groups that matches this regexp will
246  automatically be subscribed to this topic"))  automatically be subscribed to this topic")
247        (subscribe-level (integer :tag "Subscribe Level" :value 1) "\
248    If this topic parameter is set, when new groups are subscribed
249    automatically under this topic (via the `subscribe' topic parameter)
250    assign this level to the group, rather than the default level
251    set in `gnus-level-default-subscribed'"))
252    "Alist of topic parameters that are not also group parameters.    "Alist of topic parameters that are not also group parameters.
253    
254  Each entry has the form (NAME TYPE DOC), where NAME is the parameter  Each entry has the form (NAME TYPE DOC), where NAME is the parameter
# Line 312  Server-assigned value attached to IMAP g Line 263  Server-assigned value attached to IMAP g
263  Each entry has the form (NAME TYPE DOC), where NAME is the parameter  Each entry has the form (NAME TYPE DOC), where NAME is the parameter
264  itself (a symbol), TYPE is the parameters type (a sexp widget), and  itself (a symbol), TYPE is the parameters type (a sexp widget), and
265  DOC is a documentation string for the parameter.")  DOC is a documentation string for the parameter.")
266    
267    (eval-and-compile
268      (defconst gnus-agent-parameters
269        '((agent-predicate
270           (sexp :tag "Selection Predicate" :value false)
271           "Predicate used to automatically select articles for downloading."
272           gnus-agent-cat-predicate)
273          (agent-score
274           (choice :tag "Score File" :value nil
275                   (const file :tag "Use group's score files")
276                   (repeat (list (string :format "%v" :tag "File name"))))
277           "Which score files to use when using score to select articles to fetch.
278    
279        `nil'
280             All articles will be scored to zero (0).
281    
282        `file'
283             The group's score files will be used to score the articles.
284    
285        `List'
286             A list of score file names."
287           gnus-agent-cat-score-file)
288          (agent-short-article
289           (integer :tag "Max Length of Short Article" :value "")
290           "The SHORT predicate will evaluate to true when the article is
291    shorter than this length."  gnus-agent-cat-length-when-short)
292          (agent-long-article
293           (integer :tag "Min Length of Long Article" :value "")
294           "The LONG predicate will evaluate to true when the article is
295    longer than this length."  gnus-agent-cat-length-when-long)
296          (agent-low-score
297           (integer :tag "Low Score Limit" :value "")
298           "The LOW predicate will evaluate to true when the article scores
299    lower than this limit."  gnus-agent-cat-low-score)
300          (agent-high-score
301           (integer :tag "High Score Limit" :value "")
302           "The HIGH predicate will evaluate to true when the article scores
303    higher than this limit."  gnus-agent-cat-high-score)
304          (agent-days-until-old
305           (integer :tag "Days Until Old" :value "")
306           "The OLD predicate will evaluate to true when the fetched article
307    has been stored locally for at least this many days."
308           gnus-agent-cat-days-until-old)
309          (agent-enable-expiration
310           (radio :tag "Expire in this Group or Topic" :value nil
311                  (const :format "Enable " ENABLE)
312                  (const :format "Disable " DISABLE))
313           "\nEnable, or disable, agent expiration in this group or topic."
314           gnus-agent-cat-enable-expiration)
315          (agent-enable-undownloaded-faces
316           (boolean :tag "Enable Agent Faces")
317           "Have the summary buffer use the agent's undownloaded faces.
318    These faces, when enabled, act as a warning that an article has not
319    been fetched into either the agent nor the cache.  This is of most use
320    to users who use the agent as a cache (i.e. they only operate on
321    articles that have been downloaded).  Leave disabled to display normal
322    article faces even when the article hasn't been downloaded."
323    gnus-agent-cat-enable-undownloaded-faces))
324        "Alist of group parameters that are not also topic parameters.
325    
326    Each entry has the form (NAME TYPE DOC ACCESSOR), where NAME is the
327    parameter itself (a symbol), TYPE is the parameters type (a sexp
328    widget), DOC is a documentation string for the parameter, and ACCESSOR
329    is a function (symbol) that extracts the current value from the
330    category."))
331    
332  (defvar gnus-custom-params)  (defvar gnus-custom-params)
333  (defvar gnus-custom-method)  (defvar gnus-custom-method)
334  (defvar gnus-custom-group)  (defvar gnus-custom-group)
# Line 326  DOC is a documentation string for the pa Line 343  DOC is a documentation string for the pa
343                                  :doc ,(nth 2 entry)                                  :doc ,(nth 2 entry)
344                                  (const :format "" ,(nth 0 entry))                                  (const :format "" ,(nth 0 entry))
345                                  ,(nth 1 entry)))                                  ,(nth 1 entry)))
346                         (append gnus-group-parameters                         (append (reverse gnus-group-parameters-more)
347                                   gnus-group-parameters
348                                 (if group                                 (if group
349                                     gnus-extra-group-parameters                                     gnus-extra-group-parameters
350                                   gnus-extra-topic-parameters)))))                                   gnus-extra-topic-parameters))))
351            (agent (mapcar (lambda (entry)
352                             (let ((type (nth 1 entry))
353                                   vcons)
354                               (if (listp type)
355                                   (setq type (copy-sequence type)))
356    
357                               (setq vcons (cdr (memq :value type)))
358    
359                               (if (symbolp (car vcons))
360                                   (condition-case nil
361                                       (setcar vcons (symbol-value (car vcons)))
362                                     (error)))
363                               `(cons :format "%v%h\n"
364                                      :doc ,(nth 2 entry)
365                                      (const :format "" ,(nth 0 entry))
366                                      ,type)))
367                           (if gnus-agent
368                               gnus-agent-parameters))))
369      (unless (or group topic)      (unless (or group topic)
370        (error "No group on current line"))        (error "No group on current line"))
371      (when (and group topic)      (when (and group topic)
372        (error "Both a group and topic on current line"))        (error "Both a group an topic on current line"))
373      (unless (or topic (setq info (gnus-get-info group)))      (unless (or topic (setq info (gnus-get-info group)))
374        (error "Killed group; can't be edited"))        (error "Killed group; can't be edited"))
375      ;; Ready.      ;; Ready.
376      (kill-buffer (gnus-get-buffer-create "*Gnus Customize*"))      (gnus-kill-buffer (gnus-get-buffer-create "*Gnus Customize*"))
377      (switch-to-buffer (gnus-get-buffer-create "*Gnus Customize*"))      (switch-to-buffer (gnus-get-buffer-create "*Gnus Customize*"))
378      (gnus-custom-mode)      (gnus-custom-mode)
379      (make-local-variable 'gnus-custom-group)      (make-local-variable 'gnus-custom-group)
# Line 364  DOC is a documentation string for the pa Line 400  DOC is a documentation string for the pa
400                     :action 'gnus-group-customize-done)                     :action 'gnus-group-customize-done)
401      (widget-insert ".\n\n")      (widget-insert ".\n\n")
402      (make-local-variable 'gnus-custom-params)      (make-local-variable 'gnus-custom-params)
403      (setq gnus-custom-params  
404            (widget-create 'group      (let ((values (if group
405                           :value (if group                        (gnus-info-params info)
406                                      (gnus-info-params info)                      (gnus-topic-parameters topic))))
407                                    (gnus-topic-parameters topic))  
408                           `(set :inline t        ;; The parameters in values may contain duplicates.  This is
409                                 :greedy t        ;; normally OK as assq returns the first. However, right here
410                                 :tag "Parameters"        ;; every duplicate ends up being displayed.  So, rather than
411                                 :format "%t:\n%h%v"        ;; display them, remove them from the list.
412                                 :doc "\  
413          (let ((tmp (setq values (gnus-copy-sequence values)))
414                elem)
415            (while (cdr tmp)
416              (while (setq elem (assq (caar tmp) (cdr tmp)))
417                (delq elem tmp))
418              (setq tmp (cdr tmp))))
419    
420          (setq gnus-custom-params
421                (apply 'widget-create 'group
422                       :value values
423                       (delq nil
424                             (list `(set :inline t
425                                         :greedy t
426                                         :tag "Parameters"
427                                         :format "%t:\n%h%v"
428                                         :doc "\
429  These special parameters are recognized by Gnus.  These special parameters are recognized by Gnus.
430  Check the [ ] for the parameters you want to apply to this group or  Check the [ ] for the parameters you want to apply to this group or
431  to the groups in this topic, then edit the value to suit your taste."  to the groups in this topic, then edit the value to suit your taste."
432                                 ,@types)                                       ,@types)
433                           '(repeat :inline t                                 (when gnus-agent
434                                    :tag "Variables"                                   `(set :inline t
435                                    :format "%t:\n%h%v%i\n\n"                                         :greedy t
436                                    :doc "\                                         :tag "Agent Parameters"
437                                           :format "%t:\n%h%v"
438                                           :doc "\ These agent parameters are
439    recognized by Gnus.  They control article selection and expiration for
440    use in the unplugged cache.  Check the [ ] for the parameters you want
441    to apply to this group or to the groups in this topic, then edit the
442    value to suit your taste.
443    
444    For those interested, group parameters override topic parameters while
445    topic parameters override agent category parameters.  Underlying
446    category parameters are the customizable variables."  ,@agent))
447                                   '(repeat :inline t
448                                            :tag "Variables"
449                                            :format "%t:\n%h%v%i\n\n"
450                                            :doc "\
451  Set variables local to the group you are entering.  Set variables local to the group you are entering.
452    
453  If you want to turn threading off in `news.answers', you could put  If you want to turn threading off in `news.answers', you could put
# Line 394  like.  If you want to hear a beep when y Line 460  like.  If you want to hear a beep when y
460  put something like `(dummy-variable (ding))' in the parameters of that  put something like `(dummy-variable (ding))' in the parameters of that
461  group.  `dummy-variable' will be set to the result of the `(ding)'  group.  `dummy-variable' will be set to the result of the `(ding)'
462  form, but who cares?"  form, but who cares?"
463                                    (list :format "%v" :value (nil nil)                                          (list :format "%v" :value (nil nil)
464                                          (symbol :tag "Variable")                                                (symbol :tag "Variable")
465                                          (sexp :tag                                                (sexp :tag
466                                                "Value")))                                                      "Value")))
467    
468                           '(repeat :inline t                                 '(repeat :inline t
469                                    :tag "Unknown entries"                                          :tag "Unknown entries"
470                                    sexp)))                                          sexp))))))
471      (when group      (when group
472        (widget-insert "\n\nYou can also edit the ")        (widget-insert "\n\nYou can also edit the ")
473        (widget-create 'info-link        (widget-create 'info-link
# Line 701  eh?"))) Line 767  eh?")))
767  (defvar gnus-custom-score-alist)  (defvar gnus-custom-score-alist)
768    
769  (defun gnus-score-customize (file)  (defun gnus-score-customize (file)
770    "Customize score file FILE."    "Customize score file FILE.
771    When called interactively, FILE defaults to the current score file.
772    This can be changed using the `\\[gnus-score-change-score-file]' command."
773    (interactive (list gnus-current-score-file))    (interactive (list gnus-current-score-file))
774      (unless file
775        (error (format "No score file for %s"
776                       (gnus-group-decoded-name gnus-newsgroup-name))))
777    (let ((scores (gnus-score-load file))    (let ((scores (gnus-score-load file))
778          (types (mapcar (lambda (entry)          (types (mapcar (lambda (entry)
779                           `(group :format "%v%h\n"                           `(group :format "%v%h\n"
# Line 814  articles in the thread. Line 885  articles in the thread.
885      (gnus-score-set 'touched '(t) alist))      (gnus-score-set 'touched '(t) alist))
886    (bury-buffer))    (bury-buffer))
887    
888    (eval-when-compile
889      (defvar category-fields nil)
890      (defvar gnus-agent-cat-name)
891      (defvar gnus-agent-cat-score-file)
892      (defvar gnus-agent-cat-length-when-short)
893      (defvar gnus-agent-cat-length-when-long)
894      (defvar gnus-agent-cat-low-score)
895      (defvar gnus-agent-cat-high-score)
896      (defvar gnus-agent-cat-enable-expiration)
897      (defvar gnus-agent-cat-days-until-old)
898      (defvar gnus-agent-cat-predicate)
899      (defvar gnus-agent-cat-groups)
900      (defvar gnus-agent-cat-enable-undownloaded-faces)
901    )
902    
903    (defun gnus-trim-whitespace (s)
904      (when (string-match "\\`[ \n\t]+" s)
905        (setq s (substring s (match-end 0))))
906      (when (string-match "[ \n\t]+\\'" s)
907        (setq s (substring s 0 (match-beginning 0))))
908      s)
909    
910    (defmacro gnus-agent-cat-prepare-category-field (parameter)
911      (let* ((entry (assq parameter gnus-agent-parameters))
912             (field (nth 3 entry)))
913        `(let* ((type (copy-sequence
914                       (nth 1 (assq ',parameter gnus-agent-parameters))))
915                (val (,field info))
916                (deflt (if (,field defaults)
917                           (concat " [" (gnus-trim-whitespace
918                                         (gnus-pp-to-string (,field defaults)))
919                                   "]")))
920                symb)
921    
922           (if (eq (car type) 'radio)
923               (let* ((rtype (nreverse type))
924                      (rt rtype))
925                 (while (listp (or (cadr rt) 'not-list))
926                   (setq rt (cdr rt)))
927    
928                 (setcdr rt (cons '(const :format "Inherit " nil) (cdr rt)))
929                 (setq type (nreverse rtype))))
930    
931           (if deflt
932               (let ((tag (cdr (memq :tag type))))
933                 (when (string-match "\n" deflt)
934                   (while (progn (setq deflt (replace-match "\n " t t
935                                                            deflt))
936                                 (string-match "\n" deflt (match-end 0))))
937                   (setq deflt (concat "\n" deflt)))
938    
939                 (setcar tag (concat (car tag) deflt))))
940    
941           (widget-insert "\n")
942    
943           (setq val (if val
944                         (widget-create type :value val)
945                       (widget-create type))
946                 symb (set (make-local-variable ',field) val))
947    
948           (widget-put symb :default val)
949           (widget-put symb :accessor ',field)
950           (push symb category-fields))))
951    
952    (defun gnus-agent-customize-category (category)
953      "Edit the CATEGORY."
954      (interactive (list (gnus-category-name)))
955      (let ((info (assq category gnus-category-alist))
956            (defaults (list nil '(agent-predicate . false)
957                            (cons 'agent-enable-expiration
958                                  gnus-agent-enable-expiration)
959                            '(agent-days-until-old . 7)
960                            (cons 'agent-length-when-short
961                                  gnus-agent-short-article)
962                            (cons 'agent-length-when-long gnus-agent-long-article)
963                            (cons 'agent-low-score gnus-agent-low-score)
964                            (cons 'agent-high-score gnus-agent-high-score))))
965    
966        (let ((old (get-buffer "*Gnus Agent Category Customize*")))
967          (when old
968            (gnus-kill-buffer old)))
969        (switch-to-buffer (gnus-get-buffer-create
970                           "*Gnus Agent Category Customize*"))
971    
972        (let ((inhibit-read-only t))
973          (gnus-custom-mode)
974          (buffer-disable-undo)
975    
976          (let* ((name (gnus-agent-cat-name info)))
977            (widget-insert "Customize the Agent Category '")
978            (widget-insert (symbol-name name))
979            (widget-insert "' and press ")
980            (widget-create
981             'push-button
982             :notify
983             '(lambda (&rest ignore)
984                (let* ((info (assq gnus-agent-cat-name gnus-category-alist))
985                       (widgets category-fields))
986                  (while widgets
987                    (let* ((widget (pop widgets))
988                           (value (condition-case nil (widget-value widget) (error))))
989                      (eval `(setf (,(widget-get widget :accessor) ',info)
990                                   ',value)))))
991                (gnus-category-write)
992                (gnus-kill-buffer (current-buffer))
993                (when (get-buffer gnus-category-buffer)
994                  (switch-to-buffer (get-buffer gnus-category-buffer))
995                  (gnus-category-list)))
996                           "Done")
997            (widget-insert
998             "\n    Note: Empty fields default to the customizable global\
999     variables.\n\n")
1000    
1001            (set (make-local-variable 'gnus-agent-cat-name)
1002                 name))
1003    
1004          (set (make-local-variable 'category-fields) nil)
1005          (gnus-agent-cat-prepare-category-field agent-predicate)
1006    
1007          (gnus-agent-cat-prepare-category-field agent-score)
1008          (gnus-agent-cat-prepare-category-field agent-short-article)
1009          (gnus-agent-cat-prepare-category-field agent-long-article)
1010          (gnus-agent-cat-prepare-category-field agent-low-score)
1011          (gnus-agent-cat-prepare-category-field agent-high-score)
1012    
1013          ;; The group list is NOT handled with
1014          ;; gnus-agent-cat-prepare-category-field as I don't want the
1015          ;; group list to appear when customizing a topic.
1016          (widget-insert "\n")
1017          
1018          (let ((symb
1019                 (set
1020                  (make-local-variable 'gnus-agent-cat-groups)
1021                  (widget-create
1022                   `(choice
1023                     :format "%[Select Member Groups%]\n%v" :value ignore
1024                     (const :menu-tag "do not change" :tag "" :value ignore)
1025                     (checklist :entry-format "%b %v"
1026                                :menu-tag "display group selectors"
1027                                :greedy t
1028                                :value
1029                                ,(delq nil
1030                                       (mapcar
1031                                        (lambda (newsrc)
1032                                          (car (member
1033                                                (gnus-info-group newsrc)
1034                                                (gnus-agent-cat-groups info))))
1035                                        (cdr gnus-newsrc-alist)))
1036                                ,@(mapcar (lambda (newsrc)
1037                                            `(const ,(gnus-info-group newsrc)))
1038                                          (cdr gnus-newsrc-alist))))))))
1039    
1040          (widget-put symb :default (gnus-agent-cat-groups info))
1041          (widget-put symb :accessor 'gnus-agent-cat-groups)
1042          (push symb category-fields))
1043    
1044          (widget-insert "\nExpiration Settings ")
1045    
1046          (gnus-agent-cat-prepare-category-field agent-enable-expiration)
1047          (gnus-agent-cat-prepare-category-field agent-days-until-old)
1048    
1049          (widget-insert "\nVisual Settings ")
1050    
1051          (gnus-agent-cat-prepare-category-field agent-enable-undownloaded-faces)
1052    
1053          (use-local-map widget-keymap)
1054          (widget-setup)
1055          (buffer-enable-undo))))
1056    
1057  ;;; The End:  ;;; The End:
1058    
1059  (provide 'gnus-cus)  (provide 'gnus-cus)

Legend:
Removed from v.1.6.18.2  
changed lines
  Added in v.1.6.18.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26