is coming from. It is either a signal name or a method name.
@end defun
-D-Bus errors are not propagated during event handling, because it is
-usually not desired. D-Bus errors in events can be made visible by
-setting the variable @code{dbus-debug} to @code{t}. They can also be
-handled by a hook function.
+@vindex dbus-show-dbus-errors
+D-Bus error messages are not propagated during event handling, because
+it is usually not desired. D-Bus errors in events can be made visible
+by setting the user option @code{dbus-show-dbus-errors} to
+non-@code{nil}. They can also be handled by a hook function.
@defvar dbus-event-error-functions
This hook variable keeps a list of functions, which are called when a
** Miscellaneous
+++
-*** New command 'submit-emacs-patch'
+*** New command 'submit-emacs-patch'.
This works along the lines of 'report-emacs-bug', but is more geared
towards sending a patch to the Emacs issue tracker.
+++
*** New minor mode 'button-mode'.
This minor mode does nothing else than install 'button-buffer-map' as
-a minor mode map (which binds the TAB/S-TAB key bindings to navigate
+a minor mode map (which binds the 'TAB' / 'S-TAB' key bindings to navigate
to buttons), and can be used in any view-mode-like buffer that has
buttons in it.
+++
*** In case of problems, handlers can emit proper D-Bus error messages now.
----
++++
*** D-Bus errors, which have been converted from incoming D-Bus error
-messages, contain the error name of that message now.
+messages, contain the error name of that message now. They can be
+made visible by setting user variable 'dbus-show-dbus-errors' to
+non-nil, even if protected by 'dbus-ignore-errors' otherwise.
\f
* New Modes and Packages in Emacs 28.1
;;; D-Bus constants.
+(defconst dbus-compound-types '(:array :variant :struct :dict-entry)
+ "D-Bus compound types, represented as list.")
+
(defconst dbus-service-dbus "org.freedesktop.DBus"
"The bus name used to talk to the bus itself.")
\f
;;; Default D-Bus errors.
+(defgroup dbus nil
+ "Elisp bindings for D-Bus."
+ :group 'comm
+ :link '(custom-manual "(dbus)Top")
+ :version "28.1")
+
+(defcustom dbus-show-dbus-errors nil
+ "Propagate incoming D-Bus error messages."
+ :version "28.1"
+ :type 'boolean)
+
(defconst dbus-error-dbus "org.freedesktop.DBus.Error"
"The namespace for default error names.
See /usr/include/dbus-1.0/dbus/dbus-protocol.h.")
\f
;;; Emacs defaults.
+
(defconst dbus-service-emacs "org.gnu.Emacs"
"The well known service name of Emacs.")
(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."
+Signals also D-Bus error when `dbus-show-dbus-errors' is non-nil
+and a D-Bus error message has arrived. Otherwise, return result
+of last form in BODY, or all other errors."
(declare (indent 0) (debug t))
`(condition-case err
(progn ,@body)
- (dbus-error (when dbus-debug (signal (car err) (cdr err))))))
+ (dbus-error
+ (when (or dbus-debug
+ (and dbus-show-dbus-errors
+ (= dbus-message-type-error (nth 2 last-input-event))))
+ (signal (car err) (cdr err))))))
(defvar dbus-event-error-functions '(dbus-notice-synchronous-call-errors)
"Functions to be called when a D-Bus error happens in the event handler.
(defun dbus-set-property (bus service path interface property &rest args)
"Set value of PROPERTY of INTERFACE to VALUE.
It will be checked at BUS, SERVICE, PATH. VALUE can be preceded
-by a TYPE symbol. When the value is successfully set return
-VALUE. Otherwise, return nil.
+by a TYPE symbol. When the value is successfully set, and the
+property's access type is not `:write', return VALUE. Otherwise,
+return nil.
\(dbus-set-property BUS SERVICE PATH INTERFACE PROPERTY [TYPE] VALUE)"
(dbus-ignore-errors
(dbus-call-method
bus service path dbus-interface-properties
"Set" :timeout 500 interface property (list :variant args))
- ;; Return VALUE. The property could have the `:write' access type,
- ;; so we ignore errors in `dbus-get-property'.
- (dbus-ignore-errors
- (or (dbus-get-property bus service path interface property)
- (if (symbolp (car args)) (cadr args) (car args))))))
+ ;; Return VALUE.
+ (or (dbus-get-property bus service path interface property)
+ (if (symbolp (car args)) (cadr args) (car args)))))
(defun dbus-get-all-properties (bus service path interface)
"Return all properties of INTERFACE at BUS, SERVICE, PATH.
"Property \"%s\" at path \"%s\" is not readable" property path)))
;; Return the result. Since variant is a list, we must embed
;; it into another list.
- (t (list (if (eq :array (car (nth 3 object)))
+ (t (list (if (memq (car (nth 3 object)) dbus-compound-types)
(list :variant (nth 3 object))
(cons :variant (nth 3 object))))))))
- ;; "Set" expects the same type as registered.
+ ;; "Set" expects the same type as registered. FIXME: Implement!
((string-equal method "Set")
(let* ((value (caar (nth 2 args)))
(entry (dbus-get-this-registered-property
(push
(list :dict-entry
(car (last key))
- (if (eq :array (car (nth 3 object)))
+ (if (memq (car (nth 3 object)) dbus-compound-types)
(list :variant (nth 3 object))
(cons :variant (nth 3 object))))
result))))))
;;; TODO:
-;; Support other compound properties but array.
-
+;; * Check property type in org.freedesktop.DBus.Properties.Set.
+;;
;; * Implement org.freedesktop.DBus.ObjectManager.InterfacesAdded and
;; org.freedesktop.DBus.ObjectManager.InterfacesRemoved.
;;
(defvar dbus-debug nil)
(declare-function dbus-get-unique-name "dbusbind.c" (bus))
+(setq dbus-show-dbus-errors nil)
+
(defconst dbus--test-enabled-session-bus
(and (featurep 'dbusbind)
(dbus-ignore-errors (dbus-get-unique-name :session)))
(should-not (member dbus--test-service (dbus-list-known-names bus)))
;; `dbus-service-dbus' is reserved for the BUS itself.
- (should-error (dbus-register-service bus dbus-service-dbus))
- (should-error (dbus-unregister-service bus dbus-service-dbus)))
+ (should
+ (equal
+ (butlast
+ (should-error (dbus-register-service bus dbus-service-dbus)))
+ `(dbus-error ,dbus-error-invalid-args)))
+ (should
+ (equal
+ (butlast
+ (should-error (dbus-unregister-service bus dbus-service-dbus)))
+ `(dbus-error ,dbus-error-invalid-args))))
(ert-deftest dbus-test02-register-service-session ()
"Check service registration at `:session' bus."
(unwind-protect
(let ((property1 "Property1")
(property2 "Property2")
- (property3 "Property3"))
-
- ;; Not registered property.
- (should-not
- (dbus-get-property
- :session dbus--test-service dbus--test-path
- dbus--test-interface property1))
+ (property3 "Property3")
+ (property4 "Property4"))
;; `:read' property.
(should
:session dbus--test-service dbus--test-path
dbus--test-interface property1)
"foo"))
- (should-not ;; Due to `:read' access type.
+ ;; Due to `:read' access type, we don't get a proper reply
+ ;; from `dbus-set-property'.
+ (should-not
(dbus-set-property
:session dbus--test-service dbus--test-path
dbus--test-interface property1 "foofoo"))
+ (let ((dbus-show-dbus-errors t))
+ (should
+ (equal
+ ;; We don't care the error message text.
+ (butlast
+ (should-error
+ (dbus-set-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property1 "foofoo")))
+ `(dbus-error ,dbus-error-property-read-only))))
(should
(string-equal
(dbus-get-property
dbus--test-interface property2 :write "bar")
`((:property :session ,dbus--test-interface ,property2)
(,dbus--test-service ,dbus--test-path))))
- (should-not ;; Due to `:write' access type.
+ ;; Due to `:write' access type, we don't get a proper reply
+ ;; from `dbus-get-property'.
+ (should-not
(dbus-get-property
:session dbus--test-service dbus--test-path
dbus--test-interface property2))
+ (let ((dbus-show-dbus-errors t))
+ (should
+ (equal
+ ;; We don't care the error message text.
+ (butlast
+ (should-error
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property2)))
+ `(dbus-error ,dbus-error-access-denied))))
(should
(string-equal
(dbus-set-property
dbus--test-interface property3)
"/baz/baz"))
+ ;; Not registered property.
+ (should-not
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property4))
+ (let ((dbus-show-dbus-errors t))
+ (should
+ (equal
+ ;; We don't care the error message text.
+ (butlast
+ (should-error
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property4)))
+ `(dbus-error ,dbus-error-unknown-property))))
+ (should-not
+ (dbus-set-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property4 "foobarbaz"))
+ (let ((dbus-show-dbus-errors t))
+ (should
+ (equal
+ ;; We don't care the error message text.
+ (butlast
+ (should-error
+ (dbus-set-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property4 "foobarbaz")))
+ `(dbus-error ,dbus-error-unknown-property))))
+
;; `dbus-get-all-properties'. We cannot retrieve a value for
;; the property with `:write' access type.
(let ((result