comparison lisp/net/dbus.el @ 97167:125ed717ddbb

* net/dbus.el (top): Don't register for "NameOwnerChanged". (dbus-message-type-invalid, dbus-message-type-method-call) (dbus-message-type-method-return, dbus-message-type-error) (dbus-message-type-signal): New defconst. (dbus-ignore-errors): Fix `edebug-form-spec' property. (dbus-return-values-table): New defvar. (dbus-call-method-non-blocking-handler, dbus-event-message-type): New defun. (dbus-check-event, dbus-handle-event, dbus-event-serial-number, ): Extend docstring. Adapt implementation according to new `dbus-event' layout. (dbus-event-service-name, dbus-event-path-name) (dbus-event-interface-name, dbus-event-member-name): Adapt implementation according to new `dbus-event' layout. (dbus-set-property): Correct `dbus-introspect-get-attribute' call.

97166:23dda5132c33

  "The interface supported by introspectable objects.")

(defconst dbus-interface-properties (concat dbus-interface-dbus ".Properties")
  "The interface for property objects.")

(defmacro dbus-ignore-errors (&rest body)
  "Execute BODY; signal D-Bus error when `dbus-debug' is non-nil.
Otherwise, return result of last form in BODY, or all other errors."
  `(condition-case err
       (progn ,@body)
     (dbus-error (when dbus-debug (signal (car err) (cdr err))))))

(put 'dbus-ignore-errors 'lisp-indent-function 0)
(put 'dbus-ignore-errors 'edebug-form-spec '(form symbolp body))
(font-lock-add-keywords 'emacs-lisp-mode '("\\<dbus-ignore-errors\\>"))


;;; Hash table of registered functions.

;; We create it here.  So we have a simple test in dbusbind.c, whether
;; the Lisp code has been loaded.
(setq dbus-registered-functions-table (make-hash-table :test 'equal))

(defun dbus-list-hash-table ()
  "Returns all registered member registrations to D-Bus.
The return value is a list, with elements of kind (KEY . VALUE).
See `dbus-registered-functions-table' for a description of the

	     (delete (car value) (gethash key dbus-registered-functions-table))
	     dbus-registered-functions-table)
	  (remhash key dbus-registered-functions-table))
	(setq value t)))
    value))

(defun dbus-name-owner-changed-handler (&rest args)
  "Reapplies all member registrations to D-Bus.
This handler is applied when a \"NameOwnerChanged\" signal has
arrived.  SERVICE is the object name for which the name owner has

	 (cons
	  (format "Wrong arguments of %s.NameOwnerChanged" dbus-interface-dbus)
	  args))))))

