Import Oort Gnus v0.09.

[elisp/gnus.git-] / lisp / gnus-int.el

diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el
index 91c687a..da22bb5 100644 (file)
--- a/lisp/gnus-int.el
+++ b/lisp/gnus-int.el
@@ -35,12 +35,16 @@
   :group 'gnus-start
   :type 'hook)
 
   :group 'gnus-start
   :type 'hook)
 

-(defvar gnus-server-unopen-status nil
+(defcustom gnus-server-unopen-status nil

   "The default status if the server is not able to open.
 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
   "The default status if the server is not able to open.
 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.")
+server denied."
+  :group 'gnus-start
+  :type '(choice (const :tag "Ask" nil)
+                (const :tag "Deny server" denied)
+                (const :tag "Unplugg Agent" offline)))

 
 ;;;
 ;;; Server Communication
 
 ;;;
 ;;; Server Communication

@@ -202,16 +206,16 @@ If it is down, start it up (again)."
          (setq elem (list gnus-command-method nil)
                gnus-opened-servers (cons elem gnus-opened-servers)))
        ;; Set the status of this server.
          (setq elem (list gnus-command-method nil)
                gnus-opened-servers (cons elem gnus-opened-servers)))
        ;; Set the status of this server.

-       (setcar (cdr elem) 
-               (if result 
+       (setcar (cdr elem)
+               (if result

                    (if (eq (cadr elem) 'offline)
                        'offline
                      'ok)
                    (if (eq (cadr elem) 'offline)
                        'offline
                      'ok)

-                 (if (and gnus-agent 
+                 (if (and gnus-agent

                           (not (eq (cadr elem) 'offline))
                           (gnus-agent-method-p gnus-command-method))
                      (or gnus-server-unopen-status
                           (not (eq (cadr elem) 'offline))
                           (gnus-agent-method-p gnus-command-method))
                      (or gnus-server-unopen-status

-                         (if (gnus-y-or-n-p 
+                         (if (gnus-y-or-n-p

                               (format "Unable to open %s:%s, go offline? "
                                       (car gnus-command-method)
                                       (cadr gnus-command-method)))
                               (format "Unable to open %s:%s, go offline? "
                                       (car gnus-command-method)
                                       (cadr gnus-command-method)))

@@ -262,7 +266,7 @@ If it is down, start it up (again)."
 
 (defun gnus-status-message (gnus-command-method)
   "Return the status message from GNUS-COMMAND-METHOD.
 
 (defun gnus-status-message (gnus-command-method)
   "Return the status message from GNUS-COMMAND-METHOD.

-If GNUS-COMMAND-METHOD is a string, it is interpreted as a group name.   The method
+If GNUS-COMMAND-METHOD is a string, it is interpreted as a group name.  The method

 this group uses will be queried."
   (let ((gnus-command-method
         (if (stringp gnus-command-method)
 this group uses will be queried."
   (let ((gnus-command-method
         (if (stringp gnus-command-method)

@@ -397,6 +401,7 @@ If BUFFER, insert the article in that group."
           (gnus-cache-request-article article group))
       (setq res (cons group article)
            clean-up t))
           (gnus-cache-request-article article group))
       (setq res (cons group article)
            clean-up t))

+     ;; Check the agent cache.

      ((and gnus-agent gnus-agent-cache gnus-plugged
           (numberp article)
           (gnus-agent-request-article article group))
      ((and gnus-agent gnus-agent-cache gnus-plugged
           (numberp article)
           (gnus-agent-request-article article group))

@@ -478,23 +483,45 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
     (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
   (when (gnus-check-backend-function
         'request-update-info (car gnus-command-method))
     (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
   (when (gnus-check-backend-function
         'request-update-info (car gnus-command-method))

-    (funcall (gnus-get-function gnus-command-method 'request-update-info)
-            (gnus-group-real-name (gnus-info-group info))
-            info (nth 1 gnus-command-method))))
+    (let ((group (gnus-info-group info)))
+      (and (funcall (gnus-get-function gnus-command-method
+                                      'request-update-info)
+                   (gnus-group-real-name group)
+                   info (nth 1 gnus-command-method))
+          ;; If the minimum article number is greater than 1, then all
+          ;; smaller article numbers are known not to exist; we'll
+          ;; artificially add those to the 'read range.
+          (let* ((active (gnus-active group))
+                 (min (car active)))
+            (when (> min 1)
+              (let* ((range (if (= min 2) 1 (cons 1 (1- min))))
+                     (read (gnus-info-read info))
+                     (new-read (gnus-range-add read (list range))))
+                (gnus-info-set-read info new-read)))
+            info)))))

 
 (defun gnus-request-expire-articles (articles group &optional force)
 
 (defun gnus-request-expire-articles (articles group &optional force)

-  (let ((gnus-command-method (gnus-find-method-for-group group)))
-    (funcall (gnus-get-function gnus-command-method 'request-expire-articles)
-            articles (gnus-group-real-name group) (nth 1 gnus-command-method)
-            force)))
-
-(defun gnus-request-move-article
-  (article group server accept-function &optional last)
-  (let ((gnus-command-method (gnus-find-method-for-group group)))
-    (funcall (gnus-get-function gnus-command-method 'request-move-article)
-            article (gnus-group-real-name group)
-            (nth 1 gnus-command-method) accept-function last)))
-
+  (let* ((gnus-command-method (gnus-find-method-for-group group))
+        (not-deleted 
+         (funcall 
+          (gnus-get-function gnus-command-method 'request-expire-articles)
+          articles (gnus-group-real-name group) (nth 1 gnus-command-method)
+          force)))
+    (when (and gnus-agent gnus-agent-cache
+              (gnus-sorted-difference articles not-deleted))
+      (gnus-agent-expire (gnus-sorted-difference articles not-deleted)
+                        group 'force))
+    not-deleted))
+
+(defun gnus-request-move-article (article group server accept-function &optional last)
+  (let* ((gnus-command-method (gnus-find-method-for-group group))
+        (result (funcall (gnus-get-function gnus-command-method 'request-move-article)
+                         article (gnus-group-real-name group)
+                         (nth 1 gnus-command-method) accept-function last)))
+    (when (and result gnus-agent gnus-agent-cache)
+      (gnus-agent-expire (list article) group 'force))
+    result))
+    

 (defun gnus-request-accept-article (group &optional gnus-command-method last
                                          no-encode)
   ;; Make sure there's a newline at the end of the article.
 (defun gnus-request-accept-article (group &optional gnus-command-method last
                                          no-encode)
   ;; Make sure there's a newline at the end of the article.

@@ -514,9 +541,9 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
        (let ((mail-parse-charset message-default-charset))
          (mail-encode-encoded-word-buffer)))
       (message-encode-message-body)))
        (let ((mail-parse-charset message-default-charset))
          (mail-encode-encoded-word-buffer)))
       (message-encode-message-body)))

-  (let ((func (car (or gnus-command-method
-                      (gnus-find-method-for-group group)))))
-    (funcall (intern (format "%s-request-accept-article" func))
+  (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)))
             (if (stringp group) (gnus-group-real-name group) group)
             (cadr gnus-command-method)
             last)))