From 26ea164c7e18b893a661eea9436338cbbab557e1 Mon Sep 17 00:00:00 2001 From: Daniel Colascione Date: Mon, 17 Feb 2014 03:41:42 -0800 Subject: [PATCH] Improve dbus performance on synchronous calls --- lisp/ChangeLog | 6 ++++++ lisp/net/dbus.el | 19 ++++++++++++++----- 2 files changed, 20 insertions(+), 5 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 7783f7fc424..7bea4f37278 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2014-02-17 Daniel Colascione + + * 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 Sync with Tramp 2.2.9. diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index 032315c363c..6214505ad86 100644 --- 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 -- 2.39.2