[Emacs-diffs] Changes to emacs/lisp/gnus/gnus-int.el,v

[Miles Bader]

CVSROOT:        /cvsroot/emacs
Module name:    emacs
Changes by:     Miles Bader <miles>     07/10/28 09:18:40

Index: lisp/gnus/gnus-int.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/gnus/gnus-int.el,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -b -r1.18 -r1.19
--- lisp/gnus/gnus-int.el       26 Jul 2007 05:26:58 -0000      1.18
+++ lisp/gnus/gnus-int.el       28 Oct 2007 09:18:28 -0000      1.19
@@ -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
@@ -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
+    (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))))))
+              (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