Function: gnus-agent-customize-category

gnus-agent-customize-category is an autoloaded, interactive and byte-compiled function defined in gnus-cus.el.gz.

Signature

(gnus-agent-customize-category CATEGORY)

Documentation

Edit the CATEGORY.

Key Bindings

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/gnus-cus.el.gz
(defun gnus-agent-customize-category (category)
  "Edit the CATEGORY."
  (interactive (list (gnus-category-name)) gnus-custom-mode)
  (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))))

    (gnus-kill-buffer "*Gnus Agent Category Customize*")
    (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)
                       t))))
           (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")

        (setq-local gnus-agent-cat-name name))

      (setq-local 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))))