Improve dbus error handling; detect bus failure

diff --cc lisp/ChangeLog
index 8d2c676088280a14072de327f12b615363b2e7b3,e0b8e20496dd28f05a1ed736e431f617c7c630e2..cc2b79e140697fc6d622401f3df847f25a119b21
--- 1/lisp/ChangeLog
--- 2/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@@ -1,20 -1,3 +1,35 @@@
++2014-02-21  Daniel Colascione  <dancol@dancol.org>
++
++      * net/dbus.el (dbus-init-bus-1): Declare new subr.
++      (dbus-init-bus): New function: call into dbus-init-bus-1
++      and installs a handler for the disconnect signal.
++      (dbus-call-method): Rewrite to look for result in cons.
++      (dbus-call-method-handler): Store result in cons.
++      (dbus-check-event): Recognize events with nil sender as valid.
++      (dbus-handle-bus-disconnect): New function.  React to bus
++      disconnection signal by synthesizing dbus error for each
++      pending synchronous or asynchronous call.
++      (dbus-notice-synchronous-call-errors): New function.
++      (dbus-handle-event): Raise errors directly only when `dbus-debug'
++      is true, not all the time.
++
 +2014-02-21  Juanma Barranquero  <lekktu@gmail.com>
 +
 +      * w32-fns.el (w32-enable-italics, w32-charset-to-codepage-alist):
 +      Remove obsolescence declarations, these variables do not exist anymore.
 +
 +      * savehist.el (savehist-save-minibuffer-history)
 +      (savehist-additional-variables, savehist-file, savehist-mode-hook)
 +      (savehist-save-hook, savehist-coding-system, savehist-loaded)
 +      (savehist-load, savehist-install, savehist-autosave): Fix typos;
 +      mostly, refer to "Savehist mode" when talking about the mode,
 +      and not the function.
 +
 +      * saveplace.el (save-place): Remove redundant info in docstring.
 +      (save-place-forget-unreadable-files, toggle-save-place)
 +      (save-place-forget-unreadable-files, save-place-dired-hook):
 +      Fix typos and remove unneeded backslashes.
 +
  2014-02-20  Michael Albinus  <michael.albinus@gmx.de>
  
        * net/tramp.el (ls-lisp-use-insert-directory-program): Declare.

diff --cc lisp/net/dbus.el
index 5c1296de1fab14872241f32f1de925955a552bcd,5c1296de1fab14872241f32f1de925955a552bcd..900bf4302b53a8f3710e68ddae043ace52280bf1
--- 1/lisp/net/dbus.el
--- 2/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@@ -35,7 -35,7 +35,7 @@@
  
  ;; Declare used subroutines and variables.
  (declare-function dbus-message-internal "dbusbind.c")
--(declare-function dbus-init-bus "dbusbind.c")
++(declare-function dbus-init-bus-1 "dbusbind.c")
  (defvar dbus-message-type-invalid)
  (defvar dbus-message-type-method-call)
  (defvar dbus-message-type-method-return)
@@@ -154,7 -154,7 +154,7 @@@ Otherwise, return result of last form i
  
  (define-obsolete-variable-alias 'dbus-event-error-hooks
    'dbus-event-error-functions "24.3")
--(defvar dbus-event-error-functions nil
++(defvar dbus-event-error-functions '(dbus-notice-synchronous-call-errors)
    "Functions to be called when a D-Bus error happens in the event handler.
  Every function must accept two arguments, the event and the error variable
  caught in `condition-case' by `dbus-error'.")
@@@ -173,11 -173,11 +173,23 @@@ SERIAL is the serial number of the repl
    "Handler for reply messages of asynchronous D-Bus message calls.
  It calls the function stored in `dbus-registered-objects-table'.
  The result will be made available in `dbus-return-values-table'."
