Improve dbus performance on synchronous calls

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 7783f7fc424fe7d328e5afe37df85b289d3cc697..7bea4f37278cbe359eb38c92b07adf3c076f708c 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
+2014-02-17  Daniel Colascione  <dancol@dancol.org>
+
+       * net/dbus.el (dbus-call-method): Work around bug#16775 by having
+       dbus-call-method check for completion using a busy-wait loop with
+       gradual backoff.
+
 2013-10-02  Michael Albinus  <michael.albinus@gmx.de>
 
        Sync with Tramp 2.2.9.

diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index 032315c363cedf7835b3c7b7eb3ef97c3b6389ed..6214505ad866624044ff98626cb84e2be749ea50 100644 (file)
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -260,6 +260,7 @@ object is returned instead of a list containing this single Lisp object.
       (signal 'wrong-type-argument (list 'stringp method)))
 
   (let ((timeout (plist-get args :timeout))
+        (check-interval 0.001)
        (key
         (apply
          'dbus-message-internal dbus-message-type-method-call
@@ -270,13 +271,21 @@ object is returned instead of a list containing this single Lisp object.
     ;; default 25".  Events which are not from D-Bus must be restored.
     ;; `read-event' performs a redisplay.  This must be suppressed; it
     ;; hurts when reading D-Bus events asynchronously.
+
+    ;; Work around bug#16775 by busy-waiting with gradual backoff for
+    ;; dbus calls to complete.  A better aproach would involve either
+    ;; adding arbitrary wait condition support to read-event or
+    ;; restructuring dbus as a kind of process object.  Poll at most
+    ;; about once per second for completion.
+
     (with-timeout ((if timeout (/ timeout 1000.0) 25))
       (while (eq (gethash key dbus-return-values-table :ignore) :ignore)
-       (let ((event (let ((inhibit-redisplay t) unread-command-events)
-                      (read-event nil nil 0.1))))
-         (when (and event (not (ignore-errors (dbus-check-event event))))
-           (setq unread-command-events
-                 (append unread-command-events (list event)))))))
+        (let ((event (let ((inhibit-redisplay t) unread-command-events)
+                      (read-event nil nil check-interval))))
+          (when event
+            (push event unread-command-events))
+          (when (< check-interval 1)
+            (setf check-interval (* check-interval 1.05))))))
 
     ;; Cleanup `dbus-return-values-table'.  Return the result.
     (prog1