Sync up with main trunc. unlabeled-1.6.2
authorakr <akr>
Thu, 23 Apr 1998 17:00:01 +0000 (17:00 +0000)
committerakr <akr>
Thu, 23 Apr 1998 17:00:01 +0000 (17:00 +0000)
lisp/gnus-agent.el

index 72bbab1..d616263 100644 (file)
   :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
@@ -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 ()