projects / elisp / gnus.git- / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Synch to No Gnus 200409220316.
[elisp/gnus.git-] / lisp / gnus-int.el
diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el
index 49c9ed6..c5bf584 100644 (file)
--- a/lisp/gnus-int.el
+++ b/lisp/gnus-int.el
@@ -34,6 +34,7 @@
 (require 'gnus-range)
 
 (autoload 'gnus-agent-expire "gnus-agent")
+(autoload 'gnus-agent-regenerate-group "gnus-agent")
 (autoload 'gnus-agent-read-servers-validate-native "gnus-agent")
 
 (defcustom gnus-open-server-hook nil
@@ -47,11 +48,19 @@ If the server is covered by Gnus agent, the possible values are
 `denied', set the server denied; `offline', set the server offline;
 nil, ask user.  If the server is not covered by Gnus agent, set the
 server denied."
+  :version "21.4"
   :group 'gnus-start
   :type '(choice (const :tag "Ask" nil)
                 (const :tag "Deny server" denied)
                 (const :tag "Unplug Agent" offline)))
 
+(defcustom gnus-servers-that-use-local-marks '(nntp)
+  "A list of backends that store marks locally.  This means that
+  the backend is used to set its marks even when unplugged."
+  :version "21.4"
+  :group 'gnus-start
+  :type '(repeat symbol))
+
 (defvar gnus-internal-registry-spool-current-method nil
   "The current method, for the registry.")
 
@@ -73,7 +82,7 @@ If CONFIRM is non-nil, the user will be asked for an NNTP server."
        ;; Read server name with completion.
        (setq gnus-nntp-server
              (completing-read "NNTP server: "
-                              (mapcar (lambda (server) (list server))
+                              (mapcar 'list
                                       (cons (list gnus-nntp-server)
                                             gnus-secondary-servers))
                               nil nil gnus-nntp-server)))
@@ -176,7 +185,7 @@ If it is down, start it up (again)."
     (setq method (gnus-server-to-method method)))
   ;; Check cache of constructed names.
   (let* ((method-sym (if gnus-agent
-                        (gnus-agent-get-function method)
+                        (inline (gnus-agent-get-function method))
                       (car method)))
         (method-fns (get method-sym 'gnus-method-functions))
         (func (let ((method-fnlist-elt (assq function method-fns)))
@@ -338,7 +347,7 @@ name.  The method this group uses will be queried."
     (when (stringp gnus-command-method)
       (setq gnus-command-method
            (inline (gnus-server-to-method gnus-command-method))))
-    (funcall (inline (gnus-get-function gnus-command-method 'request-group))
+        (funcall (inline (gnus-get-function gnus-command-method 'request-group))
             (gnus-group-real-name group) (nth 1 gnus-command-method)
             dont-check)))
 
@@ -412,7 +421,10 @@ If FETCH-OLD, retrieve all headers (or some subset thereof) in the group."
 
 (defun gnus-request-set-mark (group action)
   "Set marks on articles in the back end."
-  (let ((gnus-command-method (gnus-find-method-for-group group)))
+  (let* ((gnus-command-method (gnus-find-method-for-group group))
+        (gnus-plugged (or gnus-plugged 
+                          (member (car gnus-command-method)
+                                  gnus-servers-that-use-local-marks))))
     (if (not (gnus-check-backend-function
              'request-set-mark (car gnus-command-method)))
        action
@@ -422,7 +434,10 @@ If FETCH-OLD, retrieve all headers (or some subset thereof) in the group."
 
 (defun gnus-request-update-mark (group article mark)
   "Allow the back end to change the mark the user tries to put on an article."
-  (let ((gnus-command-method (gnus-find-method-for-group group)))
+  (let* ((gnus-command-method (gnus-find-method-for-group group))
+        (gnus-plugged (or gnus-plugged 
+                          (member (car gnus-command-method)
+                                  gnus-servers-that-use-local-marks))))
     (if (not (gnus-check-backend-function
              'request-update-mark (car gnus-command-method)))
        mark
@@ -517,12 +532,11 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
         (if group (gnus-find-method-for-group group) gnus-command-method))
        (gnus-inhibit-demon t)
        (mail-source-plugged gnus-plugged))
-    (if (or gnus-plugged (not (gnus-agent-method-p gnus-command-method)))
-       (progn
-         (setq gnus-internal-registry-spool-current-method gnus-command-method)
-         (funcall (gnus-get-function gnus-command-method 'request-scan)
-                  (and group (gnus-group-real-name group))
-                  (nth 1 gnus-command-method))))))
+    (when (or gnus-plugged (not (gnus-agent-method-p gnus-command-method)))
+      (setq gnus-internal-registry-spool-current-method gnus-command-method)
+      (funcall (gnus-get-function gnus-command-method 'request-scan)
+              (and group (gnus-group-real-name group))
+              (nth 1 gnus-command-method)))))
 
 (defsubst gnus-request-update-info (info gnus-command-method)
   "Request that GNUS-COMMAND-METHOD update INFO."
@@ -570,7 +584,7 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
                          (nth 1 gnus-command-method) accept-function last)))
     (when (and result gnus-agent
               (gnus-agent-method-p gnus-command-method))
-      (gnus-agent-expire (list article) group 'force))
+      (gnus-agent-unfetch-articles group (list article)))
     result))
 
 (defun gnus-request-accept-article (group &optional gnus-command-method last
@@ -580,21 +594,30 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
     (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
   (when (and (not gnus-command-method)
             (stringp group))
-    (setq gnus-command-method (gnus-group-name-to-method group)))
+    (setq gnus-command-method (or (gnus-find-method-for-group group)
+                                  (gnus-group-name-to-method group))))
   (goto-char (point-max))
   (unless (bolp)
     (insert "\n"))
   (let ((gnus-command-method (or gnus-command-method
-                                (gnus-find-method-for-group group))))
-    (funcall (gnus-get-function gnus-command-method 'request-accept-article)
-            (if (stringp group) (gnus-group-real-name group) group)
-            (cadr gnus-command-method)
-            last)))
+                                (gnus-find-method-for-group group)))
+       (result 
+        (funcall 
+         (gnus-get-function gnus-command-method 'request-accept-article)
+         (if (stringp group) (gnus-group-real-name group) group)
+         (cadr gnus-command-method)
+         last)))
+    (when (and gnus-agent (gnus-agent-method-p gnus-command-method))
+      (gnus-agent-regenerate-group group (list (cdr result))))
+    result))
 
 (defun gnus-request-replace-article (article group buffer &optional no-encode)
-  (let ((func (car (gnus-group-name-to-method group))))
-    (funcall (intern (format "%s-request-replace-article" func))
-            article (gnus-group-real-name group) buffer)))
+  (let* ((func (car (gnus-group-name-to-method group)))
+        (result (funcall (intern (format "%s-request-replace-article" func))
+                         article (gnus-group-real-name group) buffer)))
+    (when (and gnus-agent (gnus-agent-method-p gnus-command-method))
+      (gnus-agent-regenerate-group group (list article)))
+    result))
 
 (defun gnus-request-associate-buffer (group)
   (let ((gnus-command-method (gnus-find-method-for-group group)))
@@ -617,15 +640,25 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
             (gnus-group-real-name group) (nth 1 gnus-command-method) args)))
 
 (defun gnus-request-delete-group (group &optional force)
-  (let ((gnus-command-method (gnus-find-method-for-group group)))
-    (funcall (gnus-get-function gnus-command-method 'request-delete-group)
-            (gnus-group-real-name group) force (nth 1 gnus-command-method))))
+  (let* ((gnus-command-method (gnus-find-method-for-group group))
+        (result
+         (funcall (gnus-get-function gnus-command-method 'request-delete-group)
+                  (gnus-group-real-name group) force (nth 1 gnus-command-method))))
+    (when result
+      (gnus-cache-delete-group group)
+      (gnus-agent-delete-group group))
+    result))
 
 (defun gnus-request-rename-group (group new-name)
-  (let ((gnus-command-method (gnus-find-method-for-group group)))
-    (funcall (gnus-get-function gnus-command-method 'request-rename-group)
-            (gnus-group-real-name group)
-            (gnus-group-real-name new-name) (nth 1 gnus-command-method))))
+  (let* ((gnus-command-method (gnus-find-method-for-group group))
+        (result
+         (funcall (gnus-get-function gnus-command-method 'request-rename-group)
+                  (gnus-group-real-name group)
+                  (gnus-group-real-name new-name) (nth 1 gnus-command-method))))
+    (when result
+      (gnus-cache-rename-group group new-name)
+      (gnus-agent-rename-group group new-name))
+    result))
 
 (defun gnus-close-backends ()
   ;; Send a close request to all backends that support such a request.