Re: [patch] gnus agent

[simon@josefsson.org]

Lars Magne Ingebrigtsen <larsi@gnus.org> writes:

> > This patch make all articles eligible for agent download, filtered
> > only by predicates, instead of the hardcoded algorithm that choses
> > what to download from unread articles only.
> 
> Sounds like a good idea.  Please do apply.

It does have one problem though -- people that have configured agent
predicates will have to revise them to get the "old" behaviour, since
the patch make the default change.  They would need to add `(and (not
read) ...)' to get the same semantics.  I'm not sure anyone would
notice and/or care, but it is a change.  (That's why I'm not sure it's
good for the 5.8 series.)

And changing predicates in existing Agent groups is troublesome --
articles that was rejected by the earlier predicate are NOT eligible
for the new predicate.  One have to manually remove the Agent cache.

Many moons ago, I added a patch to solve that. It made the Agent look
at ALL articles every time you synched the Agent ('J s') but it was
taken out because it was simply too slow.

There's a better solution though -- making Agent store what predicates
is used when you synch the Agent and compare it the next time.  If the
predicate has changed, it clears the .agentview file.  This makes the
Agent go through ALL headers in the group, re-running the predicate on
all articles.

Since this would provoke a massive re-download of lots of articles
too, modifying the Agent to see if article X exist locally before
fetching it became necessery.

The following patch implement that. (It's against CVS, so it includes
the previous patch which I didn't commit yet) In addition, it does the
following too:

.  postpones unplugged GCC's until you're plugged (so you can Gcc into
   a nnimap group, for example).

.  query the user at plugin-time if she want to synchronize flags
   (user customizable by `gnus-agent-synchronize-flags'). It only happens
   if the user actually modified remote flags, so it doesn't affect nntp
   users.

.  makes the agent somewhat more verbose

Um, whad'ya'think?

2000-08-05  Simon Josefsson <simon@josefsson.org>

        Make GCC to nnimap group work when disconnected.

        * gnus-draft.el (gnus-draft-send): Call `gnus-agent-restore-gcc'.

        * gnus-agent.el (gnus-agent-possibly-do-gcc): 
        (gnus-agent-restore-gcc): 
        (gnus-agent-possibly-save-gcc): New functions.

        * gnus-msg.el (gnus-inews-add-send-actions): Use
        `gnus-agent-possibly-do-gcc' if Agentized.
        (gnus-inews-add-send-actions): Add `gnus-agent-possibly-save-gcc'
        to `message-header-hook'.

        * gnus.el (gnus-agent-gcc-header): New variable.

2000-07-13  Simon Josefsson <simon@josefsson.org>

        Asks the user to synch flags with server when you plug in.

        * gnus-agent.el (gnus-agent-synchronize-flags): New variable.
        (gnus-agent-possibly-synchronize-flags-server): New function, use it.
        (gnus-agent-toggle-plugged): Call it.
        (gnus-agent-synchronize-flags): Renamed from `gnus-agent-synchronize'.
        (gnus-agent-group-mode-map): `g-a-s' -> `g-a-s-flags'.
        (gnus-agent-possibly-synchronize-flags): New function.
        (gnus-agent-possibly-synchronize-flags-server): New function.

2000-07-13  Simon Josefsson <simon@josefsson.org>

        Changing predicates for a group re-sync Gnus status on the
        group.

        * gnus-agent.el (gnus-agent-fetch-group-1): Clean agent overview
        if predicates chanted.
        (gnus-agent-load-predicate): New function.
        (gnus-agent-write-predicate): Ditto.

Index: gnus-agent.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/lisp/gnus-agent.el,v
retrieving revision 5.55
diff -w -u -r5.55 gnus-agent.el
--- gnus-agent.el	2000/07/13 17:19:05	5.55
+++ gnus-agent.el	2000/08/14 19:33:13
@@ -83,6 +83,14 @@
   :group 'gnus-agent
   :type 'function)
 
