gnus-int.el (gnus-open-server): Silence compiler

[gnus] / lisp / gnus-int.el

diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el
index 339e3d9..2de6ce0 100644 (file)
--- a/lisp/gnus-int.el
+++ b/lisp/gnus-int.el
@@ -1,6 +1,6 @@
 ;;; gnus-int.el --- backend interface functions for Gnus
 
-;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
@@ -248,17 +248,26 @@ If it is down, start it up (again)."
       'denied))
 
 (defvar gnus-backend-trace nil)
+(defvar gnus-backend-trace-elapsed nil)
 
-(defun gnus-open-server (gnus-command-method)
-  "Open a connection to GNUS-COMMAND-METHOD."
-  (when (stringp gnus-command-method)
-    (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
+(defun gnus-backend-trace (type form)
   (when gnus-backend-trace
     (with-current-buffer (get-buffer-create "*gnus trace*")
       (buffer-disable-undo)
       (goto-char (point-max))
       (insert (format-time-string "%H:%M:%S")
-             (format " %S\n" gnus-command-method))))
+             (format " %.2fs %s %S\n"
+                     (if (numberp gnus-backend-trace-elapsed)
+                         (- (float-time) gnus-backend-trace-elapsed)
+                       0)
+                     type form))
+      (setq gnus-backend-trace-elapsed (float-time)))))
+
+(defun gnus-open-server (gnus-command-method)
+  "Open a connection to GNUS-COMMAND-METHOD."
+  (when (stringp gnus-command-method)
+    (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
+  (gnus-backend-trace :opening gnus-command-method)
   (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.
@@ -293,7 +302,7 @@ If it is down, start it up (again)."
         (setcar
         (cdr elem)
         (cond (result
-               (if (eq open-server-function #'nnagent-open-server)
+               (if (eq open-server-function 'nnagent-open-server)
                    ;; The agent's backend has a "special" status
                    'offline
                  'ok))
@@ -333,6 +342,7 @@ If it is down, start it up (again)."
            (save-excursion
              (gnus-agent-possibly-synchronize-flags-server
               gnus-command-method)))
+         (gnus-backend-trace :opened gnus-command-method)
           result)))))
 
 (defun gnus-close-server (gnus-command-method)
@@ -353,9 +363,13 @@ If it is down, start it up (again)."
   "Read and update infos 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 'finish-retrieve-group-infos)
-          (nth 1 gnus-command-method)
-          infos data))
+  (gnus-backend-trace :finishing gnus-command-method)
+  (prog1
+      (funcall (gnus-get-function gnus-command-method
+                                 'finish-retrieve-group-infos)
+              (nth 1 gnus-command-method)
+              infos data)
+    (gnus-backend-trace :finished gnus-command-method)))
 
 (defun gnus-retrieve-group-data-early (gnus-command-method infos)
   "Start early async retrieval of data from GNUS-COMMAND-METHOD."
@@ -568,18 +582,18 @@ This is the string that Gnus uses to identify the group."
    (gnus-group-method group)))
 
 (defun gnus-warp-to-article ()
-  "Warps from an article in a virtual group to the article in its
-real group. Does nothing on a real group."
+  "Look up the current article in the group where it originated.
+This command only makes sense for groups shows articles gathered
+from other groups -- for instance, search results and the like."
   (interactive)
-  (when (gnus-virtual-group-p gnus-newsgroup-name)
-    (let ((gnus-command-method
-           (gnus-find-method-for-group gnus-newsgroup-name)))
-      (or
-       (when (gnus-check-backend-function
-              'warp-to-article (car gnus-command-method))
-         (funcall (gnus-get-function gnus-command-method 'warp-to-article)))
-       (and (bound-and-true-p gnus-registry-enabled)
-            (gnus-try-warping-via-registry))))))
+  (let ((gnus-command-method
+         (gnus-find-method-for-group gnus-newsgroup-name)))
+    (or
+     (when (gnus-check-backend-function
+            'warp-to-article (car gnus-command-method))
+       (funcall (gnus-get-function gnus-command-method 'warp-to-article)))
+     (and (bound-and-true-p gnus-registry-enabled)
+          (gnus-try-warping-via-registry)))))
 
 (defun gnus-request-head (article group)
   "Request the head of ARTICLE in GROUP."
@@ -599,7 +613,8 @@ real group. Does nothing on a real group."
            clean-up t))
      ;; Use `head' function.
      ((fboundp head)
-      (setq res (funcall head article (gnus-group-real-name group)
+      (setq res (funcall head article
+                         (and (not gnus-override-method) (gnus-group-real-name group))
                         (nth 1 gnus-command-method))))
      ;; Use `article' function.
      (t
@@ -706,6 +721,10 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
 
 (defun gnus-request-expire-articles (articles group &optional force)
   (let* ((gnus-command-method (gnus-find-method-for-group group))
+         ;; Filter out any negative article numbers; they can't be
+         ;; expired here.
+         (articles
+          (delq nil (mapcar (lambda (n) (and (>= n 0) n)) articles)))
         (gnus-inhibit-demon t)
         (not-deleted
          (funcall