--  (puthash (list  :serial
--                (dbus-event-bus-name last-input-event)
--               (dbus-event-serial-number last-input-event))
--         (if (= (length args) 1) (car args) args)
--         dbus-return-values-table))
++  (let* ((key (list  :serial
++                     (dbus-event-bus-name last-input-event)
++                     (dbus-event-serial-number last-input-event)))
++         (result (gethash key dbus-return-values-table)))
++    (when (consp result)
++      (setcar result :complete)
++      (setcdr result (if (= (length args) 1) (car args) args)))))
++
++(defun dbus-notice-synchronous-call-errors (ev er)
++  "Detect errors resulting from pending synchronous calls."
++  (let* ((key (list  :serial
++                     (dbus-event-bus-name ev)
++                     (dbus-event-serial-number ev)))
++         (result (gethash key dbus-return-values-table)))
++    (when (consp result)
++      (setcar result :error)
++      (setcdr result er))))
  
  (defun dbus-call-method (bus service path interface method &rest args)
    "Call METHOD on the D-Bus BUS.
@@@ -264,7 -264,7 +276,8 @@@ object is returned instead of a list co
        (key
         (apply
          'dbus-message-internal dbus-message-type-method-call
--        bus service path interface method 'dbus-call-method-handler args)))
++        bus service path interface method 'dbus-call-method-handler args))
++        (result (cons :pending nil)))
  
      ;; Wait until `dbus-call-method-handler' has put the result into
      ;; `dbus-return-values-table'.  If no timeout is given, use the
@@@ -278,20 -278,20 +291,23 @@@
      ;; 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 check-interval))))
--          (when event
--            (setf unread-command-events
--                  (nconc unread-command-events
--                         (cons event nil))))
--          (when (< check-interval 1)
--            (setf check-interval (* check-interval 1.05))))))
--
--    ;; Cleanup `dbus-return-values-table'.  Return the result.
--    (prog1
--      (gethash key dbus-return-values-table)
++    (puthash key result dbus-return-values-table)
++    (unwind-protect
++         (progn
++           (with-timeout ((if timeout (/ timeout 1000.0) 25)
++                          (signal 'dbus-error (list "call timed out")))
++             (while (eq (car result) :pending)
++               (let ((event (let ((inhibit-redisplay t) unread-command-events)
++                              (read-event nil nil check-interval))))
++                 (when event
++                   (setf unread-command-events
++                         (nconc unread-command-events
++                                (cons event nil))))
++                 (when (< check-interval 1)
++                   (setf check-interval (* check-interval 1.05))))))
++           (when (eq (car result) :error)
++             (signal (cadr result) (cddr result)))
++           (cdr result))
        (remhash key dbus-return-values-table))))
  
  ;; `dbus-call-method' works non-blocking now.