+(defcustom gnus-agent-synchronize-flags 'ask
+  "Indicate if flags are synchronized when you plug in.
+If this is `ask' the hook will query the user."
+  :type '(choice (const :tag "Always" t)
+		 (const :tag "Never" nil)
+		 (const :tag "Ask" ask))
+  :group 'gnus-agent)
+
 ;;; Internal variables
 
 (defvar gnus-agent-history-buffers nil)
@@ -233,7 +241,7 @@
   "Jc" gnus-enter-category-buffer
   "Jj" gnus-agent-toggle-plugged
   "Js" gnus-agent-fetch-session
-  "JY" gnus-agent-synchronize
+  "JY" gnus-agent-synchronize-flags
   "JS" gnus-group-send-drafts
   "Ja" gnus-agent-add-group
   "Jr" gnus-agent-remove-group)
@@ -290,6 +298,7 @@
   (if plugged
       (progn
 	(setq gnus-plugged plugged)
+	(gnus-agent-possibly-synchronize-flags)
 	(gnus-run-hooks 'gnus-agent-plugged-hook)
 	(setcar (cdr gnus-agent-mode-status) " Plugged"))
     (gnus-agent-close-connections)
@@ -371,6 +380,27 @@
     (while (search-backward "\n" nil t)
       (replace-match "\\n" t t))))
 
+(defun gnus-agent-restore-gcc ()
+  "Restore GCC field from saved header."
+  (save-excursion
+    (goto-char (point-min))
+    (while (re-search-forward (concat gnus-agent-gcc-header ":") nil t)
+      (replace-match "Gcc:" 'fixedcase))))
+  
+(defun gnus-agent-possibly-save-gcc ()
+  "Save GCC if Gnus is unplugged."
+  (unless gnus-plugged
+    (save-excursion
+      (goto-char (point-min))
+      (let ((case-fold-search t))
+	(while (re-search-forward "^gcc:" nil t)
+	  (replace-match (concat gnus-agent-gcc-header ":") 'fixedcase))))))
+
+(defun gnus-agent-possibly-do-gcc ()
+  "Do GCC if Gnus is plugged."
+  (when gnus-plugged
+    (gnus-inews-do-gcc)))
+
 ;;;
 ;;; Group mode commands
 ;;;
@@ -425,13 +455,26 @@
 	  (setf (cadddr c) (delete group (cadddr c))))))
     (gnus-category-write)))
 
-(defun gnus-agent-synchronize ()
-  "Synchronize local, unplugged, data with backend.
-Currently sends flag setting requests, if any."
+(defun gnus-agent-synchronize-flags ()
+  "Synchronize unplugged flags with servers."
   (interactive)
   (save-excursion
     (dolist (gnus-command-method gnus-agent-covered-methods)
       (when (file-exists-p (gnus-agent-lib-file "flags"))
+	(gnus-agent-synchronize-flags-server gnus-command-method)))))
+
+(defun gnus-agent-possibly-synchronize-flags ()
+  "Synchronize flags according to `gnus-agent-synchronize-flags'."
+  (interactive)
+  (save-excursion
+    (dolist (gnus-command-method gnus-agent-covered-methods)
+      (when (file-exists-p (gnus-agent-lib-file "flags"))
+	(gnus-agent-possibly-synchronize-flags-server gnus-command-method)))))
+
+(defun gnus-agent-synchronize-flags-server (method)
+  "Synchronize flags set when unplugged for server."
+  (let ((gnus-command-method method))
+    (when (file-exists-p (gnus-agent-lib-file "flags"))
 	(set-buffer (get-buffer-create " *Gnus Agent flag synchronize*"))
 	(erase-buffer)
 	(nnheader-insert-file-contents (gnus-agent-lib-file "flags"))
@@ -444,8 +487,17 @@
 	      (write-file (gnus-agent-lib-file "flags"))
 	      (error "Couldn't set flags from file %s"
 		     (gnus-agent-lib-file "flags"))))
-	  (write-file (gnus-agent-lib-file "flags")))
-        (kill-buffer nil)))))
+	(delete-file (gnus-agent-lib-file "flags")))
+      (kill-buffer nil))))
+
+(defun gnus-agent-possibly-synchronize-flags-server (method)
+  "Synchronize flags for server according to `gnus-agent-synchronize-flags'."
+  (when (or (and gnus-agent-synchronize-flags
+		 (not (eq gnus-agent-synchronize-flags 'ask)))
+	    (and (eq gnus-agent-synchronize-flags 'ask)
+		 (gnus-y-or-n-p (format "Synchronize flags on server `%s'? " 
+					(cadr method)))))
+    (gnus-agent-synchronize-flags-server method)))
 
 ;;;
 ;;; Server mode commands
@@ -553,9 +605,8 @@
 	       (gnus-agent-method-p gnus-command-method))
       (gnus-agent-load-alist gnus-newsgroup-name)
       ;; First mark all undownloaded articles as undownloaded.
-      (let ((articles (append gnus-newsgroup-unreads
-			      gnus-newsgroup-marked
-			      gnus-newsgroup-dormant))
+      (let ((articles (gnus-uncompress-sequence 
+		       (gnus-active gnus-newsgroup-name)))
 	    article)
 	(while (setq article (pop articles))
 	  (unless (or (cdr (assq article gnus-agent-article-alist))
@@ -752,25 +803,37 @@
 
 (defun gnus-agent-fetch-articles (group articles)
   "Fetch ARTICLES from GROUP and put them into the Agent."
-  (when articles
-    ;; Prune off articles that we have already fetched.
+  (let ((dir (concat (gnus-agent-directory) (gnus-agent-group-path group) "/"))
+	(date (time-to-days (current-time)))
+	(case-fold-search t)
+	pos crosses id elem exist)
+    ;; Prune off articles that we have already fetched, and notice
+    ;; articles that (for some reason) already exist locally.
     (while (and articles
-		(cdr (assq (car articles) gnus-agent-article-alist)))
+		(or (cdr (assq (car articles) gnus-agent-article-alist))
+		    (setq exist (file-readable-p
+				 (expand-file-name
+				  (int-to-string (car articles)) dir)))))
+      (when exist
+	(setcdr (assq (car articles) gnus-agent-article-alist) t)
+	(setq exist nil))
       (pop articles))
     (let ((arts articles))
       (while (cdr arts)
-	(if (cdr (assq (cadr arts) gnus-agent-article-alist))
-	    (setcdr arts (cddr arts))
+	(if (or (cdr (assq (cadr arts) gnus-agent-article-alist))
+		(setq exist (file-readable-p
+			     (expand-file-name
+			      (int-to-string (cadr arts)) dir))))
+	    (progn
+	      (when exist
+		(setcdr (assq (cadr arts) gnus-agent-article-alist) t)
+		(setq exist nil))
+	      (setcdr arts (cddr arts)))
 	  (setq arts (cdr arts)))))
     (when articles
-      (let ((dir (concat
-		  (gnus-agent-directory)
-		  (gnus-agent-group-path group) "/"))
-	    (date (time-to-days (current-time)))
-	    (case-fold-search t)
-	    pos crosses id elem)
 	(gnus-make-directory dir)
-	(gnus-message 7 "Fetching articles for %s..." group)
+      (gnus-message 7 "Fetching articles %s for %s..." 
+		    (gnus-compress-sequence articles) group)
 	;; Fetch the articles from the backend.
 	(if (gnus-check-backend-function 'retrieve-articles group)
 	    (setq pos (gnus-retrieve-articles articles group))
@@ -820,8 +883,8 @@
 	    (gnus-agent-enter-history
 	     id (or crosses (list (cons group (caar pos)))) date)
 	    (widen)
-	    (pop pos)))
-	(gnus-agent-save-alist group)))))
+	  (pop pos))))
+    (gnus-agent-save-alist group)))
 
 (defun gnus-agent-crosspost (crosses article)
   (let (gnus-agent-article-alist group alist beg end)
@@ -868,14 +931,9 @@
       (pop gnus-agent-group-alist))))
 
 (defun gnus-agent-fetch-headers (group &optional force)
-  (let ((articles (gnus-list-of-unread-articles group))
+  (let ((articles (gnus-uncompress-range (gnus-active group)))
 	(gnus-decode-encoded-word-function 'identity)
 	(file (gnus-agent-article-name ".overview" group)))
-    ;; Add article with marks to list of article headers we want to fetch.
-    (dolist (arts (gnus-info-marks (gnus-get-info group)))
-      (setq articles (union (gnus-uncompress-sequence (cdr arts))
-			    articles)))
-    (setq articles (sort articles '<))
     ;; Remove known articles.
     (when (gnus-agent-load-alist group)
       (setq articles (gnus-sorted-intersection
@@ -935,8 +993,8 @@
 	(goto-char (point-max))
 	(insert-buffer-substring gnus-agent-overview-buffer))
     ;; We do it the hard way.
-    (nnheader-find-nov-line (car articles))
-    (gnus-agent-copy-nov-line (car articles))
+    (and (nnheader-find-nov-line (car articles))
+	 (gnus-agent-copy-nov-line (car articles)))
     (pop articles)
     (while (and articles
 		(not (eobp)))
@@ -955,6 +1013,19 @@
 	(set-buffer nntp-server-buffer)
 	(insert-buffer-substring gnus-agent-overview-buffer b e)))))
 
+(defun gnus-agent-load-predicate (group)
+  "Return the predicate used to generate .agentview file for GROUP."
+  (gnus-agent-read-file (gnus-agent-article-name ".predicate" group)))
+
+(defun gnus-agent-write-predicate (group predicate)
+  "Write the predicate used to generate .agentview file for GROUP."
+  (let ((file-name-coding-system nnmail-pathname-coding-system)
+	(file (gnus-agent-article-name ".predicate" group)))
+    (gnus-make-directory (file-name-directory file))
+    (with-temp-file file
+      (princ predicate (current-buffer))
+      (insert "\n"))))
+
 (defun gnus-agent-load-alist (group &optional dir)
   "Load the article-state alist for GROUP."
   (setq gnus-agent-article-alist
@@ -965,10 +1036,12 @@
 
 (defun gnus-agent-save-alist (group &optional articles state dir)
   "Save the article-state alist for GROUP."
-  (let ((file-name-coding-system nnmail-pathname-coding-system))
-      (with-temp-file (if dir
+  (let ((file-name-coding-system nnmail-pathname-coding-system)
+	(file (if dir
 			  (concat dir ".agentview")
-			(gnus-agent-article-name ".agentview" group))
+		(gnus-agent-article-name ".agentview" group))))
+    (gnus-make-directory (file-name-directory file))
+    (with-temp-file file
 	(princ (setq gnus-agent-article-alist
 		     (nconc gnus-agent-article-alist
 			    (mapcar (lambda (article) (cons article state))
@@ -1036,8 +1109,21 @@
 	;; Maybe some other gnus-summary local variables should also
 	;; be put here.
 	)
+    (gnus-message 9 "Agent fetching group %s..." group)
     (unless (gnus-check-group group)
       (error "Can't open server for %s" group))
+    ;; Check if predicates have changed
+    (setq category (gnus-group-category group))
+    (setq predicate
+	  (gnus-get-predicate
+	   (or (gnus-group-find-parameter group 'agent-predicate t)
+	       (cadr category))))
+    (unless (equal predicate (gnus-agent-load-predicate group))
+      (when (gnus-agent-load-alist group)
+	(gnus-message 5 "Agent predicate change detected for %s..." group))
+      (let (gnus-agent-article-alist)
+	(gnus-agent-save-alist group))
+      (gnus-agent-write-predicate group predicate))
     ;; Fetch headers.
     (when (and (or (gnus-active group) (gnus-activate-group group))
 	       (setq articles (gnus-agent-fetch-headers group))
@@ -1055,11 +1141,8 @@
 		 ;; `gnus-agent-overview-buffer' may be killed for
 		 ;; timeout reason.  If so, recreate it.
 		 (gnus-agent-create-buffer)))
-      (setq category (gnus-group-category group))
-      (setq predicate
-	    (gnus-get-predicate
-	     (or (gnus-group-find-parameter group 'agent-predicate t)
-		 (cadr category))))
+      (gnus-message 8 "Agent looking in %s at articles %s..."
+		    group (gnus-compress-sequence articles))
       ;; Do we want to download everything, or nothing?
       (if (or (eq (caaddr predicate) 'gnus-agent-true)
 	      (eq (caaddr predicate) 'gnus-agent-false))
@@ -1097,6 +1180,7 @@
 			score-method
 		      (list (list score-method)))))))
 	(when score-param
+	  (gnus-message 8 "Agent scores in group %s..." group)
 	  (gnus-score-headers score-param))
 	(setq arts nil)
 	(while (setq gnus-headers (pop gnus-newsgroup-headers))
@@ -1104,16 +1188,20 @@
 		(or (cdr (assq (mail-header-number gnus-headers)
 			       gnus-newsgroup-scored))
 		    gnus-summary-default-score))
-	  (when (funcall predicate)
-	    (push (mail-header-number gnus-headers)
-		  arts))))
+	  (if (funcall predicate)
+	      (push (mail-header-number gnus-headers) arts))))
+      (gnus-message 8 "Agent predicate accepted %s..."
+		    (gnus-compress-sequence arts)))
       ;; Fetch the articles.
       (when arts
-	(gnus-agent-fetch-articles group arts)))
+      (gnus-message 8 "Agent fetching articles %s..."
+		    (gnus-compress-sequence arts))
+      (gnus-agent-fetch-articles group arts))
     ;; Perhaps we have some additional articles to fetch.
     (setq arts (assq 'download (gnus-info-marks
 				(setq info (gnus-get-info group)))))
     (when (cdr arts)
+      (gnus-message 8 "Agent is downloading marked articles...")
       (gnus-agent-fetch-articles
        group (gnus-uncompress-range (cdr arts)))
       (setq marks (delq arts (gnus-info-marks info)))
@@ -1274,7 +1362,7 @@
   (setq gnus-category-alist
 	(or (gnus-agent-read-file
 	     (nnheader-concat gnus-agent-directory "lib/categories"))
-	    (list (list 'default 'short nil nil)))))
+	    (list (list 'default '(and short (not read)) nil nil)))))
 
 (defun gnus-category-write ()
   "Write the category alist."
@@ -1367,6 +1455,7 @@
     (long . gnus-agent-long-p)
     (low . gnus-agent-low-scored-p)
     (high . gnus-agent-high-scored-p)
+    (read . gnus-agent-read-p)
     (true . gnus-agent-true)
     (false . gnus-agent-false))
   "Mapping from short score predicate symbols to predicate functions.")
@@ -1397,6 +1486,11 @@
 (defun gnus-agent-high-scored-p ()
   "Say whether an article has a high score or not."
   (> gnus-score gnus-agent-high-score))
+
+(defun gnus-agent-read-p ()
+  "Say whether an article is read or not."
+  (gnus-member-of-range (mail-header-number gnus-headers)
+			(gnus-info-read (gnus-get-info gnus-newsgroup-name))))
 
 (defun gnus-category-make-function (cat)
   "Make a function from category CAT."
diff -w -u -r5.18 gnus-draft.el
--- lisp/gnus-draft.el  2000/04/26 16:31:37     5.18
+++ lisp/gnus-draft.el  2000/08/14 19:42:09
@@ -143,6 +143,8 @@
        (setq type (ignore-errors (read (current-buffer)))
              method (ignore-errors (read (current-buffer))))
        (message-remove-header gnus-agent-meta-information-header)))
+    ;; Let Agent restore any GCC lines and h ave message perform them.
+    (gnus-agent-restore-gcc)
     ;; Then we send it.  If we have no meta-information, we just send
     ;; it and let Message figure out how.
     (when (and (or (null method)
diff -w -u -r5.66 gnus-msg.el
--- lisp/gnus-msg.el    2000/06/25 16:49:30     5.66
+++ lisp/gnus-msg.el    2000/08/14 19:42:11
@@ -262,7 +262,11 @@
 
 (defun gnus-inews-add-send-actions (winconf buffer article)
   (make-local-hook 'message-sent-hook)
-  (add-hook 'message-sent-hook 'gnus-inews-do-gcc nil t)
+  (add-hook 'message-sent-hook (if gnus-agent 'gnus-agent-possibly-do-gcc
+                                'gnus-inews-do-gcc) nil t)
+  (when gnus-agent
+    (make-local-hook 'message-header-hook)
+    (add-hook 'message-header-hook 'gnus-agent-possibly-save-gcc nil t))
   (setq message-post-method
        `(lambda (arg)
           (gnus-post-method arg ,gnus-newsgroup-name)))
diff -w -u -r5.141 gnus.el
--- lisp/gnus.el        2000/07/13 23:11:45     5.141
+++ lisp/gnus.el        2000/08/14 19:42:16
@@ -1478,6 +1478,7 @@
 ;;; Internal variables
 
 (defvar gnus-agent-meta-information-header "X-Gnus-Agent-Meta-Information")
+(defvar gnus-agent-gcc-header "X-Gnus-Agent-Gcc")
 (defvar gnus-group-get-parameter-function 'gnus-group-get-parameter)
 (defvar gnus-original-article-buffer " *Original Article*")
 (defvar gnus-newsgroup-name nil)