Synch to No Gnus 200501120840.
[elisp/gnus.git-] / lisp / gnus-agent.el
index 3547079..dde79ca 100644 (file)
@@ -63,6 +63,7 @@
 
 (defcustom gnus-agent-fetched-hook nil
   "Hook run when finished fetching articles."
+  :version "21.4"
   :group 'gnus-agent
   :type 'hook)
 
@@ -124,7 +125,7 @@ fetched will be limited to it. If not a positive integer, never consider it."
   :type '(choice (const nil)
                 (integer :tag "Number")))
 
-(defcustom gnus-agent-synchronize-flags 'ask
+(defcustom gnus-agent-synchronize-flags nil
   "Indicate if flags are synchronized when you plug in.
 If this is `ask' the hook will query the user."
   :version "21.1"
@@ -136,7 +137,7 @@ If this is `ask' the hook will query the user."
 (defcustom gnus-agent-go-online 'ask
   "Indicate if offline servers go online when you plug in.
 If this is `ask' the hook will query the user."
-  :version "21.1"
+  :version "21.3"
   :type '(choice (const :tag "Always" t)
                 (const :tag "Never" nil)
                 (const :tag "Ask" ask))
@@ -170,6 +171,7 @@ read articles as they would just be downloaded again."
   "Chunk size for `gnus-agent-fetch-session'.
 The function will split its article fetches into chunks smaller than
 this limit."
+  :version "21.4"
   :group 'gnus-agent
   :type 'integer)
 
@@ -180,6 +182,7 @@ contents from a group's local storage.  This value may be overridden
 to disable expiration in specific categories, topics, and groups.  Of
 course, you could change gnus-agent-enable-expiration to DISABLE then
 enable expiration per categories, topics, and groups."
+  :version "21.4"
   :group 'gnus-agent
   :type '(radio (const :format "Enable " ENABLE)
                 (const :format "Disable " DISABLE)))
@@ -189,6 +192,7 @@ enable expiration per categories, topics, and groups."
 Have gnus-agent-expire scan the directories under
 \(gnus-agent-directory) for groups that are no longer agentized.
 When found, offer to remove them."
+  :version "21.4"
   :type 'boolean
   :group 'gnus-agent)
 
@@ -196,6 +200,7 @@ When found, offer to remove them."
   "Initially, all servers from these methods are agentized.
 The user may remove or add servers using the Server buffer.
 See Info node `(gnus)Server Buffer'."
+  :version "21.4"
   :type '(repeat symbol)
   :group 'gnus-agent)
 
@@ -203,6 +208,7 @@ See Info node `(gnus)Server Buffer'."
   "Whether and when outgoing mail should be queued by the agent.
 When `always', always queue outgoing mail.  When nil, never
 queue.  Otherwise, queue if and only if unplugged."
+  :version "21.4"
   :group 'gnus-agent
   :type '(radio (const :format "Always" always)
                (const :format "Never" nil)
@@ -211,6 +217,7 @@ queue.  Otherwise, queue if and only if unplugged."
 (defcustom gnus-agent-prompt-send-queue nil
   "If non-nil, `gnus-group-send-queue' will prompt if called when
 unplugged."
+  :version "21.4"
   :group 'gnus-agent
   :type 'boolean)
 
@@ -827,25 +834,39 @@ be a select method."
   (interactive)
   (save-excursion
     (dolist (gnus-command-method (gnus-agent-covered-methods))
-      (when (file-exists-p (gnus-agent-lib-file "flags"))
+      (when (and (file-exists-p (gnus-agent-lib-file "flags"))
+                (not (eq (gnus-server-status gnus-command-method) 'offline)))
        (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))
+  (let ((gnus-command-method method)
+       (gnus-agent nil))
     (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))
-         (gnus-message 1 "Couldn't open server %s" (nth 1 gnus-command-method))
-       (while (not (eobp))
-         (if (null (eval (read (current-buffer))))
-             (gnus-delete-line)
-           (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")))
+      (cond ((null gnus-plugged)
+            (gnus-message 
+             1 "You must be plugged to synchronize flags with server %s" 
+             (nth 1 gnus-command-method)))
+           ((null (gnus-check-server gnus-command-method))
+            (gnus-message 
+             1 "Couldn't open server %s" (nth 1 gnus-command-method)))
+           (t
+            (condition-case err
+                (while t
+                  (let ((bgn (point)))
+                    (eval (read (current-buffer)))
+                    (delete-region bgn (point))))
+              (end-of-file
+               (delete-file (gnus-agent-lib-file "flags")))
+              (error
+               (let ((file (gnus-agent-lib-file "flags")))
+                 (write-region (point-min) (point-max)
+                               (gnus-agent-lib-file "flags") nil 'silent)
+                 (error "Couldn't set flags from file %s due to %s"
+                        file (error-message-string err)))))))
       (kill-buffer nil))))
 
 (defun gnus-agent-possibly-synchronize-flags-server (method)
@@ -896,7 +917,7 @@ next enabled. Depends upon the caller to determine whether group deletion is sup
         (path           (directory-file-name
                          (let (gnus-command-method command-method)
                            (gnus-agent-group-pathname group)))))
-    (gnus-delete-file path)
+    (gnus-delete-directory path)
 
     (let* ((real-group (gnus-group-real-name group)))
       (gnus-agent-save-group-info command-method real-group nil)
@@ -1201,6 +1222,49 @@ This can be added to `gnus-select-article-hook' or
 ;;; Internal functions
 ;;;
 
+(defun gnus-agent-synchronize-group-flags (group actions server)
+"Update a plugged group by performing the indicated actions."
+  (let* ((gnus-command-method (gnus-server-to-method server))
+        (info
+         ;; This initializer is required as gnus-request-set-mark
+         ;; calls gnus-group-real-name to strip off the host name
+         ;; before calling the backend.  Now that the backend is
+         ;; trying to call gnus-request-set-mark, I have to
+         ;; reconstruct the original group name.
+         (or (gnus-get-info group)
+             (gnus-get-info 
+              (setq group (gnus-group-full-name 
+                           group gnus-command-method))))))
+    (gnus-request-set-mark group actions)
+
+    (when info
+      (dolist (action actions)
+       (let ((range (nth 0 action))
+             (what  (nth 1 action))
+             (marks (nth 2 action)))
+         (dolist (mark marks)
+           (cond ((eq mark 'read)
+                  (gnus-info-set-read 
+                   info
+                   (funcall (if (eq what 'add)
+                                'gnus-range-add
+                              'gnus-remove-from-range)
+                            (gnus-info-read info)
+                            range))
+                  (gnus-get-unread-articles-in-group 
+                   info
+                   (gnus-active (gnus-info-group info))))
+                 ((memq mark '(tick))
+                  (let ((info-marks (assoc mark (gnus-info-marks info))))
+                    (unless info-marks
+                      (gnus-info-set-marks info (cons (setq info-marks (list mark)) (gnus-info-marks info))))
+                    (setcdr info-marks (funcall (if (eq what 'add)
+                                 'gnus-range-add
+                               'gnus-remove-from-range)
+                             (cdr info-marks)
+                             range)))))))))
+    nil))
+
 (defun gnus-agent-save-active (method)
   (when (gnus-agent-method-p method)
     (let* ((gnus-command-method method)
@@ -1333,7 +1397,7 @@ downloaded into the agent."
         (nnheader-translate-file-chars
          (nnheader-replace-duplicate-chars-in-string
           (nnheader-replace-chars-in-string 
-           (gnus-group-real-name group)
+           (gnus-group-real-name (gnus-group-decoded-name group))
            ?/ ?_)
           ?. ?_)))
   (if (or nnmail-use-long-file-names
@@ -1350,7 +1414,9 @@ downloaded into the agent."
   ;; while plugged.
   (let ((gnus-command-method (or gnus-command-method
                                  (gnus-find-method-for-group group))))
-    (nnmail-group-pathname (gnus-group-real-name group) (gnus-agent-directory))))
+    (nnmail-group-pathname (gnus-group-real-name
+                           (gnus-group-decoded-name group))
+                          (gnus-agent-directory))))
 
 (defun gnus-agent-get-function (method)
   (if (gnus-online method)
@@ -1631,7 +1697,7 @@ and that there are no duplicates."
                   (setq backed-up (gnus-agent-backup-overview-buffer)))
               (gnus-message 1
                            "Duplicate overview line for %d" cur)
-             (delete-region (point) (progn (forward-line 1) (point))))
+             (delete-region p (progn (forward-line 1) (point))))
             ((< cur prev-num)
              (or backed-up
                   (setq backed-up (gnus-agent-backup-overview-buffer)))
@@ -3861,7 +3927,7 @@ entry of article %s deleted." l1))
                             gnus-agent-article-alist))))
 
        (when regenerated
-           (gnus-agent-update-files-total-fetched-for group nil)))
+         (gnus-agent-update-files-total-fetched-for group nil)))
 
       (gnus-message 5 "")
       regenerated)))