@@@ -922,7 -922,7 +938,8 @@@ not well formed.
               ;; Service.
               (or (= dbus-message-type-method-return (nth 2 event))
                   (= dbus-message-type-error (nth 2 event))
--                 (stringp (nth 4 event)))
++                   (or (stringp (nth 4 event))
++                       (null (nth 4 event))))
               ;; Object path.
               (or (= dbus-message-type-method-return (nth 2 event))
                   (= dbus-message-type-error (nth 2 event))
@@@ -973,7 -973,7 +990,7 @@@ If the HANDLER returns a `dbus-error', 
          (nth 1 event) (nth 4 event) (nth 3 event) (cadr err))))
       ;; Propagate D-Bus error messages.
       (run-hook-with-args 'dbus-event-error-functions event err)
--     (when (or dbus-debug (= dbus-message-type-error (nth 2 event)))
++     (when dbus-debug
         (signal (car err) (cdr err))))))
  
  (defun dbus-event-bus-name (event)
@@@ -1679,6 -1679,6 +1696,64 @@@ It will be registered for all objects c
         result)
        '(:signature "{oa{sa{sv}}}"))))))
  
++(defun dbus-handle-bus-disconnect ()
++  "React to a bus disconnection.
++BUS is the bus that disconnected.  This routine unregisters all
++handlers on the given bus and causes all synchronous calls
++pending at the time of disconnect to fail."
++  (let ((bus (dbus-event-bus-name last-input-event))
++        (keys-to-remove))
++    (maphash
++     (lambda (key value)
++       (when (and (eq (nth 0 key) :serial)
++                  (eq (nth 1 key) bus))
++         (run-hook-with-args
++          'dbus-event-error-functions
++          (list 'dbus-event
++                bus
++                dbus-message-type-error
++                (nth 2 key)
++                nil
++                nil
++                nil
++                nil
++                value)
++          '(dbus-error "Bus disconnected"))
++         (push key keys-to-remove)))
++     dbus-registered-objects-table)
++    (dolist (key keys-to-remove)
++      (remhash key dbus-registered-objects-table))))
++
++(defun dbus-init-bus (bus &optional private)
++  "Establish the connection to D-Bus BUS.
++
++BUS can be either the symbol `:system' or the symbol `:session', or it
++can be a string denoting the address of the corresponding bus.  For
++the system and session buses, this function is called when loading
++`dbus.el', there is no need to call it again.
++
++The function returns a number, which counts the connections this Emacs
++session has established to the BUS under the same unique name (see
++`dbus-get-unique-name').  It depends on the libraries Emacs is linked
++with, and on the environment Emacs is running.  For example, if Emacs
++is linked with the gtk toolkit, and it runs in a GTK-aware environment
++like Gnome, another connection might already be established.
++
++When PRIVATE is non-nil, a new connection is established instead of
++reusing an existing one.  It results in a new unique name at the bus.
++This can be used, if it is necessary to distinguish from another
++connection used in the same Emacs process, like the one established by
++GTK+.  It should be used with care for at least the `:system' and
++`:session' buses, because other Emacs Lisp packages might already use
++this connection to those buses.
++"
++  (dbus-init-bus-1 bus private)
++  (dbus-register-signal bus nil
++                        "/org/freedesktop/DBus/Local"
++                        "org.freedesktop.DBus.Local"
++                        "Disconnected"
++                        #'dbus-handle-bus-disconnect))
++
   \f
  ;; Initialize `:system' and `:session' buses.  This adds their file
  ;; descriptors to input_wait_mask, in order to detect incoming

diff --cc src/ChangeLog
index 4bb4719710672d12555d17fb7705fc921acebcb2,4bb4719710672d12555d17fb7705fc921acebcb2..05fccace7713b58d3898ec33b35a34379a2f9c66
--- 1/src/ChangeLog
--- 2/src/ChangeLog
+++ b/src/ChangeLog
@@@ -1,3 -1,3 +1,7 @@@
++2014-02-21  Daniel Colascione  <dancol@dancol.org>
++
++      * dbusbind.c: Rename dbus-init-bus to dbus-init-bus-1.
++
  2014-02-20  Eli Zaretskii  <eliz@gnu.org>
  
        * xdisp.c (init_iterator): Don't dereference a bogus face

diff --cc src/dbusbind.c
index 1c386f02c9059bd8d516f4dcce1315e07428a412,1c386f02c9059bd8d516f4dcce1315e07428a412..460733c7239dffe491952a2fb5cd799856b8bfda
--- 1/src/dbusbind.c
--- 2/src/dbusbind.c
+++ b/src/dbusbind.c
@@@ -42,7 -42,7 +42,7 @@@ along with GNU Emacs.  If not, see <htt
  
  \f
  /* Subroutines.  */
--static Lisp_Object Qdbus_init_bus;
++static Lisp_Object Qdbus_init_bus_1;
  static Lisp_Object Qdbus_get_unique_name;
  static Lisp_Object Qdbus_message_internal;
  
@@@ -1121,9 -1121,9 +1121,12 @@@ xd_close_bus (Lisp_Object bus
    return;
  }
  
--DEFUN ("dbus-init-bus", Fdbus_init_bus, Sdbus_init_bus, 1, 2, 0,
++DEFUN ("dbus-init-bus-1", Fdbus_init_bus_1, Sdbus_init_bus_1, 1, 2, 0,
         doc: /* Establish the connection to D-Bus BUS.
  
++This function is dbus-internal.  You almost certainly want to use
++dbus-init-bus.
++
  BUS can be either the symbol `:system' or the symbol `:session', or it
  can be a string denoting the address of the corresponding bus.  For
  the system and session buses, this function is called when loading
@@@ -1742,8 -1742,8 +1745,8 @@@ voi
  syms_of_dbusbind (void)
  {
  
--  DEFSYM (Qdbus_init_bus, "dbus-init-bus");
--  defsubr (&Sdbus_init_bus);
++  DEFSYM (Qdbus_init_bus_1, "dbus-init-bus-1");
++  defsubr (&Sdbus_init_bus_1);
  
    DEFSYM (Qdbus_get_unique_name, "dbus-get-unique-name");
    defsubr (&Sdbus_get_unique_name);