:group 'gnus-agent
:type 'integer)
+(defcustom gnus-agent-expire-all nil
+ "If non-nil, also expire unread, ticked and dormant articles.
+If nil, only read articles will be expired."
+ :group 'gnus-agent
+ :type 'boolean)
+
+(defcustom gnus-agent-group-mode-hook nil
+ "Hook run in Agent group minor modes."
+ :group 'gnus-agent
+ :type 'hook)
+
+(defcustom gnus-agent-summary-mode-hook nil
+ "Hook run in Agent summary minor modes."
+ :group 'gnus-agent
+ :type 'hook)
+
+(defcustom gnus-agent-server-mode-hook nil
+ "Hook run in Agent summary minor modes."
+ :group 'gnus-agent
+ :type 'hook)
+
;;; Internal variables
(defvar gnus-agent-history-buffers nil)
buffer))))
minor-mode-map-alist))
(gnus-agent-toggle-plugged gnus-plugged)
- (gnus-run-hooks 'gnus-agent-mode-hook)))
+ (gnus-run-hooks 'gnus-agent-mode-hook
+ (intern (format "gnus-agent-%s-mode-hook" buffer)))))
(defvar gnus-agent-group-mode-map (make-sparse-keymap))
(gnus-define-keys gnus-agent-group-mode-map
groups group gnus-command-method)
(save-excursion
(while methods
- (setq gnus-command-method (car methods)
- groups (gnus-groups-from-server (pop methods)))
- (gnus-agent-with-fetch
- (while (setq group (pop groups))
- (when (<= (gnus-group-level group) gnus-agent-handle-level)
- (gnus-agent-fetch-group-1 group gnus-command-method)))))
+ (setq gnus-command-method (car methods))
+ (when (or (gnus-server-opened gnus-command-method)
+ (gnus-open-server gnus-command-method))
+ (setq groups (gnus-groups-from-server (pop methods)))
+ (gnus-agent-with-fetch
+ (while (setq group (pop groups))
+ (when (<= (gnus-group-level group) gnus-agent-handle-level)
+ (gnus-agent-fetch-group-1 group gnus-command-method))))))
(gnus-message 6 "Finished fetching articles into the Gnus agent"))))
(defun gnus-agent-fetch-group-1 (group method)
(defun gnus-agent-high-scored-p ()
"Say whether an article has a high score or not."
- (> gnus-score gnus-agent-low-score))
+ (> gnus-score gnus-agent-high-score))
(defun gnus-category-make-function (cat)
"Make a function from category CAT."
(set-buffer
(setq gnus-agent-current-history
(setq history (gnus-agent-history-buffer))))
- (goto-char (point-min))
- (while (not (eobp))
- (skip-chars-forward "^\t")
- (if (> (read (current-buffer)) day)
- ;; New article; we don't expire it.
- (forward-line 1)
- ;; Old article. Schedule it for possible nuking.
- (while (not (eolp))
- (setq sym (let ((obarray expiry-hashtb))
- (read (current-buffer))))
- (if (boundp sym)
- (set sym (cons (cons (read (current-buffer)) (point))
- (symbol-value sym)))
- (set sym (list (cons (read (current-buffer)) (point)))))
- (skip-chars-forward " "))
- (forward-line 1)))
- ;; We now have all articles that can possibly be expired.
- (mapatoms
- (lambda (sym)
- (setq group (symbol-name sym)
- articles (sort (symbol-value sym) 'car-less-than-car)
- low (car (gnus-active group))
- info (gnus-get-info group)
- unreads (ignore-errors (gnus-list-of-unread-articles group))
- marked (nconc (gnus-uncompress-range
- (cdr (assq 'ticked (gnus-info-marks info))))
- (gnus-uncompress-range
- (cdr (assq 'dormant (gnus-info-marks info)))))
- nov-file (gnus-agent-article-name ".overview" group))
- (gnus-message 5 "Expiring articles in %s" group)
- (set-buffer overview)
- (erase-buffer)
- (when (file-exists-p nov-file)
- (nnheader-insert-file-contents nov-file))
- (goto-char (point-min))
- (while (setq elem (pop articles))
- (setq article (car elem))
- (when (or (null low)
- (< article low)
- (and (not (memq article unreads))
- (not (memq article marked))))
- ;; Find and nuke the NOV line.
- (while (and (not (eobp))
- (< (setq art (read (current-buffer))) article))
- (forward-line 1))
- (if (or (eobp)
- (/= art article))
- (beginning-of-line)
- (gnus-delete-line))
- ;; Nuke the article.
- (when (file-exists-p (setq file (gnus-agent-article-name
- (number-to-string article)
- group)))
- (delete-file file))
- ;; Schedule the history line for nuking.
- (push (cdr elem) histories)))
- (write-region (point-min) (point-max) nov-file nil 'silent))
- expiry-hashtb)
- (set-buffer history)
- (setq histories (nreverse (sort histories '<)))
- (while histories
- (goto-char (pop histories))
- (gnus-delete-line))
- (gnus-agent-save-history)
- (gnus-agent-close-history)))))
+ (unless (zerop (buffer-size))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (skip-chars-forward "^\t")
+ (if (> (read (current-buffer)) day)
+ ;; New article; we don't expire it.
+ (forward-line 1)
+ ;; Old article. Schedule it for possible nuking.
+ (while (not (eolp))
+ (setq sym (let ((obarray expiry-hashtb))
+ (read (current-buffer))))
+ (if (boundp sym)
+ (set sym (cons (cons (read (current-buffer)) (point))
+ (symbol-value sym)))
+ (set sym (list (cons (read (current-buffer)) (point)))))
+ (skip-chars-forward " "))
+ (forward-line 1)))
+ ;; We now have all articles that can possibly be expired.
+ (mapatoms
+ (lambda (sym)
+ (setq group (symbol-name sym)
+ articles (sort (symbol-value sym) 'car-less-than-car)
+ low (car (gnus-active group))
+ info (gnus-get-info group)
+ unreads (ignore-errors (gnus-list-of-unread-articles group))
+ marked (nconc (gnus-uncompress-range
+ (cdr (assq 'ticked (gnus-info-marks info))))
+ (gnus-uncompress-range
+ (cdr (assq 'dormant
+ (gnus-info-marks info)))))
+ nov-file (gnus-agent-article-name ".overview" group))
+ (gnus-message 5 "Expiring articles in %s" group)
+ (set-buffer overview)
+ (erase-buffer)
+ (when (file-exists-p nov-file)
+ (nnheader-insert-file-contents nov-file))
+ (goto-char (point-min))
+ (while (setq elem (pop articles))
+ (setq article (car elem))
+ (when (or (null low)
+ (< article low)
+ gnus-agent-expire-all
+ (and (not (memq article unreads))
+ (not (memq article marked))))
+ ;; Find and nuke the NOV line.
+ (while (and (not (eobp))
+ (< (setq art (read (current-buffer))) article))
+ (forward-line 1))
+ (if (or (eobp)
+ (/= art article))
+ (beginning-of-line)
+ (gnus-delete-line))
+ ;; Nuke the article.
+ (when (file-exists-p (setq file (gnus-agent-article-name
+ (number-to-string article)
+ group)))
+ (delete-file file))
+ ;; Schedule the history line for nuking.
+ (push (cdr elem) histories)))
+ (write-region (point-min) (point-max) nov-file nil 'silent))
+ expiry-hashtb)
+ (set-buffer history)
+ (setq histories (nreverse (sort histories '<)))
+ (while histories
+ (goto-char (pop histories))
+ (gnus-delete-line))
+ (gnus-agent-save-history)
+ (gnus-agent-close-history))
+ (gnus-message 4 "Expiry...done")))))
;;;###autoload
(defun gnus-agent-batch ()