aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMichael Albinus2020-09-16 14:32:57 +0200
committerMichael Albinus2020-09-16 14:32:57 +0200
commit92f342f38dd82aae4a662708dd6280fdfb2e013b (patch)
treed6c895200d165224678d04b51ae03d8f149ca23a
parent96f1fedf4dd662dbd5bba7eebc0b9c9e926fbce6 (diff)
downloademacs-92f342f38dd82aae4a662708dd6280fdfb2e013b.tar.gz
emacs-92f342f38dd82aae4a662708dd6280fdfb2e013b.zip
D-Bus: keep type information in D-Bus events
* doc/misc/dbus.texi (Errors and Events): * etc/NEWS: D-Bus events keep the type information of their arguments. * lisp/net/dbus.el (dbus-check-event): Fix docstring. (dbus-delete-types, dbus-flatten-types): New defuns. (dbus-handle-event, dbus-register-property, dbus-property-handler): Handle type information. (dbus-set-property): Fix thinko. * src/dbusbind.c (XD_BASIC_DBUS_TYPE): Simplify. (xd_dbus_type_to_symbol): New function. (xd_retrieve_arg): Return type information for the arguments. (xd_read_message_1): Return type information for the error name. (dbus-registered-objects-table): Fix docstring.
-rw-r--r--doc/misc/dbus.texi8
-rw-r--r--etc/NEWS31
-rw-r--r--lisp/net/dbus.el90
-rw-r--r--src/dbusbind.c104
4 files changed, 141 insertions, 92 deletions
diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi
index 1d4db7e7ab3..ef5f0b6625b 100644
--- a/doc/misc/dbus.texi
+++ b/doc/misc/dbus.texi
@@ -1346,6 +1346,8 @@ message arrives, and @var{handler} is called. Example:
1346@cindex method calls, returning 1346@cindex method calls, returning
1347@cindex returning method calls 1347@cindex returning method calls
1348 1348
1349@c https://wiki.ubuntu.com/DebuggingDBus
1350
1349You can offer an own service in D-Bus, which will be visible by other 1351You can offer an own service in D-Bus, which will be visible by other
1350D-Bus clients. See @uref{https://dbus.freedesktop.org/doc/dbus-api-design.html} 1352D-Bus clients. See @uref{https://dbus.freedesktop.org/doc/dbus-api-design.html}
1351for a discussion of the design. 1353for a discussion of the design.
@@ -1981,8 +1983,10 @@ of the D-Bus object emitting the message. @var{interface} and
1981@var{member} denote the message which has been sent. 1983@var{member} denote the message which has been sent.
1982 1984
1983@var{handler} is the callback function which has been registered for 1985@var{handler} is the callback function which has been registered for
1984this message (@pxref{Signals}). When a @code{dbus-event} event 1986this message (@pxref{Signals}). @var{args} are the typed arguments as
1985arrives, @var{handler} is called with @var{args} as arguments. 1987returned from the message. They are passed to @var{handler} without
1988type information, when it is called during event handling in
1989@code{dbus-handle-event}.
1986 1990
1987In order to inspect the @code{dbus-event} data, you could extend the 1991In order to inspect the @code{dbus-event} data, you could extend the
1988definition of the callback function in @ref{Signals}: 1992definition of the callback function in @ref{Signals}:
diff --git a/etc/NEWS b/etc/NEWS
index e5a34a8978e..81a4273b0f5 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -87,7 +87,7 @@ useful on systems such as FreeBSD which ships only with "etc/termcap".
87 87
88+++ 88+++
89*** Emacs now defaults to UTF-8 instead of ISO-8859-1. 89*** Emacs now defaults to UTF-8 instead of ISO-8859-1.
90This is only for the default, where the user has set no LANG (or 90This is only for the default, where the user has set no 'LANG' (or
91similar) variable or environment. This change should lead to no 91similar) variable or environment. This change should lead to no
92user-visible changes for normal usage. 92user-visible changes for normal usage.
93 93
@@ -128,12 +128,12 @@ and mode line. ('mwheel-mode' is enabled by default on most graphical
128displays.) 128displays.)
129 129
130--- 130---
131** The default value of 'frame-title-format' and icon-title-format' has changed. 131** The default value of 'frame-title-format' and 'icon-title-format' has changed.
132These variables are used to display the title bar of visible frames 132These variables are used to display the title bar of visible frames
133and the title bar of an iconified frame. They now show the name of 133and the title bar of an iconified frame. They now show the name of
134the current buffer and the text "GNU Emacs" instead of the value of 134the current buffer and the text "GNU Emacs" instead of the value of
135'invocation-name'. To get the old behavior back, add the following to 135'invocation-name'. To get the old behavior back, add the following to
136your Init file: 136your init file:
137 137
138 (setq frame-title-format '(multiple-frames "%b" 138 (setq frame-title-format '(multiple-frames "%b"
139 ("" invocation-name "@" system-name))) 139 ("" invocation-name "@" system-name)))
@@ -313,14 +313,14 @@ details of marking the file at the end of the region.
313directories with the help of new command 'dired-vc-next-action'. 313directories with the help of new command 'dired-vc-next-action'.
314 314
315+++ 315+++
316*** 'dired-jump' and 'dired-jump-other-window' moved from dired-x to dired. 316*** 'dired-jump' and 'dired-jump-other-window' moved from 'dired-x' to 'dired'.
317The 'dired-jump' and 'dired-jump-other-window' commands have been 317The 'dired-jump' and 'dired-jump-other-window' commands have been
318moved from the 'dired-x' package to 'dired'. The user option 318moved from the 'dired-x' package to 'dired'. The user option
319'dired-bind-jump' no longer has any effect and is now obsolete. 319'dired-bind-jump' no longer has any effect and is now obsolete.
320The commands are now bound to 'C-x C-j' and 'C-x 4 C-j' by default. 320The commands are now bound to 'C-x C-j' and 'C-x 4 C-j' by default.
321 321
322To get the old behavior of 'dired-bind-jump' back and unbind the above 322To get the old behavior of 'dired-bind-jump' back and unbind the above
323keys, add the following to your Init file: 323keys, add the following to your init file:
324 324
325(global-set-key "\C-x\C-j" nil) 325(global-set-key "\C-x\C-j" nil)
326(global-set-key "\C-x4\C-j" nil) 326(global-set-key "\C-x4\C-j" nil)
@@ -825,7 +825,7 @@ background colors or transparency, such as xbm, pbm, svg, png and gif.
825** EWW 825** EWW
826 826
827+++ 827+++
828*** New variable 'eww-retrieve-command'. 828*** New user option 'eww-retrieve-command'.
829This can be used to download data via an external command. If nil 829This can be used to download data via an external command. If nil
830(the default), then 'url-retrieve' is used. 830(the default), then 'url-retrieve' is used.
831 831
@@ -999,10 +999,10 @@ window after starting). This variable defaults to nil.
999** Miscellaneous 999** Miscellaneous
1000 1000
1001+++ 1001+++
1002*** New variables to control the look of line/column numbers in the mode line. 1002*** New user options to control the look of line/column numbers in the mode line.
1003'mode-line-position-line-format' is the line number format (when 1003'mode-line-position-line-format' is the line number format (when
1004'line-number-mode') is on, and 'mode-line-position-column-format' is 1004'line-number-mode' is on), and 'mode-line-position-column-format' is
1005the column number format (when 'column-number-mode') is on. These are 1005the column number format (when 'column-number-mode' is on). These are
1006also used if both modes are on, which leads to the default in that 1006also used if both modes are on, which leads to the default in that
1007case going from "(5,9)" to "(L5,C9)". 1007case going from "(5,9)" to "(L5,C9)".
1008 1008
@@ -1166,6 +1166,9 @@ messages, contain the error name of that message now. They can be
1166made visible by setting user variable 'dbus-show-dbus-errors' to 1166made visible by setting user variable 'dbus-show-dbus-errors' to
1167non-nil, even if protected by 'dbus-ignore-errors' otherwise. 1167non-nil, even if protected by 'dbus-ignore-errors' otherwise.
1168 1168
1169---
1170*** D-Bus events keep the type information of their arguments.
1171
1169 1172
1170* New Modes and Packages in Emacs 28.1 1173* New Modes and Packages in Emacs 28.1
1171 1174
@@ -1306,7 +1309,7 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el.
1306'semantic-flex-token-start', 'semantic-flex-token-text', 1309'semantic-flex-token-start', 'semantic-flex-token-text',
1307'semantic-imenu-bucketize-type-parts', 1310'semantic-imenu-bucketize-type-parts',
1308'semantic-imenu-expand-type-parts', 'semantic-imenu-expandable-token', 1311'semantic-imenu-expand-type-parts', 'semantic-imenu-expandable-token',
1309'semantic-init-db-hooks)', 'semantic-init-hooks', 1312'semantic-init-db-hooks', 'semantic-init-hooks',
1310'semantic-init-mode-hooks', 'semantic-java-prototype-nonterminal', 1313'semantic-init-mode-hooks', 'semantic-java-prototype-nonterminal',
1311'semantic-nonterminal-abstract', 'semantic-nonterminal-full-name', 1314'semantic-nonterminal-abstract', 'semantic-nonterminal-full-name',
1312'semantic-nonterminal-leaf', 'semantic-nonterminal-protection', 1315'semantic-nonterminal-leaf', 'semantic-nonterminal-protection',
@@ -1367,8 +1370,8 @@ This removes the final remaining trace of old-style backquotes.
1367'emacs_function' and 'emacs_finalizer' for module functions and 1370'emacs_function' and 'emacs_finalizer' for module functions and
1368finalizers, respectively. 1371finalizers, respectively.
1369 1372
1370** Module functions can now be made interactive. Use 1373** Module functions can now be made interactive.
1371'make_interactive' to give a module function an interactive 1374Use 'make_interactive' to give a module function an interactive
1372specification. 1375specification.
1373 1376
1374** Module functions can now install an optional finalizer that is 1377** Module functions can now install an optional finalizer that is
@@ -1440,8 +1443,8 @@ This can be used to parse RGB color specs in several formats and
1440convert them to a list '(R G B)' of primary color values. 1443convert them to a list '(R G B)' of primary color values.
1441 1444
1442--- 1445---
1443** Variable 'uniquify-buffer-name-style' can now be a function. 1446** User option 'uniquify-buffer-name-style' can now be a function.
1444This variable can be one of the predefined styles or a function to 1447This user option can be one of the predefined styles or a function to
1445personalize the uniquified buffer name. 1448personalize the uniquified buffer name.
1446 1449
1447 1450
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index d4e6cb943df..fa910643a35 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -1016,8 +1016,9 @@ D-Bus message. SERVICE and PATH are the unique name and the
1016object path of the D-Bus object emitting the message. INTERFACE 1016object path of the D-Bus object emitting the message. INTERFACE
1017and MEMBER denote the message which has been sent. HANDLER is 1017and MEMBER denote the message which has been sent. HANDLER is
1018the function which has been registered for this message. ARGS 1018the function which has been registered for this message. ARGS
1019are the arguments passed to HANDLER, when it is called during 1019are the typed arguments as returned from the message. They are
1020event handling in `dbus-handle-event'. 1020passed to HANDLER without type information, when it is called
1021during event handling in `dbus-handle-event'.
1021 1022
1022This function signals a `dbus-error' if the event is not well 1023This function signals a `dbus-error' if the event is not well
1023formed." 1024formed."
@@ -1053,22 +1054,53 @@ formed."
1053 (functionp (nth 8 event))) 1054 (functionp (nth 8 event)))
1054 (signal 'dbus-error (list "Not a valid D-Bus event" event)))) 1055 (signal 'dbus-error (list "Not a valid D-Bus event" event))))
1055 1056
1057(defun dbus-delete-types (&rest args)
1058 "Delete type information from arguments retrieved via `dbus-handle-event'.
1059Basic type arguments (TYPE VALUE) will be transformed into VALUE, and
1060compound type arguments (TYPE VALUE) will be transformed into (VALUE)."
1061 (car
1062 (mapcar
1063 (lambda (elt)
1064 (cond
1065 ((atom elt) elt)
1066 ((memq (car elt) dbus-compound-types)
1067 (mapcar #'dbus-delete-types (cdr elt)))
1068 (t (cadr elt))))
1069 args)))
1070
1071(defun dbus-flatten-types (arg)
1072 "Flatten type information from argument retrieved via `dbus-handle-event'.
1073Basic type arguments (TYPE VALUE) will be transformed into TYPE VALUE, and
1074compound type arguments (TYPE VALUE) will be kept as is."
1075 (let (result)
1076 (dolist (elt arg)
1077 (cond
1078 ((atom elt) (push elt result))
1079 ((and (not (memq (car elt) dbus-compound-types)))
1080 (push (car elt) result)
1081 (push (cadr elt) result))
1082 (t
1083 (push (cons (car elt) (dbus-flatten-types (cdr elt))) result))))
1084 (nreverse result)))
1085
1056;;;###autoload 1086;;;###autoload
1057(defun dbus-handle-event (event) 1087(defun dbus-handle-event (event)
1058 "Handle events from the D-Bus. 1088 "Handle events from the D-Bus.
1059EVENT is a D-Bus event, see `dbus-check-event'. HANDLER, being 1089EVENT is a D-Bus event, see `dbus-check-event'. HANDLER, being
1060part of the event, is called with arguments ARGS. 1090part of the event, is called with arguments ARGS (without type information).
1061If the HANDLER returns a `dbus-error', it is propagated as return message." 1091If the HANDLER returns a `dbus-error', it is propagated as return message."
1062 (interactive "e") 1092 (interactive "e")
1063 (condition-case err 1093 (condition-case err
1064 (let (result) 1094 (let (args result)
1065 ;; We ignore not well-formed events. 1095 ;; We ignore not well-formed events.
1066 (dbus-check-event event) 1096 (dbus-check-event event)
1097 ;; Remove type information.
1098 (setq args (mapcar #'dbus-delete-types (nthcdr 9 event)))
1067 ;; Error messages must be propagated. 1099 ;; Error messages must be propagated.
1068 (when (= dbus-message-type-error (nth 2 event)) 1100 (when (= dbus-message-type-error (nth 2 event))
1069 (signal 'dbus-error (nthcdr 9 event))) 1101 (signal 'dbus-error args))
1070 ;; Apply the handler. 1102 ;; Apply the handler.
1071 (setq result (apply (nth 8 event) (nthcdr 9 event))) 1103 (setq result (apply (nth 8 event) args))
1072 ;; Return an (error) message when it is a message call. 1104 ;; Return an (error) message when it is a message call.
1073 (when (= dbus-message-type-method-call (nth 2 event)) 1105 (when (= dbus-message-type-method-call (nth 2 event))
1074 (dbus-ignore-errors 1106 (dbus-ignore-errors
@@ -1491,7 +1523,7 @@ return nil.
1491 ;; "Set" requires a variant. 1523 ;; "Set" requires a variant.
1492 (dbus-call-method 1524 (dbus-call-method
1493 bus service path dbus-interface-properties 1525 bus service path dbus-interface-properties
1494 "Set" :timeout 500 interface property (list :variant args)) 1526 "Set" :timeout 500 interface property (cons :variant args))
1495 ;; Return VALUE. 1527 ;; Return VALUE.
1496 (or (dbus-get-property bus service path interface property) 1528 (or (dbus-get-property bus service path interface property)
1497 (if (symbolp (car args)) (cadr args) (car args))))) 1529 (if (symbolp (car args)) (cadr args) (car args)))))
@@ -1570,8 +1602,7 @@ clients from discovering the still incomplete interface.
1570 1602
1571\(dbus-register-property BUS SERVICE PATH INTERFACE PROPERTY ACCESS \ 1603\(dbus-register-property BUS SERVICE PATH INTERFACE PROPERTY ACCESS \
1572[TYPE] VALUE &optional EMITS-SIGNAL DONT-REGISTER-SERVICE)" 1604[TYPE] VALUE &optional EMITS-SIGNAL DONT-REGISTER-SERVICE)"
1573 (let ((signature "s") ;; FIXME: For the time being. 1605 (let (;; Read basic type symbol.
1574 ;; Read basic type symbol.
1575 (type (when (symbolp (car args)) (pop args))) 1606 (type (when (symbolp (car args)) (pop args)))
1576 (value (pop args)) 1607 (value (pop args))
1577 (emits-signal (pop args)) 1608 (emits-signal (pop args))
@@ -1590,6 +1621,8 @@ clients from discovering the still incomplete interface.
1590 (signal 'wrong-type-argument (list "Value type invalid" value)))))) 1621 (signal 'wrong-type-argument (list "Value type invalid" value))))))
1591 (unless (consp value) 1622 (unless (consp value)
1592 (setq value (list type value))) 1623 (setq value (list type value)))
1624 (setq value (if (member (car value) dbus-compound-types)
1625 (list :variant value) (cons :variant value)))
1593 1626
1594 ;; Add handlers for the three property-related methods. 1627 ;; Add handlers for the three property-related methods.
1595 (dbus-register-method 1628 (dbus-register-method
@@ -1627,8 +1660,7 @@ clients from discovering the still incomplete interface.
1627 (let ((key (list :property bus interface property)) 1660 (let ((key (list :property bus interface property))
1628 (val 1661 (val
1629 (cons 1662 (cons
1630 (list 1663 (list nil service path (list access emits-signal value))
1631 nil service path (list access emits-signal signature value))
1632 (dbus-get-other-registered-properties 1664 (dbus-get-other-registered-properties
1633 bus service path interface property)))) 1665 bus service path interface property))))
1634 (puthash key val dbus-registered-objects-table) 1666 (puthash key val dbus-registered-objects-table)
@@ -1639,12 +1671,13 @@ clients from discovering the still incomplete interface.
1639(defun dbus-property-handler (&rest args) 1671(defun dbus-property-handler (&rest args)
1640 "Default handler for the \"org.freedesktop.DBus.Properties\" interface. 1672 "Default handler for the \"org.freedesktop.DBus.Properties\" interface.
1641It will be registered for all objects created by `dbus-register-property'." 1673It will be registered for all objects created by `dbus-register-property'."
1642 (let ((bus (dbus-event-bus-name last-input-event)) 1674 (let* ((last-input-event last-input-event)
1643 (service (dbus-event-service-name last-input-event)) 1675 (bus (dbus-event-bus-name last-input-event))
1644 (path (dbus-event-path-name last-input-event)) 1676 (service (dbus-event-service-name last-input-event))
1645 (method (dbus-event-member-name last-input-event)) 1677 (path (dbus-event-path-name last-input-event))
1646 (interface (car args)) 1678 (method (dbus-event-member-name last-input-event))
1647 (property (cadr args))) 1679 (interface (car args))
1680 (property (cadr args)))
1648 (cond 1681 (cond
1649 ;; "Get" returns a variant. 1682 ;; "Get" returns a variant.
1650 ((string-equal method "Get") 1683 ((string-equal method "Get")
@@ -1662,13 +1695,11 @@ It will be registered for all objects created by `dbus-register-property'."
1662 "Property \"%s\" at path \"%s\" is not readable" property path))) 1695 "Property \"%s\" at path \"%s\" is not readable" property path)))
1663 ;; Return the result. Since variant is a list, we must embed 1696 ;; Return the result. Since variant is a list, we must embed
1664 ;; it into another list. 1697 ;; it into another list.
1665 (t (list (if (memq (car (nth 3 object)) dbus-compound-types) 1698 (t (list (nth 2 object))))))
1666 (list :variant (nth 3 object))
1667 (cons :variant (nth 3 object))))))))
1668 1699
1669 ;; "Set" expects the same type as registered. FIXME: Implement! 1700 ;; "Set" needs the third typed argument from `last-input-event'.
1670 ((string-equal method "Set") 1701 ((string-equal method "Set")
1671 (let* ((value (caar (nth 2 args))) 1702 (let* ((value (nth 11 last-input-event))
1672 (entry (dbus-get-this-registered-property 1703 (entry (dbus-get-this-registered-property
1673 bus service path interface property)) 1704 bus service path interface property))
1674 (object (car (last (car entry))))) 1705 (object (car (last (car entry)))))
@@ -1681,13 +1712,12 @@ It will be registered for all objects created by `dbus-register-property'."
1681 `(:error ,dbus-error-property-read-only 1712 `(:error ,dbus-error-property-read-only
1682 ,(format-message 1713 ,(format-message
1683 "Property \"%s\" at path \"%s\" is not writable" property path))) 1714 "Property \"%s\" at path \"%s\" is not writable" property path)))
1684 (t (unless (consp value) 1715 (t (puthash (list :property bus interface property)
1685 (setq value (list (car (nth 3 object)) value)))
1686 (puthash (list :property bus interface property)
1687 (cons (append 1716 (cons (append
1688 (butlast (car entry)) 1717 (butlast (car entry))
1689 ;; Reuse ACCESS, EMITS-SIGNAL and TYPE. 1718 ;; Reuse ACCESS and EMITS-SIGNAL.
1690 (list (append (butlast object) (list value)))) 1719 (list (append (butlast object)
1720 (list (dbus-flatten-types value)))))
1691 (dbus-get-other-registered-properties 1721 (dbus-get-other-registered-properties
1692 bus service path interface property)) 1722 bus service path interface property))
1693 dbus-registered-objects-table) 1723 dbus-registered-objects-table)
@@ -1719,11 +1749,7 @@ It will be registered for all objects created by `dbus-register-property'."
1719 (consp object) 1749 (consp object)
1720 (not (eq :write (car object)))) 1750 (not (eq :write (car object))))
1721 (push 1751 (push
1722 (list :dict-entry 1752 (list :dict-entry (car (last key)) (nth 2 object))
1723 (car (last key))
1724 (if (memq (car (nth 3 object)) dbus-compound-types)
1725 (list :variant (nth 3 object))
1726 (cons :variant (nth 3 object))))
1727 result)))))) 1753 result))))))
1728 dbus-registered-objects-table) 1754 dbus-registered-objects-table)
1729 ;; Return the result, or an empty array. An array must be 1755 ;; Return the result, or an empty array. An array must be
diff --git a/src/dbusbind.c b/src/dbusbind.c
index 02af244ac38..46e2e22aa0e 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -129,36 +129,23 @@ static bool xd_in_read_queued_messages = 0;
129#define XD_BASIC_DBUS_TYPE(type) \ 129#define XD_BASIC_DBUS_TYPE(type) \
130 (dbus_type_is_valid (type) && dbus_type_is_basic (type)) 130 (dbus_type_is_valid (type) && dbus_type_is_basic (type))
131#else 131#else
132#ifdef DBUS_TYPE_UNIX_FD
133#define XD_BASIC_DBUS_TYPE(type) \
134 ((type == DBUS_TYPE_BYTE) \
135 || (type == DBUS_TYPE_BOOLEAN) \
136 || (type == DBUS_TYPE_INT16) \
137 || (type == DBUS_TYPE_UINT16) \
138 || (type == DBUS_TYPE_INT32) \
139 || (type == DBUS_TYPE_UINT32) \
140 || (type == DBUS_TYPE_INT64) \
141 || (type == DBUS_TYPE_UINT64) \
142 || (type == DBUS_TYPE_DOUBLE) \
143 || (type == DBUS_TYPE_STRING) \
144 || (type == DBUS_TYPE_OBJECT_PATH) \
145 || (type == DBUS_TYPE_SIGNATURE) \
146 || (type == DBUS_TYPE_UNIX_FD))
147#else
148#define XD_BASIC_DBUS_TYPE(type) \ 132#define XD_BASIC_DBUS_TYPE(type) \
149 ((type == DBUS_TYPE_BYTE) \ 133 ((type == DBUS_TYPE_BYTE) \
150 || (type == DBUS_TYPE_BOOLEAN) \ 134 || (type == DBUS_TYPE_BOOLEAN) \
151 || (type == DBUS_TYPE_INT16) \ 135 || (type == DBUS_TYPE_INT16) \
152 || (type == DBUS_TYPE_UINT16) \ 136 || (type == DBUS_TYPE_UINT16) \
153 || (type == DBUS_TYPE_INT32) \ 137 || (type == DBUS_TYPE_INT32) \
154 || (type == DBUS_TYPE_UINT32) \ 138 || (type == DBUS_TYPE_UINT32) \
155 || (type == DBUS_TYPE_INT64) \ 139 || (type == DBUS_TYPE_INT64) \
156 || (type == DBUS_TYPE_UINT64) \ 140 || (type == DBUS_TYPE_UINT64) \
157 || (type == DBUS_TYPE_DOUBLE) \ 141 || (type == DBUS_TYPE_DOUBLE) \
158 || (type == DBUS_TYPE_STRING) \ 142 || (type == DBUS_TYPE_STRING) \
159 || (type == DBUS_TYPE_OBJECT_PATH) \ 143 || (type == DBUS_TYPE_OBJECT_PATH) \
160 || (type == DBUS_TYPE_SIGNATURE)) 144 || (type == DBUS_TYPE_SIGNATURE) \
145#ifdef DBUS_TYPE_UNIX_FD
146 || (type == DBUS_TYPE_UNIX_FD) \
161#endif 147#endif
148 )
162#endif 149#endif
163 150
164/* This was a macro. On Solaris 2.11 it was said to compile for 151/* This was a macro. On Solaris 2.11 it was said to compile for
@@ -192,6 +179,33 @@ xd_symbol_to_dbus_type (Lisp_Object object)
192 : DBUS_TYPE_INVALID); 179 : DBUS_TYPE_INVALID);
193} 180}
194 181
182/* Determine the Lisp symbol of DBusType. */
183static Lisp_Object
184xd_dbus_type_to_symbol (int type)
185{
186 return
187 (type == DBUS_TYPE_BYTE) ? QCbyte
188 : (type == DBUS_TYPE_BOOLEAN) ? QCboolean
189 : (type == DBUS_TYPE_INT16) ? QCint16
190 : (type == DBUS_TYPE_UINT16) ? QCuint16
191 : (type == DBUS_TYPE_INT32) ? QCint32
192 : (type == DBUS_TYPE_UINT32) ? QCuint32
193 : (type == DBUS_TYPE_INT64) ? QCint64
194 : (type == DBUS_TYPE_UINT64) ? QCuint64
195 : (type == DBUS_TYPE_DOUBLE) ? QCdouble
196 : (type == DBUS_TYPE_STRING) ? QCstring
197 : (type == DBUS_TYPE_OBJECT_PATH) ? QCobject_path
198 : (type == DBUS_TYPE_SIGNATURE) ? QCsignature
199#ifdef DBUS_TYPE_UNIX_FD
200 : (type == DBUS_TYPE_UNIX_FD) ? QCunix_fd
201#endif
202 : (type == DBUS_TYPE_ARRAY) ? QCarray
203 : (type == DBUS_TYPE_VARIANT) ? QCvariant
204 : (type == DBUS_TYPE_STRUCT) ? QCstruct
205 : (type == DBUS_TYPE_DICT_ENTRY) ? QCdict_entry
206 : Qnil;
207}
208
195/* Check whether a Lisp symbol is a predefined D-Bus type symbol. */ 209/* Check whether a Lisp symbol is a predefined D-Bus type symbol. */
196#define XD_DBUS_TYPE_P(object) \ 210#define XD_DBUS_TYPE_P(object) \
197 (SYMBOLP (object) && ((xd_symbol_to_dbus_type (object) != DBUS_TYPE_INVALID))) 211 (SYMBOLP (object) && ((xd_symbol_to_dbus_type (object) != DBUS_TYPE_INVALID)))
@@ -816,7 +830,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
816 dbus_message_iter_get_basic (iter, &val); 830 dbus_message_iter_get_basic (iter, &val);
817 val = val & 0xFF; 831 val = val & 0xFF;
818 XD_DEBUG_MESSAGE ("%c %u", dtype, val); 832 XD_DEBUG_MESSAGE ("%c %u", dtype, val);
819 return make_fixnum (val); 833 return list2 (xd_dbus_type_to_symbol (dtype), make_fixnum (val));
820 } 834 }
821 835
822 case DBUS_TYPE_BOOLEAN: 836 case DBUS_TYPE_BOOLEAN:
@@ -824,7 +838,8 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
824 dbus_bool_t val; 838 dbus_bool_t val;
825 dbus_message_iter_get_basic (iter, &val); 839 dbus_message_iter_get_basic (iter, &val);
826 XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true"); 840 XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true");
827 return (val == FALSE) ? Qnil : Qt; 841 return list2 (xd_dbus_type_to_symbol (dtype),
842 (val == FALSE) ? Qnil : Qt);
828 } 843 }
829 844
830 case DBUS_TYPE_INT16: 845 case DBUS_TYPE_INT16:
@@ -834,7 +849,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
834 dbus_message_iter_get_basic (iter, &val); 849 dbus_message_iter_get_basic (iter, &val);
835 pval = val; 850 pval = val;
836 XD_DEBUG_MESSAGE ("%c %d", dtype, pval); 851 XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
837 return make_fixnum (val); 852 return list2 (xd_dbus_type_to_symbol (dtype), make_fixnum (val));
838 } 853 }
839 854
840 case DBUS_TYPE_UINT16: 855 case DBUS_TYPE_UINT16:
@@ -844,7 +859,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
844 dbus_message_iter_get_basic (iter, &val); 859 dbus_message_iter_get_basic (iter, &val);
845 pval = val; 860 pval = val;
846 XD_DEBUG_MESSAGE ("%c %d", dtype, pval); 861 XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
847 return make_fixnum (val); 862 return list2 (xd_dbus_type_to_symbol (dtype), make_fixnum (val));
848 } 863 }
849 864
850 case DBUS_TYPE_INT32: 865 case DBUS_TYPE_INT32:
@@ -854,7 +869,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
854 dbus_message_iter_get_basic (iter, &val); 869 dbus_message_iter_get_basic (iter, &val);
855 pval = val; 870 pval = val;
856 XD_DEBUG_MESSAGE ("%c %d", dtype, pval); 871 XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
857 return INT_TO_INTEGER (val); 872 return list2 (xd_dbus_type_to_symbol (dtype), INT_TO_INTEGER (val));
858 } 873 }
859 874
860 case DBUS_TYPE_UINT32: 875 case DBUS_TYPE_UINT32:
@@ -867,7 +882,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
867 dbus_message_iter_get_basic (iter, &val); 882 dbus_message_iter_get_basic (iter, &val);
868 pval = val; 883 pval = val;
869 XD_DEBUG_MESSAGE ("%c %u", dtype, pval); 884 XD_DEBUG_MESSAGE ("%c %u", dtype, pval);
870 return INT_TO_INTEGER (val); 885 return list2 (xd_dbus_type_to_symbol (dtype), INT_TO_INTEGER (val));
871 } 886 }
872 887
873 case DBUS_TYPE_INT64: 888 case DBUS_TYPE_INT64:
@@ -876,7 +891,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
876 dbus_message_iter_get_basic (iter, &val); 891 dbus_message_iter_get_basic (iter, &val);
877 intmax_t pval = val; 892 intmax_t pval = val;
878 XD_DEBUG_MESSAGE ("%c %"PRIdMAX, dtype, pval); 893 XD_DEBUG_MESSAGE ("%c %"PRIdMAX, dtype, pval);
879 return INT_TO_INTEGER (val); 894 return list2 (xd_dbus_type_to_symbol (dtype), INT_TO_INTEGER (val));
880 } 895 }
881 896
882 case DBUS_TYPE_UINT64: 897 case DBUS_TYPE_UINT64:
@@ -885,7 +900,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
885 dbus_message_iter_get_basic (iter, &val); 900 dbus_message_iter_get_basic (iter, &val);
886 uintmax_t pval = val; 901 uintmax_t pval = val;
887 XD_DEBUG_MESSAGE ("%c %"PRIuMAX, dtype, pval); 902 XD_DEBUG_MESSAGE ("%c %"PRIuMAX, dtype, pval);
888 return INT_TO_INTEGER (val); 903 return list2 (xd_dbus_type_to_symbol (dtype), INT_TO_INTEGER (val));
889 } 904 }
890 905
891 case DBUS_TYPE_DOUBLE: 906 case DBUS_TYPE_DOUBLE:
@@ -893,7 +908,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
893 double val; 908 double val;
894 dbus_message_iter_get_basic (iter, &val); 909 dbus_message_iter_get_basic (iter, &val);
895 XD_DEBUG_MESSAGE ("%c %f", dtype, val); 910 XD_DEBUG_MESSAGE ("%c %f", dtype, val);
896 return make_float (val); 911 return list2 (xd_dbus_type_to_symbol (dtype), make_float (val));
897 } 912 }
898 913
899 case DBUS_TYPE_STRING: 914 case DBUS_TYPE_STRING:
@@ -903,7 +918,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
903 char *val; 918 char *val;
904 dbus_message_iter_get_basic (iter, &val); 919 dbus_message_iter_get_basic (iter, &val);
905 XD_DEBUG_MESSAGE ("%c %s", dtype, val); 920 XD_DEBUG_MESSAGE ("%c %s", dtype, val);
906 return build_string (val); 921 return list2 (xd_dbus_type_to_symbol (dtype), build_string (val));
907 } 922 }
908 923
909 case DBUS_TYPE_ARRAY: 924 case DBUS_TYPE_ARRAY:
@@ -923,7 +938,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
923 dbus_message_iter_next (&subiter); 938 dbus_message_iter_next (&subiter);
924 } 939 }
925 XD_DEBUG_MESSAGE ("%c %s", dtype, XD_OBJECT_TO_STRING (result)); 940 XD_DEBUG_MESSAGE ("%c %s", dtype, XD_OBJECT_TO_STRING (result));
926 return Fnreverse (result); 941 return Fcons (xd_dbus_type_to_symbol (dtype), Fnreverse (result));
927 } 942 }
928 943
929 default: 944 default:
@@ -1544,7 +1559,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
1544 path = dbus_message_get_path (dmessage); 1559 path = dbus_message_get_path (dmessage);
1545 interface = dbus_message_get_interface (dmessage); 1560 interface = dbus_message_get_interface (dmessage);
1546 member = dbus_message_get_member (dmessage); 1561 member = dbus_message_get_member (dmessage);
1547 error_name =dbus_message_get_error_name (dmessage); 1562 error_name = dbus_message_get_error_name (dmessage);
1548 1563
1549 XD_DEBUG_MESSAGE ("Event received: %s %u %s %s %s %s %s %s", 1564 XD_DEBUG_MESSAGE ("Event received: %s %u %s %s %s %s %s %s",
1550 XD_MESSAGE_TYPE_TO_STRING (mtype), 1565 XD_MESSAGE_TYPE_TO_STRING (mtype),
@@ -1572,9 +1587,10 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
1572 EVENT_INIT (event); 1587 EVENT_INIT (event);
1573 event.kind = DBUS_EVENT; 1588 event.kind = DBUS_EVENT;
1574 event.frame_or_window = Qnil; 1589 event.frame_or_window = Qnil;
1575 event.arg = Fcons (value, 1590 event.arg =
1576 (mtype == DBUS_MESSAGE_TYPE_ERROR) 1591 Fcons (value,
1577 ? (Fcons (build_string (error_name), args)) : args); 1592 (mtype == DBUS_MESSAGE_TYPE_ERROR)
1593 ? Fcons (list2 (QCstring, build_string (error_name)), args) : args);
1578 } 1594 }
1579 1595
1580 else /* DBUS_MESSAGE_TYPE_METHOD_CALL, DBUS_MESSAGE_TYPE_SIGNAL. */ 1596 else /* DBUS_MESSAGE_TYPE_METHOD_CALL, DBUS_MESSAGE_TYPE_SIGNAL. */
@@ -1828,7 +1844,7 @@ wildcard then.
1828 1844
1829OBJECT is either the handler to be called when a D-Bus message, which 1845OBJECT is either the handler to be called when a D-Bus message, which
1830matches the key criteria, arrives (TYPE `:method' and `:signal'), or a 1846matches the key criteria, arrives (TYPE `:method' and `:signal'), or a
1831list (ACCESS EMITS-SIGNAL SIGNATURE VALUE) for TYPE `:property'. 1847list (ACCESS EMITS-SIGNAL VALUE) for TYPE `:property'.
1832 1848
1833For entries of type `:signal', there is also a fifth element RULE, 1849For entries of type `:signal', there is also a fifth element RULE,
1834which keeps the match string the signal is registered with. 1850which keeps the match string the signal is registered with.