diff lisp/gnus/gnus-agent.el @ 32985:2e19cd4c5909

2000-10-27 Simon Josefsson <[e-mail]> * gnus-agent.el (gnus-agent-possibly-do-gcc): (gnus-agent-restore-gcc): (gnus-agent-possibly-save-gcc): New functions. 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-10-27 ShengHuo ZHU <[e-mail]> * gnus.el (gnus-xmas-define): Defalias gnus-overlay-buffer, gnus-overlay-start. * gnus.el (gnus-agent-fetching): New variable. * gnus-agent.el (gnus-agent-with-fetch): Bind it. * gnus-agent.el (gnus-agent-fetch-session): Catch quit. (gnus-agent-fetch-group-1): Score-param could be nil. (gnus-agent-any-covered-gcc): New function. (gnus-agent-possibly-save-gcc): Use it. (gnus-agent-possibly-do-gcc): Ditto. * gnus-agent.el: Revoke Mike McEwan's 1998-09-05 patch due to the GNU assignment issue. (gnus-agent-fetch-group-1): Reimplement Mike McEwan's proposal. * gnus-agent.el: timer vs. itimer.

--- a/lisp/gnus/gnus-agent.el	Fri Oct 27 19:24:25 2000 +0000
+++ b/lisp/gnus/gnus-agent.el	Fri Oct 27 19:48:11 2000 +0000
@@ -2,6 +2,7 @@
 ;; Copyright (C) 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <[e-mail]>
