emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] Changes to emacs/lisp/gnus/gnus-cus.el [emacs-unicode-2]


From: Miles Bader
Subject: [Emacs-diffs] Changes to emacs/lisp/gnus/gnus-cus.el [emacs-unicode-2]
Date: Thu, 09 Sep 2004 08:14:42 -0400

Index: emacs/lisp/gnus/gnus-cus.el
diff -c emacs/lisp/gnus/gnus-cus.el:1.8.4.1 emacs/lisp/gnus/gnus-cus.el:1.8.4.2
*** emacs/lisp/gnus/gnus-cus.el:1.8.4.1 Fri Mar 12 00:02:57 2004
--- emacs/lisp/gnus/gnus-cus.el Thu Sep  9 09:36:25 2004
***************
*** 1,6 ****
  ;;; gnus-cus.el --- customization commands for Gnus
  ;;
! ;; Copyright (C) 1996,1999, 2000 Free Software Foundation, Inc.
  
  ;; Author: Per Abrahamsen <address@hidden>
  ;; Keywords: news
--- 1,7 ----
  ;;; gnus-cus.el --- customization commands for Gnus
  ;;
! ;; Copyright (C) 1996, 1999, 2000, 2001, 2002, 2003, 2004
! ;;        Free Software Foundation, Inc.
  
  ;; Author: Per Abrahamsen <address@hidden>
  ;; Keywords: news
