diff lisp/gnus/gnus-int.el @ 85712:a3c27999decb

Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Revision: [e-mail]/emacs--devo--0--patch-911

--- a/lisp/gnus/gnus-int.el	Sun Oct 28 04:58:17 2007 +0000
+++ b/lisp/gnus/gnus-int.el	Sun Oct 28 09:18:39 2007 +0000
@@ -75,7 +75,7 @@
 	;; 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)))
@@ -209,11 +209,12 @@
   "Open a connection to GNUS-COMMAND-METHOD."
   (when (stringp gnus-command-method)
     (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
-  (let ((elem (assoc gnus-command-method gnus-opened-servers)))
+  (let ((elem (assoc gnus-command-method gnus-opened-servers))
+	(server (gnus-method-to-server-name gnus-command-method)))
     ;; If this method was previously denied, we just return nil.
     (if (eq (nth 1 elem) 'denied)
 	(progn
-	  (gnus-message 1 "Denied server")
+	  (gnus-message 1 "Denied server %s" server)
 	  nil)
       ;; Open the server.
       (let* ((open-server-function (gnus-get-function gnus-command-method 'open-server))
@@ -224,11 +225,11 @@
                           (nthcdr 2 gnus-command-method))
                (error
                 (gnus-message 1 (format
-                                 "Unable to open server due to: %s"
-                                 (error-message-string err)))
+                                 "Unable to open server %s due to: %s"
+                                 server (error-message-string err)))
                 nil)
                (quit
-                (gnus-message 1 "Quit trying to open server")
+                (gnus-message 1 "Quit trying to open server %s" server)
                 nil)))
             open-offline)
 	;; If this hasn't been opened before, we add it to the list.
@@ -253,9 +254,9 @@
                              ((and
 			       (not gnus-batch-mode)
 			       (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 server %s, go offline? "
+				 server)))
                               (setq open-offline t)
                               'offline)
                              (t
@@ -335,6 +336,23 @@
   (funcall (gnus-get-function gnus-command-method 'request-regenerate)
 	   (nth 1 gnus-command-method)))
 
+(defun gnus-request-compact-group (group)
+  (let* ((method (gnus-find-method-for-group group))
+	 (gnus-command-method method)
+	 (result
+	  (funcall (gnus-get-function gnus-command-method
+				      'request-compact-group)
+		   (gnus-group-real-name group)
+		   (nth 1 gnus-command-method) t)))
+    result))
+
+(defun gnus-request-compact (gnus-command-method)
+  "Request groups compaction  from GNUS-COMMAND-METHOD."
+  (when (stringp gnus-command-method)
+    (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
+  (funcall (gnus-get-function gnus-command-method 'request-compact)
+	   (nth 1 gnus-command-method)))
+
 (defun gnus-request-group (group &optional dont-check gnus-command-method)
   "Request GROUP.  If DONT-CHECK, no information is required."
   (let ((gnus-command-method
@@ -342,7 +360,7 @@
     (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)))
 
@@ -521,12 +539,11 @@
 	 (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."
@@ -566,12 +583,12 @@
     not-deleted))
 
 (defun gnus-request-move-article (article group server accept-function
-					  &optional last)
+					  &optional last move-is-internal)
   (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)))
+			  (nth 1 gnus-command-method) accept-function last move-is-internal)))
     (when (and result gnus-agent
 	       (gnus-agent-method-p gnus-command-method))
       (gnus-agent-unfetch-articles group (list article)))
@@ -597,7 +614,7 @@
 	(let ((mail-parse-charset message-default-charset))
 	  (mail-encode-encoded-word-buffer)))
       (message-encode-message-body)))
-(let ((gnus-command-method (or gnus-command-method
+  (let ((gnus-command-method (or gnus-command-method
 				 (gnus-find-method-for-group group)))
 	(result
 	 (funcall