+;; Maintainer: [e-mail]
 ;; This file is part of GNU Emacs.
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
@@ -27,10 +28,12 @@
 (require 'gnus-cache)
 (require 'nnvirtual)
 (require 'gnus-sum)
+(require 'gnus-score)
 (eval-when-compile
-  (require 'timer)
-  (require 'cl)
-  (require 'gnus-score))
+  (if (featurep 'xemacs)
+      (require 'itimer)
+    (require 'timer))
+  (require 'cl))
 
 (defcustom gnus-agent-directory (nnheader-concat gnus-directory "agent/")
   "Where the Gnus agent will store its files."
@@ -83,6 +86,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)
@@ -100,10 +111,6 @@
 (defvar gnus-agent-send-mail-function nil)
 (defvar gnus-agent-file-coding-system 'raw-text)
 
-(defconst gnus-agent-scoreable-headers
-  '("subject" "from" "date" "message-id" "references" "chars" "lines" "xref")
-  "Headers that are considered when scoring articles for download via the Agent.")
-
 ;; Dynamic variables
 (defvar gnus-headers)
 (defvar gnus-score)
@@ -186,7 +193,7 @@
 (defmacro gnus-agent-with-fetch (&rest forms)
   "Do FORMS safely."
   `(unwind-protect
-       (progn
+       (let ((gnus-agent-fetching t))
 	 (gnus-agent-start-fetch)
 	 ,@forms)
      (gnus-agent-stop-fetch)))
@@ -233,7 +240,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 +297,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 +379,43 @@
     (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-any-covered-gcc ()
+  (save-restriction
+    (message-narrow-to-headers)
+    (let* ((gcc (mail-fetch-field "gcc" nil t))
+	   (methods (and gcc 
+			 (mapcar 'gnus-inews-group-method
+				 (message-unquote-tokens
+				  (message-tokenize-header 
+				   gcc " ,")))))
+	   covered)
+      (while (and (not covered) methods)
+	(setq covered
+	      (member (car methods) gnus-agent-covered-methods)
+	      methods (cdr methods)))
+      covered)))
+
+(defun gnus-agent-possibly-save-gcc ()
+  "Save GCC if Gnus is unplugged."
+  (when (and (not gnus-plugged) (gnus-agent-any-covered-gcc))
+    (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 (or gnus-plugged (not (gnus-agent-any-covered-gcc)))
+    (gnus-inews-do-gcc)))
+
 ;;;
 ;;; Group mode commands
 ;;;
@@ -425,27 +470,49 @@
 	  (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"))
-	(set-buffer (get-buffer-create " *Gnus Agent flag synchronize*"))
-	(erase-buffer)
-	(nnheader-insert-file-contents (gnus-agent-lib-file "flags"))
-	(if (null (gnus-check-server gnus-command-method))
-	    (message "Couldn't open server %s" (nth 1 gnus-command-method))
-	  (while (not (eobp))
-	    (if (null (eval (read (current-buffer))))
-		(progn (forward-line)
-		       (kill-line -1))
-	      (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)))))
+	(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"))
+      (if (null (gnus-check-server gnus-command-method))
+	  (message "Couldn't open server %s" (nth 1 gnus-command-method))
+	(while (not (eobp))
+	  (if (null (eval (read (current-buffer))))
+	      (progn (forward-line)
+		     (kill-line -1))
+	    (write-file (gnus-agent-lib-file "flags"))
+	    (error "Couldn't set flags from file %s"
+		   (gnus-agent-lib-file "flags"))))
+	(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
@@ -1034,7 +1101,11 @@
 	  (error 
 	   (unless (funcall gnus-agent-confirmation-function
 			    (format "Error (%s).  Continue? " err))
-	     (error "Cannot fetch articles into the Gnus agent."))))
+	     (error "Cannot fetch articles into the Gnus agent.")))
+	  (quit 
+	   (unless (funcall gnus-agent-confirmation-function
+			    (format "Quit (%s).  Continue? " err))
+	     (signal 'quit "Cannot fetch articles into the Gnus agent."))))
 	(pop methods))
       (gnus-message 6 "Finished fetching articles into the Gnus agent"))))
 
@@ -1057,17 +1128,13 @@
     ;; Fetch headers.
     (when (and (or (gnus-active group) (gnus-activate-group group))
 	       (setq articles (gnus-agent-fetch-headers group))
-	       (progn
+	       (let ((nntp-server-buffer gnus-agent-overview-buffer))
 		 ;; Parse them and see which articles we want to fetch.
 		 (setq gnus-newsgroup-dependencies
 		       (make-vector (length articles) 0))
-		 ;; No need to call `gnus-get-newsgroup-headers-xover' with
-		 ;; the entire .overview for group as we still have the just
-		 ;; downloaded headers in `gnus-agent-overview-buffer'.
-		 (let ((nntp-server-buffer gnus-agent-overview-buffer))
-		   (setq gnus-newsgroup-headers
-			 (gnus-get-newsgroup-headers-xover articles nil nil 
-							   group)))
+		 (setq gnus-newsgroup-headers
+		       (gnus-get-newsgroup-headers-xover articles nil nil 
+							 group))
 		 ;; `gnus-agent-overview-buffer' may be killed for
 		 ;; timeout reason.  If so, recreate it.
 		 (gnus-agent-create-buffer)))
@@ -1076,45 +1143,24 @@
 	    (gnus-get-predicate
 	     (or (gnus-group-find-parameter group 'agent-predicate t)
 		 (cadr category))))
-      ;; Do we want to download everything, or nothing?
-      (if (or (eq (caaddr predicate) 'gnus-agent-true)
-	      (eq (caaddr predicate) 'gnus-agent-false))
-	  ;; Yes.
-	  (setq arts (symbol-value
-		      (cadr (assoc (caaddr predicate)
-				   '((gnus-agent-true articles)
-				     (gnus-agent-false nil))))))
-	;; No, we need to decide what we want.
+      (if (memq (caaddr predicate) '(gnus-agent-true gnus-agent-false))
+	  ;; Simple implementation
+	  (setq arts
+		(and (eq (caaddr predicate) 'gnus-agent-true) articles))
+	(setq arts nil)
 	(setq score-param
-	      (let ((score-method
-		     (or
-		      (gnus-group-find-parameter group 'agent-score t)
-		      (caddr category))))
-		(when score-method
-		  (require 'gnus-score)
-		  (if (eq score-method 'file)
-		      (let ((entries
-			     (gnus-score-load-files
-			      (gnus-all-score-files group)))
-			    list score-file)
-			(while (setq list (car entries))
-			  (push (car list) score-file)
-			  (setq list (cdr list))
-			  (while list
-			    (when (member (caar list)
-					  gnus-agent-scoreable-headers)
-			      (push (car list) score-file))
-			    (setq list (cdr list)))
-			  (setq score-param
-				(append score-param (list (nreverse score-file)))
-				score-file nil entries (cdr entries)))
-			(list score-param))
-		    (if (stringp (car score-method))
-			score-method
-		      (list (list score-method)))))))
+	      (or (gnus-group-get-parameter group 'agent-score t)
+		  (caddr category)))
+	;; Translate score-param into real one
+	(cond
+	 ((not score-param))
+	 ((eq score-param 'file)
+	  (setq score-param (gnus-all-score-files group)))
+	 ((stringp (car score-param)))
+	 (t
+	  (setq score-param (list (list score-param)))))
 	(when score-param
 	  (gnus-score-headers score-param))
-	(setq arts nil)
 	(while (setq gnus-headers (pop gnus-newsgroup-headers))
 	  (setq gnus-score
 		(or (cdr (assq (mail-header-number gnus-headers)