***************
*** 27,41 ****
  ;;; Code:
  
  (require 'wid-edit)
  (require 'gnus-score)
  (require 'gnus-topic)
  
  ;;; Widgets:
  
- ;; There should be special validation for this.
- (define-widget 'gnus-email-address 'string
-   "An email address")
- 
  (defun gnus-custom-mode ()
    "Major mode for editing Gnus customization buffers.
  
--- 28,41 ----
  ;;; Code:
  
  (require 'wid-edit)
+ (require 'gnus)
+ (require 'gnus-agent)
  (require 'gnus-score)
  (require 'gnus-topic)
+ (require 'gnus-art)
  
  ;;; Widgets:
  
  (defun gnus-custom-mode ()
    "Major mode for editing Gnus customization buffers.
  
***************
*** 72,107 ****
  ;;; Group Customization:
  
  (defconst gnus-group-parameters
!   '((to-address (gnus-email-address :tag "To Address") "\
! 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
                    :tag "Extra Aliases"
                    (list
                     :tag "List"
--- 72,78 ----
  ;;; Group Customization:
  
  (defconst gnus-group-parameters
!   '((extra-aliases (choice
                    :tag "Extra Aliases"
                    (list
                     :tag "List"
***************
*** 168,196 ****
  `gcc' header (this symbol takes precedence over any default `Gcc'
  rules as described later).")
  
-     (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.")
- 
      (expiry-wait (choice :tag  "Expire Wait"
                         :value never
                         (const never)
--- 139,144 ----
***************
*** 205,217 ****
  `immediate'.")
  
      (expiry-target (choice :tag "Expiry Target"
!                            :value delete
!                            (const delete)
!                            (function :format "%v" nnmail-)
!                            string) "\
  Where expired messages end up.
  
! Overrides `nnmail-expiry-target', which see.")
  
      (score-file (file :tag "Score File") "\
  Make the specified file into the current score file.
--- 153,165 ----
  `immediate'.")
  
      (expiry-target (choice :tag "Expiry Target"
!                          :value delete
!                          (const delete)
!                          (function :format "%v" nnmail-)
!                          string) "\
  Where expired messages end up.
  
! Overrides `nnmail-expiry-target'.")
  
      (score-file (file :tag "Score File") "\
  Make the specified file into the current score file.
***************
*** 232,265 ****
      (display (choice :tag "Display"
                     :value default
                     (const all)
!                    (const default)) "\
  Which articles to display on entering the group.
  
  `all'
       Display all articles, both read and unread.
  
  `default'
       Display the default visible articles, which normally includes
!      unread and ticked articles.")
  
      (comment (string :tag  "Comment") "\
  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..")
! 
!     (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.")
  
      (highlight-words
       (choice :tag "Highlight words"
--- 180,210 ----
      (display (choice :tag "Display"
                     :value default
                     (const all)
!                    (integer)
!                    (const default)
!                    (sexp  :tag "Other")) "\
  Which articles to display on entering the group.
  
  `all'
       Display all articles, both read and unread.
  
+ `integer'
+      Display the last NUMBER articles in the group.  This is the same as
+      entering the group with C-u NUMBER.
+ 
  `default'
       Display the default visible articles, which normally includes
!      unread and ticked articles.
! 
! `Other'
!      Display the articles that satisfy the S-expression. The S-expression
!      should be in an array form.")
  
      (comment (string :tag  "Comment") "\
  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.")
  
      (highlight-words
       (choice :tag "Highlight words"
***************
*** 270,292 ****
                           (symbol :tag "Face"
                                   gnus-emphasis-highlight-words))))
       "highlight regexps.
! See gnus-emphasis-alist.")
  
      (posting-style
       (choice :tag "Posting style"
             :value nil
             (repeat (list
!                     (choice :tag "Type"
                              :value nil
                              (const signature)
!                             (const signature-file)
!                             (const organization)
!                             (const address)
!                             (const name)
!                             (const body))
                      (string :format "%v"))))
       "post style.
! See gnus-posting-styles."))
    "Alist of valid group or topic parameters.
  
  Each entry has the form (NAME TYPE DOC), where NAME is the parameter
--- 215,237 ----
                           (symbol :tag "Face"
                                   gnus-emphasis-highlight-words))))
       "highlight regexps.
! See `gnus-emphasis-alist'.")
  
      (posting-style
       (choice :tag "Posting style"
             :value nil
             (repeat (list
!                     (choice :tag "Type"
                              :value nil
                              (const signature)
!                             (const signature-file)
!                             (const organization)
!                             (const address)
!                             (const name)
!                             (const body))
                      (string :format "%v"))))
       "post style.
! See `gnus-posting-styles'."))
    "Alist of valid group or topic parameters.
  
  Each entry has the form (NAME TYPE DOC), where NAME is the parameter
***************
*** 295,303 ****
  
  (defconst gnus-extra-topic-parameters
    '((subscribe (regexp :tag "Subscribe") "\
! If `gnus-subscribe-newsgroup-method' is set to
  `gnus-subscribe-topics', new groups that matches this regexp will
! automatically be subscribed to this topic"))
    "Alist of topic parameters that are not also group parameters.
  
  Each entry has the form (NAME TYPE DOC), where NAME is the parameter
--- 240,254 ----
  
  (defconst gnus-extra-topic-parameters
    '((subscribe (regexp :tag "Subscribe") "\
! If `gnus-subscribe-newsgroup-method' or
! `gnus-subscribe-options-newsgroup-method' is set to
  `gnus-subscribe-topics', new groups that matches this regexp will
! automatically be subscribed to this topic")
!     (subscribe-level (integer :tag "Subscribe Level" :value 1) "\
! If this topic parameter is set, when new groups are subscribed
! automatically under this topic (via the `subscribe' topic parameter)
! assign this level to the group, rather than the default level
! set in `gnus-level-default-subscribed'"))
    "Alist of topic parameters that are not also group parameters.
  
  Each entry has the form (NAME TYPE DOC), where NAME is the parameter
***************
*** 312,317 ****
--- 263,334 ----
  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.")
+ 
+ (eval-and-compile
+   (defconst gnus-agent-parameters
+     '((agent-predicate
+        (sexp :tag "Selection Predicate" :value false)
+        "Predicate used to automatically select articles for downloading."
+        gnus-agent-cat-predicate)
+       (agent-score
+        (choice :tag "Score File" :value nil
+                (const file :tag "Use group's score files")
+                (repeat (list (string :format "%v" :tag "File name"))))
+        "Which score files to use when using score to select articles to fetch.
+ 
+     `nil'
+          All articles will be scored to zero (0).
+ 
+     `file'
+          The group's score files will be used to score the articles.
+ 
+     `List'
+          A list of score file names."
+        gnus-agent-cat-score-file)
+       (agent-short-article
+        (integer :tag "Max Length of Short Article" :value "")
+        "The SHORT predicate will evaluate to true when the article is
+ shorter than this length."  gnus-agent-cat-length-when-short)
+       (agent-long-article
+        (integer :tag "Min Length of Long Article" :value "")
+        "The LONG predicate will evaluate to true when the article is
+ longer than this length."  gnus-agent-cat-length-when-long)
+       (agent-low-score
+        (integer :tag "Low Score Limit" :value "")
+        "The LOW predicate will evaluate to true when the article scores
+ lower than this limit."  gnus-agent-cat-low-score)
+       (agent-high-score
+        (integer :tag "High Score Limit" :value "")
+        "The HIGH predicate will evaluate to true when the article scores
+ higher than this limit."  gnus-agent-cat-high-score)
+       (agent-days-until-old
+        (integer :tag "Days Until Old" :value "")
+        "The OLD predicate will evaluate to true when the fetched article
+ 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 "Enable " ENABLE)
+               (const :format "Disable " DISABLE))
+        "\nEnable, or disable, agent expiration in this group or topic."
+        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 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)
  (defvar gnus-custom-group)
***************
*** 326,343 ****
                                :doc ,(nth 2 entry)
                                (const :format "" ,(nth 0 entry))
                                ,(nth 1 entry)))
!                      (append gnus-group-parameters
                               (if group
                                   gnus-extra-group-parameters
!                                gnus-extra-topic-parameters)))))
      (unless (or group topic)
        (error "No group on current line"))
      (when (and group topic)
!       (error "Both a group and topic on current line"))
      (unless (or topic (setq info (gnus-get-info group)))
        (error "Killed group; can't be edited"))
      ;; Ready.
!     (kill-buffer (gnus-get-buffer-create "*Gnus Customize*"))
      (switch-to-buffer (gnus-get-buffer-create "*Gnus Customize*"))
      (gnus-custom-mode)
      (make-local-variable 'gnus-custom-group)
--- 343,379 ----
                                :doc ,(nth 2 entry)
                                (const :format "" ,(nth 0 entry))
                                ,(nth 1 entry)))
!                      (append (reverse gnus-group-parameters-more)
!                              gnus-group-parameters
                               (if group
                                   gnus-extra-group-parameters
!                                gnus-extra-topic-parameters))))
!       (agent (mapcar (lambda (entry)
!                          (let ((type (nth 1 entry))
!                                vcons)
!                            (if (listp type)
!                                (setq type (copy-sequence type)))
! 
!                            (setq vcons (cdr (memq :value type)))
! 
!                            (if (symbolp (car vcons))
!                                (condition-case nil
!                                    (setcar vcons (symbol-value (car vcons)))
!                                  (error)))
!                            `(cons :format "%v%h\n"
!                                   :doc ,(nth 2 entry)
!                                   (const :format "" ,(nth 0 entry))
!                                   ,type)))
!                      (if gnus-agent
!                            gnus-agent-parameters))))
      (unless (or group topic)
        (error "No group on current line"))
      (when (and group topic)
!       (error "Both a group an topic on current line"))
      (unless (or topic (setq info (gnus-get-info group)))
        (error "Killed group; can't be edited"))
      ;; Ready.
!     (gnus-kill-buffer (gnus-get-buffer-create "*Gnus Customize*"))
      (switch-to-buffer (gnus-get-buffer-create "*Gnus Customize*"))
      (gnus-custom-mode)
      (make-local-variable 'gnus-custom-group)
***************
*** 364,387 ****
                   :action 'gnus-group-customize-done)
      (widget-insert ".\n\n")
      (make-local-variable 'gnus-custom-params)
!     (setq gnus-custom-params
!         (widget-create 'group
!                        :value (if group
!                                   (gnus-info-params info)
!                                 (gnus-topic-parameters topic))
!                        `(set :inline t
!                              :greedy t
!                              :tag "Parameters"
!                              :format "%t:\n%h%v"
!                              :doc "\
  These special parameters are recognized by Gnus.
  Check the [ ] for the parameters you want to apply to this group or
  to the groups in this topic, then edit the value to suit your taste."
!                              ,@types)
!                        '(repeat :inline t
!                                 :tag "Variables"
!                                 :format "%t:\n%h%v%i\n\n"
!                                 :doc "\
  Set variables local to the group you are entering.
  
  If you want to turn threading off in `news.answers', you could put
--- 400,453 ----
                   :action 'gnus-group-customize-done)
      (widget-insert ".\n\n")
      (make-local-variable 'gnus-custom-params)
! 
!     (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)))
!           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
!                    :value values
!                    (delq nil
!                          (list `(set :inline t
!                                      :greedy t
!                                      :tag "Parameters"
!                                      :format "%t:\n%h%v"
!                                      :doc "\
  These special parameters are recognized by Gnus.
  Check the [ ] for the parameters you want to apply to this group or
  to the groups in this topic, then edit the value to suit your taste."
!                                      ,@types)
!                                (when gnus-agent
!                                  `(set :inline t
!                                        :greedy t
!                                        :tag "Agent Parameters"
!                                        :format "%t:\n%h%v"
!                                        :doc "\ These agent parameters are
! recognized by Gnus.  They control article selection and expiration for
! use in the unplugged cache.  Check the [ ] for the parameters you want
! to apply to this group or to the groups in this topic, then edit the
! value to suit your taste.
! 
! For those interested, group parameters override topic parameters while
! topic parameters override agent category parameters.  Underlying
! category parameters are the customizable variables."  ,@agent))
!                                '(repeat :inline t
!                                         :tag "Variables"
!                                         :format "%t:\n%h%v%i\n\n"
!                                         :doc "\
  Set variables local to the group you are entering.
  
  If you want to turn threading off in `news.answers', you could put
***************
*** 394,407 ****
  put something like `(dummy-variable (ding))' in the parameters of that
  group.  `dummy-variable' will be set to the result of the `(ding)'
  form, but who cares?"
!                                 (list :format "%v" :value (nil nil)
!                                       (symbol :tag "Variable")
!                                       (sexp :tag
!                                             "Value")))
! 
!                        '(repeat :inline t
!                                 :tag "Unknown entries"
!                                 sexp)))
      (when group
        (widget-insert "\n\nYou can also edit the ")
        (widget-create 'info-link
--- 460,473 ----
  put something like `(dummy-variable (ding))' in the parameters of that
  group.  `dummy-variable' will be set to the result of the `(ding)'
  form, but who cares?"
!                                         (list :format "%v" :value (nil nil)
!                                               (symbol :tag "Variable")
!                                               (sexp :tag
!                                                     "Value")))
! 
!                                '(repeat :inline t
!                                         :tag "Unknown entries"
!                                         sexp))))))
      (when group
        (widget-insert "\n\nYou can also edit the ")
        (widget-create 'info-link
***************
*** 701,708 ****
  (defvar gnus-custom-score-alist)
  
  (defun gnus-score-customize (file)
!   "Customize score file FILE."
    (interactive (list gnus-current-score-file))
    (let ((scores (gnus-score-load file))
        (types (mapcar (lambda (entry)
                         `(group :format "%v%h\n"
--- 767,779 ----
  (defvar gnus-custom-score-alist)
  
  (defun gnus-score-customize (file)
!   "Customize score file FILE.
! 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))))
    (let ((scores (gnus-score-load file))
        (types (mapcar (lambda (entry)
                         `(group :format "%v%h\n"
***************
*** 814,819 ****
--- 885,1059 ----
      (gnus-score-set 'touched '(t) alist))
    (bury-buffer))
  
+ (eval-when-compile
+   (defvar category-fields 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)
+   (when (string-match "\\`[ \n\t]+" s)
+     (setq s (substring s (match-end 0))))
+   (when (string-match "[ \n\t]+\\'" s)
+     (setq s (substring s 0 (match-beginning 0))))
+   s)
+ 
+ (defmacro gnus-agent-cat-prepare-category-field (parameter)
+   (let* ((entry (assq parameter gnus-agent-parameters))
+          (field (nth 3 entry)))
+     `(let* ((type (copy-sequence
+                    (nth 1 (assq ',parameter gnus-agent-parameters))))
+             (val (,field info))
+             (deflt (if (,field defaults)
+                        (concat " [" (gnus-trim-whitespace
+                                      (gnus-pp-to-string (,field defaults)))
+                              "]")))
+             symb)
+ 
+        (if (eq (car type) 'radio)
+            (let* ((rtype (nreverse type))
+                   (rt rtype))
+              (while (listp (or (cadr rt) 'not-list))
+                (setq rt (cdr rt)))
+ 
+              (setcdr rt (cons '(const :format "Inherit " nil) (cdr rt)))
+              (setq type (nreverse rtype))))
+ 
+        (if deflt
+            (let ((tag (cdr (memq :tag type))))
+              (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")
+ 
+        (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."
+   (interactive (list (gnus-category-name)))
+   (let ((info (assq category gnus-category-alist))
+         (defaults (list nil '(agent-predicate . false)
+                         (cons 'agent-enable-expiration
+                               gnus-agent-enable-expiration)
+                         '(agent-days-until-old . 7)
+                         (cons 'agent-length-when-short
+                               gnus-agent-short-article)
+                         (cons 'agent-length-when-long gnus-agent-long-article)
+                         (cons 'agent-low-score gnus-agent-low-score)
+                         (cons 'agent-high-score gnus-agent-high-score))))
+ 
+     (let ((old (get-buffer "*Gnus Agent Category Customize*")))
+       (when old
+         (gnus-kill-buffer old)))
+     (switch-to-buffer (gnus-get-buffer-create
+                        "*Gnus Agent Category Customize*"))
+ 
+     (let ((inhibit-read-only t))
+       (gnus-custom-mode)
+       (buffer-disable-undo)
+ 
+       (let* ((name (gnus-agent-cat-name info)))
+         (widget-insert "Customize the Agent Category '")
+         (widget-insert (symbol-name name))
+         (widget-insert "' and press ")
+         (widget-create
+          'push-button
+          :notify
+          '(lambda (&rest ignore)
+             (let* ((info (assq gnus-agent-cat-name gnus-category-alist))
+                    (widgets category-fields))
+               (while widgets
+                 (let* ((widget (pop widgets))
+                        (value (condition-case nil (widget-value widget) 
(error))))
+                   (eval `(setf (,(widget-get widget :accessor) ',info)
+                                ',value)))))
+             (gnus-category-write)
+             (gnus-kill-buffer (current-buffer))
+             (when (get-buffer gnus-category-buffer)
+               (switch-to-buffer (get-buffer gnus-category-buffer))
+               (gnus-category-list)))
+                        "Done")
+         (widget-insert
+          "\n    Note: Empty fields default to the customizable global\
+  variables.\n\n")
+ 
+         (set (make-local-variable 'gnus-agent-cat-name)
+              name))
+ 
+       (set (make-local-variable 'category-fields) nil)
+       (gnus-agent-cat-prepare-category-field agent-predicate)
+ 
+       (gnus-agent-cat-prepare-category-field agent-score)
+       (gnus-agent-cat-prepare-category-field agent-short-article)
+       (gnus-agent-cat-prepare-category-field agent-long-article)
+       (gnus-agent-cat-prepare-category-field agent-low-score)
+       (gnus-agent-cat-prepare-category-field agent-high-score)
+ 
+       ;; The group list is NOT handled with
+       ;; gnus-agent-cat-prepare-category-field as I don't want the
+       ;; group list to appear when customizing a topic.
+       (widget-insert "\n")
+       
+       (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))))
+ 
  ;;; The End:
  
  (provide 'gnus-cus)




reply via email to

[Prev in Thread] Current Thread [Next in Thread]