[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/net/dbus.el,v
From: |
Michael Albinus |
Subject: |
[Emacs-diffs] Changes to emacs/lisp/net/dbus.el,v |
Date: |
Mon, 21 Jan 2008 20:06:15 +0000 |
CVSROOT: /sources/emacs
Module name: emacs
Changes by: Michael Albinus <albinus> 08/01/21 20:06:15
Index: dbus.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/net/dbus.el,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -b -r1.10 -r1.11
--- dbus.el 4 Jan 2008 21:52:51 -0000 1.10
+++ dbus.el 21 Jan 2008 20:06:15 -0000 1.11
@@ -46,6 +46,17 @@
(defconst dbus-interface-introspectable "org.freedesktop.DBus.Introspectable"
"The interface supported by introspectable 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.
@@ -64,6 +75,35 @@
dbus-registered-functions-table)
result))
+(defun dbus-unregister-object (object)
+ "Unregister OBJECT from D-Bus.
+OBJECT must be the result of a preceding `dbus-register-method'
+or `dbus-register-signal' call. It returns t if OBJECT has been
+unregistered, nil otherwise."
+ ;; Check parameter.
+ (unless (and (consp object) (not (null (car object))) (consp (cdr object)))
+ (signal 'wrong-type-argument (list 'D-Bus object)))
+
+ ;; Find the corresponding entry in the hash table.
+ (let* ((key (car object))
+ (value (gethash key dbus-registered-functions-table)))
+ ;; Loop over the registered functions.
+ (while (consp value)
+ ;; (car value) has the structure (UNAME SERVICE PATH HANDLER).
+ ;; (cdr object) has the structure ((SERVICE PATH HANDLER) ...).
+ (if (not (equal (cdr (car value)) (car (cdr object))))
+ (setq value (cdr value))
+ ;; Compute new hash value. If it is empty, remove it from
+ ;; hash table.
+ (unless
+ (puthash
+ key
+ (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
@@ -110,15 +150,13 @@
args))))))
;; Register the handler.
-(condition-case nil
- (progn
+(dbus-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
"NameOwnerChanged" 'dbus-name-owner-changed-handler))
- (dbus-error))
;;; D-Bus events.
@@ -168,16 +206,15 @@
(interactive "e")
;; We don't want to raise an error, because this function is called
;; in the event handling loop.
- (condition-case err
+ (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
- (nth 1 event) (nth 2 event) (nth 3 event) result)))
- (dbus-error (when dbus-debug (signal (car err) (cdr err))))))
+ (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.
@@ -238,11 +275,10 @@
"Return the D-Bus service names which can be activated as list.
The result is a list of strings, which is nil when there are no
activatable service names at all."
- (condition-case nil
+ (dbus-ignore-errors
(dbus-call-method
:system dbus-service-dbus
- dbus-path-dbus dbus-interface-dbus "ListActivatableNames")
- (dbus-error)))
+ dbus-path-dbus dbus-interface-dbus "ListActivatableNames")))
(defun dbus-list-names (bus)
"Return the service names registered at D-Bus BUS.
@@ -250,10 +286,9 @@
registered service names at all. Well known names are strings like
\"org.freedesktop.DBus\". Names starting with \":\" are unique names
for services."
- (condition-case nil
+ (dbus-ignore-errors
(dbus-call-method
- bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus "ListNames")
- (dbus-error)))
+ bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus "ListNames")))
(defun dbus-list-known-names (bus)
"Retrieve all services which correspond to a known name in BUS.
@@ -267,20 +302,18 @@
"Return the unique names registered at D-Bus BUS and queued for SERVICE.
The result is a list of strings, or nil when there are no queued name
owners service names at all."
- (condition-case nil
+ (dbus-ignore-errors
(dbus-call-method
bus dbus-service-dbus dbus-path-dbus
- dbus-interface-dbus "ListQueuedOwners" service)
- (dbus-error)))
+ dbus-interface-dbus "ListQueuedOwners" service)))
(defun dbus-get-name-owner (bus service)
"Return the name owner of SERVICE registered at D-Bus BUS.
The result is either a string, or nil if there is no name owner."
- (condition-case nil
+ (dbus-ignore-errors
(dbus-call-method
bus dbus-service-dbus dbus-path-dbus
- dbus-interface-dbus "GetNameOwner" service)
- (dbus-error)))
+ dbus-interface-dbus "GetNameOwner" service)))
(defun dbus-introspect (bus service path)
"Return the introspection data of SERVICE in D-Bus BUS at object path PATH.
@@ -291,10 +324,9 @@
\(dbus-introspect
:system \"org.freedesktop.Hal\"
\"/org/freedesktop/Hal/devices/computer\")"
- (condition-case nil
+ (dbus-ignore-errors
(dbus-call-method
- bus service path dbus-interface-introspectable "Introspect")
- (dbus-error)))
+ bus service path dbus-interface-introspectable "Introspect")))
(if nil ;; Must be reworked. Shall we offer D-Bus signatures at all?
(defun dbus-get-signatures (bus interface signal)
@@ -310,7 +342,7 @@
If INTERFACE or SIGNAL do not exist, or if they do not support
the D-Bus method org.freedesktop.DBus.Introspectable.Introspect,
the function returns nil."
- (condition-case nil
+ (dbus-ignore-errors
(let ((introspect-xml
(with-temp-buffer
(insert (dbus-introspect bus interface))
@@ -326,14 +358,13 @@
;; That's the requested interface. Check for signals.
(setq signals (xml-get-children (car interfaces) 'signal))
(while signals
- (when (string-equal (xml-get-attribute (car signals) 'name)
- signal)
+ (when (string-equal (xml-get-attribute (car signals) 'name) signal)
;; The signal we are looking for.
(setq args (xml-get-children (car signals) 'arg))
(while args
(unless (xml-get-attribute (car args) 'type)
;; This shouldn't happen, let's escape.
- (signal 'dbus-error ""))
+ (signal 'dbus-error nil))
;; We append the signature.
(setq
result (append result
@@ -343,9 +374,7 @@
(setq signals (cdr signals)))
(setq interfaces nil))
(setq interfaces (cdr interfaces)))
- result)
- ;; We ignore `dbus-error'. There might be no introspectable interface.
- (dbus-error nil)))
+ result)))
) ;; (if nil ...
(provide 'dbus)