;; Register the handler.
(ignore-errors
  (dbus-register-signal
   :system dbus-service-dbus dbus-path-dbus dbus-interface-dbus
   "NameOwnerChanged" 'dbus-name-owner-changed-handler)
  (dbus-register-signal
   :session dbus-service-dbus dbus-path-dbus dbus-interface-dbus

(defun dbus-check-event (event)
  "Checks whether EVENT is a well formed D-Bus event.
EVENT is a list which starts with symbol `dbus-event':

     (dbus-event BUS SERIAL SERVICE PATH INTERFACE MEMBER HANDLER &rest ARGS)

BUS identifies the D-Bus the message is coming from.  It is
either the symbol `:system' or the symbol `:session'.  SERIAL is
the serial number of the received D-Bus message if it is a method
call, or `nil'.  SERVICE and PATH are the unique name and the
object path of the D-Bus object emitting the message.  INTERFACE
and MEMBER denote the message which has been sent.  HANDLER is
the function which has been registered for this message.  ARGS
are the arguments passed to HANDLER, when it is called during
event handling in `dbus-handle-event'.

This function raises a `dbus-error' signal in case the event is
not well formed."
  (when dbus-debug (message "DBus-Event %s" event))
  (unless (and (listp event)
	       (eq (car event) 'dbus-event)
	       ;; Bus symbol.
	       (symbolp (nth 1 event))
	       ;; Serial.
	       (or (natnump (nth 2 event)) (null (nth 2 event)))
	       ;; Service.
	       (stringp (nth 3 event))
	       ;; Object path.
	       (stringp (nth 4 event))
	       ;; Interface.
	       (stringp (nth 5 event))
	       ;; Member.
	       (stringp (nth 6 event))
	       ;; Handler.
	       (functionp (nth 7 event)))
    (signal 'dbus-error (list "Not a valid D-Bus event" event))))

;;;###autoload
(defun dbus-handle-event (event)
  "Handle events from the D-Bus.
EVENT is a D-Bus event, see `dbus-check-event'.  HANDLER, being
part of the event, is called with arguments ARGS."
  (interactive "e")
  ;; We don't want to raise an error, because this function is called
  ;; in the event handling loop.
  (dbus-ignore-errors
    (let (result)
      (dbus-check-event event)
      (setq result (apply (nth 7 event) (nthcdr 8 event)))
      (unless (consp result) (setq result (cons result nil)))
      ;; Return a message when serial is not `nil'.
      (when (not (null (nth 2 event)))
	(apply 'dbus-method-return-internal
	       (nth 1 event) (nth 2 event) (nth 3 event) result)))))

(defun dbus-event-bus-name (event)
  "Return the bus name the event is coming from.
The result is either the symbol `:system' or the symbol `:session'.
EVENT is a D-Bus event, see `dbus-check-event'.  This function
raises a `dbus-error' signal in case the event is not well
formed."
  (dbus-check-event event)
  (nth 1 event))

(defun dbus-event-serial-number (event)
  "Return the serial number of the corresponding D-Bus message.
The result is a number in case the D-Bus message is a method
call, or `nil' for all other mesage types.  The serial number is
needed for generating a reply message.  EVENT is a D-Bus event,
see `dbus-check-event'.  This function raises a `dbus-error'
signal in case the event is not well formed."
  (dbus-check-event event)
  (nth 2 event))

(defun dbus-event-service-name (event)
  "Return the name of the D-Bus object the event is coming from.
The result is a string.  EVENT is a D-Bus event, see `dbus-check-event'.
This function raises a `dbus-error' signal in case the event is
not well formed."
  (dbus-check-event event)
  (nth 3 event))

(defun dbus-event-path-name (event)
  "Return the object path of the D-Bus object the event is coming from.
The result is a string.  EVENT is a D-Bus event, see `dbus-check-event'.
This function raises a `dbus-error' signal in case the event is
not well formed."
  (dbus-check-event event)
  (nth 4 event))

(defun dbus-event-interface-name (event)
  "Return the interface name of the D-Bus object the event is coming from.
The result is a string.  EVENT is a D-Bus event, see `dbus-check-event'.
This function raises a `dbus-error' signal in case the event is
not well formed."
  (dbus-check-event event)
  (nth 5 event))

(defun dbus-event-member-name (event)
  "Return the member name the event is coming from.
It is either a signal name or a method name. The result is is a
string.  EVENT is a D-Bus event, see `dbus-check-event'.  This
function raises a `dbus-error' signal in case the event is not
well formed."
  (dbus-check-event event)
  (nth 6 event))


;;; D-Bus registered names.

(defun dbus-list-activatable-names ()

	   bus service path "org.freedesktop.DBus.Properties"))
	 ;; PROPERTY must be writable.
	 (string-equal
	  "readwrite"
	  (dbus-introspect-get-attribute
	   bus service path interface property)
	  "access"))
      ;; "Set" requires a variant.
      (dbus-call-method
       bus service path dbus-interface-properties
       "Set" interface property (list :variant value))
      ;; Return VALUE.

97167:125ed717ddbb

  "The interface supported by introspectable objects.")

(defconst dbus-interface-properties (concat dbus-interface-dbus ".Properties")
  "The interface for property objects.")

(defconst dbus-message-type-invalid 0
  "This value is never a valid message type.")

(defconst dbus-message-type-method-call 1
  "Message type of a method call message.")

(defconst dbus-message-type-method-return 2
  "Message type of a method return message.")

(defconst dbus-message-type-error 3
  "Message type of an error reply message.")

(defconst dbus-message-type-signal 4
  "Message type of a signal message.")

(defmacro dbus-ignore-errors (&rest body)
  "Execute BODY; signal D-Bus error when `dbus-debug' is non-nil.
Otherwise, return result of last form in BODY, or all other errors."
  `(condition-case err
       (progn ,@body)
     (dbus-error (when dbus-debug (signal (car err) (cdr err))))))

(put 'dbus-ignore-errors 'lisp-indent-function 0)
(put 'dbus-ignore-errors 'edebug-form-spec '(form body))
(font-lock-add-keywords 'emacs-lisp-mode '("\\<dbus-ignore-errors\\>"))


;;; Hash table of registered functions.

;; We create it here.  So we have a simple test in dbusbind.c, whether
;; the Lisp code has been loaded.
(setq dbus-registered-functions-table (make-hash-table :test 'equal))

(defvar dbus-return-values-table (make-hash-table :test 'equal)
  "Hash table for temporary storing arguments of reply messages.
A key in this hash table is a list (BUS SERIAL).  BUS is either the
symbol `:system' or the symbol `:session'.  SERIAL is the serial number
of the reply message.  See `dbus-call-method-non-blocking-handler' and
`dbus-call-method-non-blocking'.")

(defun dbus-list-hash-table ()
  "Returns all registered member registrations to D-Bus.
The return value is a list, with elements of kind (KEY . VALUE).
See `dbus-registered-functions-table' for a description of the

	     (delete (car value) (gethash key dbus-registered-functions-table))
	     dbus-registered-functions-table)
	  (remhash key dbus-registered-functions-table))
	(setq value t)))
    value))

(defun dbus-call-method-non-blocking-handler (&rest args)
  "Handler for reply messages of asynchronous D-Bus message calls.
It calls the function stored in `dbus-registered-functions-table'.
The result will be made available in `dbus-return-values-table'."
  (puthash (list (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))

(defun dbus-call-method-non-blocking
  (bus service path interface method &rest args)
  "Call METHOD on the D-Bus BUS, but don't block the event queue.
This is necessary for communicating to registered D-Bus methods,
which are running in the same Emacs process.

The arguments are the same as in `dbus-call-method'.

usage: (dbus-call-method-non-blocking
         BUS SERVICE PATH INTERFACE METHOD
         &optional :timeout TIMEOUT &rest ARGS)"

  (let ((key
	 (apply
	  'dbus-call-method-asynchronously
	  bus service path interface method
	  'dbus-call-method-non-blocking-handler args)))
    ;; Wait until `dbus-call-method-non-blocking-handler' has put the
    ;; result into `dbus-return-values-table'.
    (while (not (gethash key dbus-return-values-table nil))
      (read-event nil nil 0.1))

    ;; Cleanup `dbus-return-values-table'.  Return the result.
    (prog1
	(gethash key dbus-return-values-table nil)
      (remhash key dbus-return-values-table))))

(defun dbus-name-owner-changed-handler (&rest args)
  "Reapplies all member registrations to D-Bus.
This handler is applied when a \"NameOwnerChanged\" signal has
arrived.  SERVICE is the object name for which the name owner has

	 (cons
	  (format "Wrong arguments of %s.NameOwnerChanged" dbus-interface-dbus)
	  args))))))

;; Register the handler.
(when nil ;ignore-errors
  (dbus-register-signal
   :system dbus-service-dbus dbus-path-dbus dbus-interface-dbus
   "NameOwnerChanged" 'dbus-name-owner-changed-handler)
  (dbus-register-signal
   :session dbus-service-dbus dbus-path-dbus dbus-interface-dbus

(defun dbus-check-event (event)
  "Checks whether EVENT is a well formed D-Bus event.
EVENT is a list which starts with symbol `dbus-event':

  (dbus-event BUS TYPE SERIAL SERVICE PATH INTERFACE MEMBER HANDLER &rest ARGS)

BUS identifies the D-Bus the message is coming from.  It is
either the symbol `:system' or the symbol `:session'.  TYPE is
the D-Bus message type which has caused the event, SERIAL is the
serial number of the received D-Bus message.  SERVICE and PATH
are the unique name and the object path of the D-Bus object
emitting the message.  INTERFACE and MEMBER denote the message
which has been sent.  HANDLER is the function which has been
registered for this message.  ARGS are the arguments passed to
HANDLER, when it is called during event handling in
`dbus-handle-event'.

This function raises a `dbus-error' signal in case the event is
not well formed."
  (when dbus-debug (message "DBus-Event %s" event))
  (unless (and (listp event)
	       (eq (car event) 'dbus-event)
	       ;; Bus symbol.
	       (symbolp (nth 1 event))
	       ;; Type.
	       (and (natnump (nth 2 event))
		    (< dbus-message-type-invalid (nth 2 event)))
	       ;; Serial.
	       (natnump (nth 3 event))
	       ;; Service.
	       (or (= dbus-message-type-method-return (nth 2 event))
		   (stringp (nth 4 event)))
	       ;; Object path.
	       (or (= dbus-message-type-method-return (nth 2 event))
		   (stringp (nth 5 event)))
	       ;; Interface.
	       (or (= dbus-message-type-method-return (nth 2 event))
		   (stringp (nth 6 event)))
	       ;; Member.
	       (or (= dbus-message-type-method-return (nth 2 event))
		   (stringp (nth 7 event)))
	       ;; Handler.
	       (functionp (nth 8 event)))
    (signal 'dbus-error (list "Not a valid D-Bus event" event))))

;;;###autoload
(defun dbus-handle-event (event)
  "Handle events from the D-Bus.
EVENT is a D-Bus event, see `dbus-check-event'.  HANDLER, being
part of the event, is called with arguments ARGS.
If the HANDLER returns an `dbus-error', it is propagated as return message."
  (interactive "e")
  ;; By default, we don't want to raise an error, because this
  ;; function is called in the event handling loop.
  (condition-case err
      (let (result)
	(dbus-check-event event)
	(setq result (apply (nth 8 event) (nthcdr 9 event)))
	;; Return a message when it is a message call.
	(when (= dbus-message-type-method-call (nth 2 event))
	  (dbus-ignore-errors
	    (dbus-method-return-internal
	     (nth 1 event) (nth 3 event) (nth 4 event) result))))
    ;; Error handling.
    (dbus-error
     ;; Return an error message when it is a message call.
     (when (= dbus-message-type-method-call (nth 2 event))
       (dbus-ignore-errors
	 (dbus-method-error-internal
	  (nth 1 event) (nth 3 event) (nth 4 event) (cadr err))))
     ;; Propagate D-Bus error in the debug case.
     (when dbus-debug (signal (car err) (cdr err))))))

(defun dbus-event-bus-name (event)
  "Return the bus name the event is coming from.
The result is either the symbol `:system' or the symbol `:session'.
EVENT is a D-Bus event, see `dbus-check-event'.  This function
raises a `dbus-error' signal in case the event is not well
formed."
  (dbus-check-event event)
  (nth 1 event))

(defun dbus-event-message-type (event)
  "Return the message type of the corresponding D-Bus message.
The result is a number.  EVENT is a D-Bus event, see
`dbus-check-event'.  This function raises a `dbus-error' signal
in case the event is not well formed."
  (dbus-check-event event)
  (nth 2 event))

(defun dbus-event-serial-number (event)
  "Return the serial number of the corresponding D-Bus message.
The result is a number.  The serial number is needed for
generating a reply message.  EVENT is a D-Bus event, see
`dbus-check-event'.  This function raises a `dbus-error' signal
in case the event is not well formed."
  (dbus-check-event event)
  (nth 3 event))

(defun dbus-event-service-name (event)
  "Return the name of the D-Bus object the event is coming from.
The result is a string.  EVENT is a D-Bus event, see `dbus-check-event'.
This function raises a `dbus-error' signal in case the event is
not well formed."
  (dbus-check-event event)
  (nth 4 event))

(defun dbus-event-path-name (event)
  "Return the object path of the D-Bus object the event is coming from.
The result is a string.  EVENT is a D-Bus event, see `dbus-check-event'.
This function raises a `dbus-error' signal in case the event is
not well formed."
  (dbus-check-event event)
  (nth 5 event))

(defun dbus-event-interface-name (event)
  "Return the interface name of the D-Bus object the event is coming from.
The result is a string.  EVENT is a D-Bus event, see `dbus-check-event'.
This function raises a `dbus-error' signal in case the event is
not well formed."
  (dbus-check-event event)
  (nth 6 event))

(defun dbus-event-member-name (event)
  "Return the member name the event is coming from.
It is either a signal name or a method name. The result is is a
string.  EVENT is a D-Bus event, see `dbus-check-event'.  This
function raises a `dbus-error' signal in case the event is not
well formed."
  (dbus-check-event event)
  (nth 7 event))


;;; D-Bus registered names.

(defun dbus-list-activatable-names ()

	   bus service path "org.freedesktop.DBus.Properties"))
	 ;; PROPERTY must be writable.
	 (string-equal
	  "readwrite"
	  (dbus-introspect-get-attribute
	   (dbus-get-property bus service path interface property)
	   "access")))
      ;; "Set" requires a variant.
      (dbus-call-method
       bus service path dbus-interface-properties
       "Set" interface property (list :variant value))
      ;; Return VALUE.