From: akr Date: Thu, 23 Apr 1998 17:00:01 +0000 (+0000) Subject: Sync up with main trunc. X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=cb9a5c91719df5ed269597c6e48293dbf80acc23;p=elisp%2Fgnus.git- Sync up with main trunc. --- diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 72bbab1..d616263 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -54,6 +54,27 @@ :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) @@ -181,7 +202,8 @@ 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 @@ -822,12 +844,14 @@ the actual number of articles toggled is returned." 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) @@ -1149,7 +1173,7 @@ The following commands are available: (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." @@ -1220,71 +1244,75 @@ The following commands are available: (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 ()