diff options
| author | Michael Albinus | 2020-09-16 14:32:57 +0200 |
|---|---|---|
| committer | Michael Albinus | 2020-09-16 14:32:57 +0200 |
| commit | 92f342f38dd82aae4a662708dd6280fdfb2e013b (patch) | |
| tree | d6c895200d165224678d04b51ae03d8f149ca23a | |
| parent | 96f1fedf4dd662dbd5bba7eebc0b9c9e926fbce6 (diff) | |
| download | emacs-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.texi | 8 | ||||
| -rw-r--r-- | etc/NEWS | 31 | ||||
| -rw-r--r-- | lisp/net/dbus.el | 90 | ||||
| -rw-r--r-- | src/dbusbind.c | 104 |
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 | |||
| 1349 | You can offer an own service in D-Bus, which will be visible by other | 1351 | You can offer an own service in D-Bus, which will be visible by other |
| 1350 | D-Bus clients. See @uref{https://dbus.freedesktop.org/doc/dbus-api-design.html} | 1352 | D-Bus clients. See @uref{https://dbus.freedesktop.org/doc/dbus-api-design.html} |
| 1351 | for a discussion of the design. | 1353 | for 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 |
| 1984 | this message (@pxref{Signals}). When a @code{dbus-event} event | 1986 | this message (@pxref{Signals}). @var{args} are the typed arguments as |
| 1985 | arrives, @var{handler} is called with @var{args} as arguments. | 1987 | returned from the message. They are passed to @var{handler} without |
| 1988 | type information, when it is called during event handling in | ||
| 1989 | @code{dbus-handle-event}. | ||
| 1986 | 1990 | ||
| 1987 | In order to inspect the @code{dbus-event} data, you could extend the | 1991 | In order to inspect the @code{dbus-event} data, you could extend the |
| 1988 | definition of the callback function in @ref{Signals}: | 1992 | definition of the callback function in @ref{Signals}: |
| @@ -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. |
| 90 | This is only for the default, where the user has set no LANG (or | 90 | This is only for the default, where the user has set no 'LANG' (or |
| 91 | similar) variable or environment. This change should lead to no | 91 | similar) variable or environment. This change should lead to no |
| 92 | user-visible changes for normal usage. | 92 | user-visible changes for normal usage. |
| 93 | 93 | ||
| @@ -128,12 +128,12 @@ and mode line. ('mwheel-mode' is enabled by default on most graphical | |||
| 128 | displays.) | 128 | displays.) |
| 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. |
| 132 | These variables are used to display the title bar of visible frames | 132 | These variables are used to display the title bar of visible frames |
| 133 | and the title bar of an iconified frame. They now show the name of | 133 | and the title bar of an iconified frame. They now show the name of |
| 134 | the current buffer and the text "GNU Emacs" instead of the value of | 134 | the 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 |
| 136 | your Init file: | 136 | your 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. | |||
| 313 | directories with the help of new command 'dired-vc-next-action'. | 313 | directories 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'. |
| 317 | The 'dired-jump' and 'dired-jump-other-window' commands have been | 317 | The 'dired-jump' and 'dired-jump-other-window' commands have been |
| 318 | moved from the 'dired-x' package to 'dired'. The user option | 318 | moved 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. |
| 320 | The commands are now bound to 'C-x C-j' and 'C-x 4 C-j' by default. | 320 | The commands are now bound to 'C-x C-j' and 'C-x 4 C-j' by default. |
| 321 | 321 | ||
| 322 | To get the old behavior of 'dired-bind-jump' back and unbind the above | 322 | To get the old behavior of 'dired-bind-jump' back and unbind the above |
| 323 | keys, add the following to your Init file: | 323 | keys, 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'. |
| 829 | This can be used to download data via an external command. If nil | 829 | This 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 |
| 1005 | the column number format (when 'column-number-mode') is on. These are | 1005 | the column number format (when 'column-number-mode' is on). These are |
| 1006 | also used if both modes are on, which leads to the default in that | 1006 | also used if both modes are on, which leads to the default in that |
| 1007 | case going from "(5,9)" to "(L5,C9)". | 1007 | case 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 | |||
| 1166 | made visible by setting user variable 'dbus-show-dbus-errors' to | 1166 | made visible by setting user variable 'dbus-show-dbus-errors' to |
| 1167 | non-nil, even if protected by 'dbus-ignore-errors' otherwise. | 1167 | non-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 |
| 1368 | finalizers, respectively. | 1371 | finalizers, 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 | 1374 | Use 'make_interactive' to give a module function an interactive |
| 1372 | specification. | 1375 | specification. |
| 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 | |||
| 1440 | convert them to a list '(R G B)' of primary color values. | 1443 | convert 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. |
| 1444 | This variable can be one of the predefined styles or a function to | 1447 | This user option can be one of the predefined styles or a function to |
| 1445 | personalize the uniquified buffer name. | 1448 | personalize 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 | |||
| 1016 | object path of the D-Bus object emitting the message. INTERFACE | 1016 | object path of the D-Bus object emitting the message. INTERFACE |
| 1017 | and MEMBER denote the message which has been sent. HANDLER is | 1017 | and MEMBER denote the message which has been sent. HANDLER is |
| 1018 | the function which has been registered for this message. ARGS | 1018 | the function which has been registered for this message. ARGS |
| 1019 | are the arguments passed to HANDLER, when it is called during | 1019 | are the typed arguments as returned from the message. They are |
| 1020 | event handling in `dbus-handle-event'. | 1020 | passed to HANDLER without type information, when it is called |
| 1021 | during event handling in `dbus-handle-event'. | ||
| 1021 | 1022 | ||
| 1022 | This function signals a `dbus-error' if the event is not well | 1023 | This function signals a `dbus-error' if the event is not well |
| 1023 | formed." | 1024 | formed." |
| @@ -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'. | ||
| 1059 | Basic type arguments (TYPE VALUE) will be transformed into VALUE, and | ||
| 1060 | compound 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'. | ||
| 1073 | Basic type arguments (TYPE VALUE) will be transformed into TYPE VALUE, and | ||
| 1074 | compound 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. |
| 1059 | EVENT is a D-Bus event, see `dbus-check-event'. HANDLER, being | 1089 | EVENT is a D-Bus event, see `dbus-check-event'. HANDLER, being |
| 1060 | part of the event, is called with arguments ARGS. | 1090 | part of the event, is called with arguments ARGS (without type information). |
| 1061 | If the HANDLER returns a `dbus-error', it is propagated as return message." | 1091 | If 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. |
| 1641 | It will be registered for all objects created by `dbus-register-property'." | 1673 | It 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. */ | ||
| 183 | static Lisp_Object | ||
| 184 | xd_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 | ||
| 1829 | OBJECT is either the handler to be called when a D-Bus message, which | 1845 | OBJECT is either the handler to be called when a D-Bus message, which |
| 1830 | matches the key criteria, arrives (TYPE `:method' and `:signal'), or a | 1846 | matches the key criteria, arrives (TYPE `:method' and `:signal'), or a |
| 1831 | list (ACCESS EMITS-SIGNAL SIGNATURE VALUE) for TYPE `:property'. | 1847 | list (ACCESS EMITS-SIGNAL VALUE) for TYPE `:property'. |
| 1832 | 1848 | ||
| 1833 | For entries of type `:signal', there is also a fifth element RULE, | 1849 | For entries of type `:signal', there is also a fifth element RULE, |
| 1834 | which keeps the match string the signal is registered with. | 1850 | which keeps the match string the signal is registered with. |