From: "Basil L. Contovounesios" <contovob@tcd.ie>
To: Michael Albinus <michael.albinus@gmx.de>
Cc: 41744@debbugs.gnu.org
Subject: bug#41744: 27.0.91; Various D-Bus cleanups
Date: Wed, 17 Jun 2020 21:08:46 +0100 [thread overview]
Message-ID: <87d05xbgkx.fsf@tcd.ie> (raw)
In-Reply-To: <874krln7fg.fsf@gmx.de> (Michael Albinus's message of "Mon, 08 Jun 2020 13:06:11 +0200")
[-- Attachment #1: Type: text/plain, Size: 365 bytes --]
Michael Albinus <michael.albinus@gmx.de> writes:
> "Basil L. Contovounesios" <contovob@tcd.ie> writes:
>
>> And these implementation cleanups for master:
>
> This I will review once the first patch set has arrived in master.
The doc patch for emacs-27 has now propagated to master, so here's a
rebased version of the patch for master. WDYT?
Thanks,
--
Basil
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Various-dbus.el-cleanups-bug-41744.patch --]
[-- Type: text/x-diff, Size: 25742 bytes --]
From 37e8bcd3b14ee3a26a817ae95f6568db7e379fcf Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
Date: Sat, 6 Jun 2020 13:20:06 +0100
Subject: [PATCH] Various dbus.el cleanups (bug#41744)
* lisp/net/dbus.el: Remove unneeded dependency on cl-lib.el. Quote
function symbols as such.
(dbus-ignore-errors): Don't add macro name to font-lock keywords, as
emacs-lisp-mode now dynamically fontifies new macro definitions.
(dbus-call-method-non-blocking): Define as obosolete alias using
define-obsolete-function-alias.
(dbus-register-signal, dbus-escape-as-identifier): Simplify. Use
regexp \` and \' in place of ^ and $.
(dbus--parse-xml-buffer): New function for libxml2 compatibility.
(dbus-introspect-xml): Use it.
(dbus-string-to-byte-array, dbus-byte-array-to-string)
(dbus-unescape-from-identifier, dbus-list-known-names)
(dbus-introspect-get-all-nodes, dbus-get-all-properties)
(dbus-get-all-managed-objects): Simplify.
(dbus--introspect-names, dbus--introspect-name): New convenience
functions.
(dbus-introspect-get-node-names)
(dbus-introspect-get-interface-names)
(dbus-introspect-get-interface, dbus-introspect-get-method-names)
(dbus-introspect-get-method, dbus-introspect-get-signal-names)
(dbus-introspect-get-signal, dbus-introspect-get-property-names)
(dbus-introspect-get-property)
(dbus-introspect-get-annotation-names)
(dbus-introspect-get-annotation)
(dbus-introspect-get-argument-names, dbus-introspect-get-argument):
Use them to DRY.
* test/lisp/net/dbus-tests.el (dbus-test-all): Quote function
symbols as such.
---
lisp/net/dbus.el | 269 +++++++++++++++---------------------
test/lisp/net/dbus-tests.el | 4 +-
2 files changed, 111 insertions(+), 162 deletions(-)
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index 06bd9e567f..e2e95b8e57 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -51,9 +51,6 @@ dbus-registered-objects-table
(unless (boundp 'dbus-debug)
(defvar dbus-debug nil))
-;; Pacify byte compiler.
-(eval-when-compile (require 'cl-lib))
-
(require 'xml)
(defconst dbus-service-dbus "org.freedesktop.DBus"
@@ -169,7 +166,6 @@ dbus-ignore-errors
`(condition-case err
(progn ,@body)
(dbus-error (when dbus-debug (signal (car err) (cdr err))))))
-(font-lock-add-keywords 'emacs-lisp-mode '("\\<dbus-ignore-errors\\>"))
(define-obsolete-variable-alias 'dbus-event-error-hooks
'dbus-event-error-functions "24.3")
@@ -181,7 +177,7 @@ dbus-event-error-functions
\f
;;; Basic D-Bus message functions.
-(defvar dbus-return-values-table (make-hash-table :test 'equal)
+(defvar dbus-return-values-table (make-hash-table :test #'equal)
"Hash table for temporarily storing arguments of reply messages.
A key in this hash table is a list (:serial BUS SERIAL), like in
`dbus-registered-objects-table'. BUS is either a Lisp symbol,
@@ -301,8 +297,8 @@ dbus-call-method
(check-interval 0.001)
(key
(apply
- 'dbus-message-internal dbus-message-type-method-call
- bus service path interface method 'dbus-call-method-handler args))
+ #'dbus-message-internal dbus-message-type-method-call
+ bus service path interface method #'dbus-call-method-handler args))
(result (cons :pending nil)))
;; Wait until `dbus-call-method-handler' has put the result into
@@ -339,8 +335,8 @@ dbus-call-method
(remhash key dbus-return-values-table))))
;; `dbus-call-method' works non-blocking now.
-(defalias 'dbus-call-method-non-blocking 'dbus-call-method)
-(make-obsolete 'dbus-call-method-non-blocking 'dbus-call-method "24.3")
+(define-obsolete-function-alias 'dbus-call-method-non-blocking
+ #'dbus-call-method "24.3")
(defun dbus-call-method-asynchronously
(bus service path interface method handler &rest args)
@@ -406,7 +402,7 @@ dbus-call-method-asynchronously
(or (null handler) (functionp handler)
(signal 'wrong-type-argument (list 'functionp handler)))
- (apply 'dbus-message-internal dbus-message-type-method-call
+ (apply #'dbus-message-internal dbus-message-type-method-call
bus service path interface method handler args))
(defun dbus-send-signal (bus service path interface signal &rest args)
@@ -454,7 +450,7 @@ dbus-send-signal
(or (stringp signal)
(signal 'wrong-type-argument (list 'stringp signal)))
- (apply 'dbus-message-internal dbus-message-type-signal
+ (apply #'dbus-message-internal dbus-message-type-signal
bus service path interface signal args))
(defun dbus-method-return-internal (bus service serial &rest args)
@@ -470,7 +466,7 @@ dbus-method-return-internal
(or (natnump serial)
(signal 'wrong-type-argument (list 'natnump serial)))
- (apply 'dbus-message-internal dbus-message-type-method-return
+ (apply #'dbus-message-internal dbus-message-type-method-return
bus service serial args))
(defun dbus-method-error-internal (bus service serial &rest args)
@@ -486,7 +482,7 @@ dbus-method-error-internal
(or (natnump serial)
(signal 'wrong-type-argument (list 'natnump serial)))
- (apply 'dbus-message-internal dbus-message-type-error
+ (apply #'dbus-message-internal dbus-message-type-error
bus service serial args))
\f
@@ -552,13 +548,13 @@ dbus-register-service
`:already-owner': Service is already the primary owner."
;; Add Peer handler.
- (dbus-register-method
- bus service nil dbus-interface-peer "Ping" 'dbus-peer-handler 'dont-register)
+ (dbus-register-method bus service nil dbus-interface-peer "Ping"
+ #'dbus-peer-handler 'dont-register)
;; Add ObjectManager handler.
(dbus-register-method
bus service nil dbus-interface-objectmanager "GetManagedObjects"
- 'dbus-managed-objects-handler 'dont-register)
+ #'dbus-managed-objects-handler 'dont-register)
(let ((arg 0)
reply)
@@ -681,7 +677,7 @@ dbus-register-signal
(if (and (stringp service)
(not (zerop (length service)))
(not (string-equal service dbus-service-dbus))
- (not (string-match "^:" service)))
+ (/= (string-to-char service) ?:))
(setq uname (dbus-get-name-owner bus service))
(setq uname service))
@@ -710,7 +706,7 @@ dbus-register-signal
;; `:arg0' .. `:arg63', `:path0' .. `:path63'.
((and (keywordp key)
(string-match
- "^:\\(arg\\|path\\)\\([[:digit:]]+\\)$"
+ "\\`:\\(arg\\|path\\)\\([[:digit:]]+\\)\\'"
(symbol-name key)))
(setq counter (match-string 2 (symbol-name key))
args (cdr args)
@@ -726,9 +722,7 @@ dbus-register-signal
"path" "")
value))
;; `:arg-namespace', `:path-namespace'.
- ((and (keywordp key)
- (string-match
- "^:\\(arg\\|path\\)-namespace$" (symbol-name key)))
+ ((memq key '(:arg-namespace :path-namespace))
(setq args (cdr args)
value (car args))
(unless (stringp value)
@@ -736,8 +730,7 @@ dbus-register-signal
(list "Wrong argument" key value)))
(format
",%s='%s'"
- (if (string-equal (match-string 1 (symbol-name key)) "path")
- "path_namespace" "arg0namespace")
+ (if (eq key :path-namespace) "path_namespace" "arg0namespace")
value))
;; `:eavesdrop'.
((eq key :eavesdrop)
@@ -751,11 +744,11 @@ dbus-register-signal
bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
"AddMatch" rule)
(dbus-error
- (if (not (string-match "eavesdrop" rule))
+ (if (not (string-match-p "eavesdrop" rule))
(signal (car err) (cdr err))
;; The D-Bus spec says we shall fall back to a rule without eavesdrop.
(when dbus-debug (message "Removing eavesdrop from rule %s" rule))
- (setq rule (replace-regexp-in-string ",eavesdrop='true'" "" rule))
+ (setq rule (replace-regexp-in-string ",eavesdrop='true'" "" rule t t))
(dbus-call-method
bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
"AddMatch" rule))))
@@ -893,9 +886,7 @@ dbus-string-to-byte-array
STRING shall be UTF-8 coded."
(if (zerop (length string))
'(:array :signature "y")
- (let (result)
- (dolist (elt (string-to-list string) (append '(:array) result))
- (setq result (append result (list :byte elt)))))))
+ (cons :array (mapcan (lambda (c) (list :byte c)) string))))
(defun dbus-byte-array-to-string (byte-array &optional multibyte)
"Transform BYTE-ARRAY into UTF-8 coded string.
@@ -903,12 +894,9 @@ dbus-byte-array-to-string
array as produced by `dbus-string-to-byte-array'. The resulting
string is unibyte encoded, unless MULTIBYTE is non-nil."
(apply
- (if multibyte 'string 'unibyte-string)
- (if (equal byte-array '(:array :signature "y"))
- nil
- (let (result)
- (dolist (elt byte-array result)
- (when (characterp elt) (setq result (append result `(,elt)))))))))
+ (if multibyte #'string #'unibyte-string)
+ (unless (equal byte-array '(:array :signature "y"))
+ (seq-filter #'characterp byte-array))))
(defun dbus-escape-as-identifier (string)
"Escape an arbitrary STRING so it follows the rules for a C identifier.
@@ -930,9 +918,9 @@ dbus-escape-as-identifier
(if (zerop (length string))
"_"
(replace-regexp-in-string
- "^[0-9]\\|[^A-Za-z0-9]"
+ "\\`[0-9]\\|[^A-Za-z0-9]"
(lambda (x) (format "_%2x" (aref x 0)))
- string)))
+ string nil t)))
(defun dbus-unescape-from-identifier (string)
"Retrieve the original string from the encoded STRING as unibyte string.
@@ -942,7 +930,7 @@ dbus-unescape-from-identifier
(replace-regexp-in-string
"_.."
(lambda (x) (byte-to-string (string-to-number (substring x 1) 16)))
- string)))
+ string nil t)))
\f
;;; D-Bus events.
@@ -1020,7 +1008,7 @@ dbus-handle-event
(if (eq result :ignore)
(dbus-method-return-internal
(nth 1 event) (nth 4 event) (nth 3 event))
- (apply 'dbus-method-return-internal
+ (apply #'dbus-method-return-internal
(nth 1 event) (nth 4 event) (nth 3 event)
(if (consp result) result (list result)))))))
;; Error handling.
@@ -1119,10 +1107,9 @@ dbus-list-names
(defun dbus-list-known-names (bus)
"Retrieve all services which correspond to a known name in BUS.
A service has a known name if it doesn't start with \":\"."
- (let (result)
- (dolist (name (dbus-list-names bus) (nreverse result))
- (unless (string-equal ":" (substring name 0 1))
- (push name result)))))
+ (seq-remove (lambda (name)
+ (= (string-to-char name) ?:))
+ (dbus-list-names bus)))
(defun dbus-list-queued-owners (bus service)
"Return the unique names registered at D-Bus BUS and queued for SERVICE.
@@ -1182,6 +1169,18 @@ dbus-peer-handler
\f
;;; D-Bus introspection.
+(defsubst dbus--introspect-names (object tag)
+ "Return the names of the children of OBJECT with TAG."
+ (mapcar (lambda (elt)
+ (dbus-introspect-get-attribute elt "name"))
+ (xml-get-children object tag)))
+
+(defsubst dbus--introspect-name (object tag name)
+ "Return the first child of OBJECT with TAG, whose name is NAME."
+ (seq-find (lambda (elt)
+ (string-equal (dbus-introspect-get-attribute elt "name") name))
+ (xml-get-children object tag)))
+
(defun dbus-introspect (bus service path)
"Return all interfaces and sub-nodes of SERVICE,
registered at object path PATH at bus BUS.
@@ -1197,17 +1196,25 @@ dbus-introspect
bus service path dbus-interface-introspectable "Introspect"
:timeout 1000)))
+(defalias 'dbus--parse-xml-buffer
+ (if (libxml-available-p)
+ (lambda ()
+ (xml-remove-comments (point-min) (point-max))
+ (libxml-parse-xml-region (point-min) (point-max)))
+ (lambda ()
+ (car (xml-parse-region (point-min) (point-max)))))
+ "Compatibility shim for `libxml-parse-xml-region'.")
+
(defun dbus-introspect-xml (bus service path)
"Return the introspection data of SERVICE in D-Bus BUS at object path PATH.
The data are a parsed list. The root object is a \"node\",
representing the object path PATH. The root object can contain
\"interface\" and further \"node\" objects."
- ;; We don't want to raise errors.
- (xml-node-name
- (ignore-errors
- (with-temp-buffer
- (insert (dbus-introspect bus service path))
- (xml-parse-region (point-min) (point-max))))))
+ (with-temp-buffer
+ ;; We don't want to raise errors.
+ (ignore-errors
+ (insert (dbus-introspect bus service path))
+ (dbus--parse-xml-buffer))))
(defun dbus-introspect-get-attribute (object attribute)
"Return the ATTRIBUTE value of D-Bus introspection OBJECT.
@@ -1219,21 +1226,15 @@ dbus-introspect-get-node-names
"Return all node names of SERVICE in D-Bus BUS at object path PATH.
It returns a list of strings. The node names stand for further
object paths of the D-Bus service."
- (let ((object (dbus-introspect-xml bus service path))
- result)
- (dolist (elt (xml-get-children object 'node) (nreverse result))
- (push (dbus-introspect-get-attribute elt "name") result))))
+ (dbus--introspect-names (dbus-introspect-xml bus service path) 'node))
(defun dbus-introspect-get-all-nodes (bus service path)
"Return all node names of SERVICE in D-Bus BUS at object path PATH.
It returns a list of strings, which are further object paths of SERVICE."
- (let ((result (list path)))
- (dolist (elt
- (dbus-introspect-get-node-names bus service path)
- result)
- (setq elt (expand-file-name elt path))
- (setq result
- (append result (dbus-introspect-get-all-nodes bus service elt))))))
+ (cons path (mapcan (lambda (elt)
+ (setq elt (expand-file-name elt path))
+ (dbus-introspect-get-all-nodes bus service elt))
+ (dbus-introspect-get-node-names bus service path))))
(defun dbus-introspect-get-interface-names (bus service path)
"Return all interface names of SERVICE in D-Bus BUS at object path PATH.
@@ -1244,10 +1245,7 @@ dbus-introspect-get-interface-names
\"org.freedesktop.DBus.Properties\". If present, \"interface\"
objects can also have \"property\" objects as children, beside
\"method\" and \"signal\" objects."
- (let ((object (dbus-introspect-xml bus service path))
- result)
- (dolist (elt (xml-get-children object 'interface) (nreverse result))
- (push (dbus-introspect-get-attribute elt "name") result))))
+ (dbus--introspect-names (dbus-introspect-xml bus service path) 'interface))
(defun dbus-introspect-get-interface (bus service path interface)
"Return the INTERFACE of SERVICE in D-Bus BUS at object path PATH.
@@ -1256,22 +1254,14 @@ dbus-introspect-get-interface
`dbus-introspect-get-interface-names'. The resulting
\"interface\" object can contain \"method\", \"signal\",
\"property\" and \"annotation\" children."
- (let ((elt (xml-get-children
- (dbus-introspect-xml bus service path) 'interface)))
- (while (and elt
- (not (string-equal
- interface
- (dbus-introspect-get-attribute (car elt) "name"))))
- (setq elt (cdr elt)))
- (car elt)))
+ (dbus--introspect-name (dbus-introspect-xml bus service path)
+ 'interface interface))
(defun dbus-introspect-get-method-names (bus service path interface)
"Return a list of strings of all method names of INTERFACE.
SERVICE is a service of D-Bus BUS at object path PATH."
- (let ((object (dbus-introspect-get-interface bus service path interface))
- result)
- (dolist (elt (xml-get-children object 'method) (nreverse result))
- (push (dbus-introspect-get-attribute elt "name") result))))
+ (dbus--introspect-names
+ (dbus-introspect-get-interface bus service path interface) 'method))
(defun dbus-introspect-get-method (bus service path interface method)
"Return method METHOD of interface INTERFACE as an XML object.
@@ -1279,22 +1269,15 @@ dbus-introspect-get-method
METHOD must be a string and a member of the list returned by
`dbus-introspect-get-method-names'. The resulting \"method\"
object can contain \"arg\" and \"annotation\" children."
- (let ((elt (xml-get-children
- (dbus-introspect-get-interface bus service path interface)
- 'method)))
- (while (and elt
- (not (string-equal
- method (dbus-introspect-get-attribute (car elt) "name"))))
- (setq elt (cdr elt)))
- (car elt)))
+ (dbus--introspect-name
+ (dbus-introspect-get-interface bus service path interface)
+ 'method method))
(defun dbus-introspect-get-signal-names (bus service path interface)
"Return a list of strings of all signal names of INTERFACE.
SERVICE is a service of D-Bus BUS at object path PATH."
- (let ((object (dbus-introspect-get-interface bus service path interface))
- result)
- (dolist (elt (xml-get-children object 'signal) (nreverse result))
- (push (dbus-introspect-get-attribute elt "name") result))))
+ (dbus--introspect-names
+ (dbus-introspect-get-interface bus service path interface) 'signal))
(defun dbus-introspect-get-signal (bus service path interface signal)
"Return signal SIGNAL of interface INTERFACE as an XML object.
@@ -1302,22 +1285,15 @@ dbus-introspect-get-signal
SIGNAL must be a string, element of the list returned by
`dbus-introspect-get-signal-names'. The resulting \"signal\"
object can contain \"arg\" and \"annotation\" children."
- (let ((elt (xml-get-children
- (dbus-introspect-get-interface bus service path interface)
- 'signal)))
- (while (and elt
- (not (string-equal
- signal (dbus-introspect-get-attribute (car elt) "name"))))
- (setq elt (cdr elt)))
- (car elt)))
+ (dbus--introspect-name
+ (dbus-introspect-get-interface bus service path interface)
+ 'signal signal))
(defun dbus-introspect-get-property-names (bus service path interface)
"Return a list of strings of all property names of INTERFACE.
SERVICE is a service of D-Bus BUS at object path PATH."
- (let ((object (dbus-introspect-get-interface bus service path interface))
- result)
- (dolist (elt (xml-get-children object 'property) (nreverse result))
- (push (dbus-introspect-get-attribute elt "name") result))))
+ (dbus--introspect-names
+ (dbus-introspect-get-interface bus service path interface) 'property))
(defun dbus-introspect-get-property (bus service path interface property)
"Return PROPERTY of INTERFACE as an XML object.
@@ -1325,15 +1301,9 @@ dbus-introspect-get-property
PROPERTY must be a string and a member of the list returned by
`dbus-introspect-get-property-names'. The resulting PROPERTY
object can contain \"annotation\" children."
- (let ((elt (xml-get-children
- (dbus-introspect-get-interface bus service path interface)
- 'property)))
- (while (and elt
- (not (string-equal
- property
- (dbus-introspect-get-attribute (car elt) "name"))))
- (setq elt (cdr elt)))
- (car elt)))
+ (dbus--introspect-name
+ (dbus-introspect-get-interface bus service path interface)
+ 'property property))
(defun dbus-introspect-get-annotation-names
(bus service path interface &optional name)
@@ -1341,15 +1311,13 @@ dbus-introspect-get-annotation-names
If NAME is nil, the annotations are children of INTERFACE,
otherwise NAME must be a \"method\", \"signal\", or \"property\"
object, where the annotations belong to."
- (let ((object
- (if name
- (or (dbus-introspect-get-method bus service path interface name)
- (dbus-introspect-get-signal bus service path interface name)
- (dbus-introspect-get-property bus service path interface name))
- (dbus-introspect-get-interface bus service path interface)))
- result)
- (dolist (elt (xml-get-children object 'annotation) (nreverse result))
- (push (dbus-introspect-get-attribute elt "name") result))))
+ (dbus--introspect-names
+ (if name
+ (or (dbus-introspect-get-method bus service path interface name)
+ (dbus-introspect-get-signal bus service path interface name)
+ (dbus-introspect-get-property bus service path interface name))
+ (dbus-introspect-get-interface bus service path interface))
+ 'annotation))
(defun dbus-introspect-get-annotation
(bus service path interface name annotation)
@@ -1357,22 +1325,13 @@ dbus-introspect-get-annotation
If NAME is nil, ANNOTATION is a child of INTERFACE, otherwise
NAME must be the name of a \"method\", \"signal\", or
\"property\" object, where the ANNOTATION belongs to."
- (let ((elt (xml-get-children
- (if name
- (or (dbus-introspect-get-method
- bus service path interface name)
- (dbus-introspect-get-signal
- bus service path interface name)
- (dbus-introspect-get-property
- bus service path interface name))
- (dbus-introspect-get-interface bus service path interface))
- 'annotation)))
- (while (and elt
- (not (string-equal
- annotation
- (dbus-introspect-get-attribute (car elt) "name"))))
- (setq elt (cdr elt)))
- (car elt)))
+ (dbus--introspect-name
+ (if name
+ (or (dbus-introspect-get-method bus service path interface name)
+ (dbus-introspect-get-signal bus service path interface name)
+ (dbus-introspect-get-property bus service path interface name))
+ (dbus-introspect-get-interface bus service path interface))
+ 'annotation annotation))
(defun dbus-introspect-get-argument-names (bus service path interface name)
"Return a list of all argument names as a list of strings.
@@ -1380,27 +1339,20 @@ dbus-introspect-get-argument-names
Argument names are optional, the function can return nil
therefore, even if the method or signal has arguments."
- (let ((object
- (or (dbus-introspect-get-method bus service path interface name)
- (dbus-introspect-get-signal bus service path interface name)))
- result)
- (dolist (elt (xml-get-children object 'arg) (nreverse result))
- (push (dbus-introspect-get-attribute elt "name") result))))
+ (dbus--introspect-names
+ (or (dbus-introspect-get-method bus service path interface name)
+ (dbus-introspect-get-signal bus service path interface name))
+ 'arg))
(defun dbus-introspect-get-argument (bus service path interface name arg)
"Return argument ARG as XML object.
NAME must be a \"method\" or \"signal\" object. ARG must be a
string and a member of the list returned by
`dbus-introspect-get-argument-names'."
- (let ((elt (xml-get-children
- (or (dbus-introspect-get-method bus service path interface name)
- (dbus-introspect-get-signal bus service path interface name))
- 'arg)))
- (while (and elt
- (not (string-equal
- arg (dbus-introspect-get-attribute (car elt) "name"))))
- (setq elt (cdr elt)))
- (car elt)))
+ (dbus--introspect-name
+ (or (dbus-introspect-get-method bus service path interface name)
+ (dbus-introspect-get-signal bus service path interface name))
+ 'arg arg))
(defun dbus-introspect-get-signature
(bus service path interface name &optional direction)
@@ -1469,13 +1421,10 @@ dbus-get-all-properties
nil is returned."
(dbus-ignore-errors
;; "GetAll" returns "a{sv}".
- (let (result)
- (dolist (dict
- (dbus-call-method
- bus service path dbus-interface-properties
- "GetAll" :timeout 500 interface)
- (nreverse result))
- (push (cons (car dict) (cl-caadr dict)) result)))))
+ (mapcar (lambda (dict)
+ (cons (car dict) (caadr dict)))
+ (dbus-call-method bus service path dbus-interface-properties
+ "GetAll" :timeout 500 interface))))
(defun dbus-register-property
(bus service path interface property access value
@@ -1520,13 +1469,13 @@ dbus-register-property
;; Add handlers for the three property-related methods.
(dbus-register-method
bus service path dbus-interface-properties "Get"
- 'dbus-property-handler 'dont-register)
+ #'dbus-property-handler 'dont-register)
(dbus-register-method
bus service path dbus-interface-properties "GetAll"
- 'dbus-property-handler 'dont-register)
+ #'dbus-property-handler 'dont-register)
(dbus-register-method
bus service path dbus-interface-properties "Set"
- 'dbus-property-handler 'dont-register)
+ #'dbus-property-handler 'dont-register)
;; Register SERVICE.
(unless (or dont-register-service (member service (dbus-list-names bus)))
@@ -1673,7 +1622,7 @@ dbus-get-all-managed-objects
(if (cadr entry2)
;; "sv".
(dolist (entry3 (cadr entry2))
- (setcdr entry3 (cl-caadr entry3)))
+ (setcdr entry3 (caadr entry3)))
(setcdr entry2 nil)))))
;; Fallback: collect the information. Slooow!
@@ -1730,7 +1679,7 @@ dbus-managed-objects-handler
(append
(butlast last-input-event 4)
(list object dbus-interface-properties
- "GetAll" 'dbus-property-handler))))
+ "GetAll" #'dbus-property-handler))))
(dbus-property-handler interface))))
(cdr (assoc object result)))))))))
dbus-registered-objects-table)
diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index e263c4563f..45c9851365 100644
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -176,8 +176,8 @@ dbus-test03-peer-interface
(defun dbus-test-all (&optional interactive)
"Run all tests for \\[dbus]."
(interactive "p")
- (funcall
- (if interactive 'ert-run-tests-interactively 'ert-run-tests-batch) "^dbus"))
+ (funcall (if interactive #'ert-run-tests-interactively #'ert-run-tests-batch)
+ "^dbus"))
(provide 'dbus-tests)
;;; dbus-tests.el ends here
--
2.27.0
next prev parent reply other threads:[~2020-06-17 20:08 UTC|newest]
Thread overview: 13+ messages / expand[flat|nested] mbox.gz Atom feed top
2020-06-06 23:26 bug#41744: 27.0.91; Various D-Bus cleanups Basil L. Contovounesios
2020-06-08 11:06 ` Michael Albinus
2020-06-08 14:00 ` Basil L. Contovounesios
2020-06-08 14:20 ` Michael Albinus
2020-06-08 14:48 ` Eli Zaretskii
2020-06-08 14:52 ` Michael Albinus
2020-06-08 17:28 ` Basil L. Contovounesios
2020-06-17 20:08 ` Basil L. Contovounesios [this message]
2020-06-18 9:59 ` Michael Albinus
2020-06-18 15:34 ` Basil L. Contovounesios
2020-06-18 16:59 ` Michael Albinus
2020-06-18 17:05 ` Basil L. Contovounesios
2020-06-18 18:02 ` Michael Albinus
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87d05xbgkx.fsf@tcd.ie \
--to=contovob@tcd.ie \
--cc=41744@debbugs.gnu.org \
--cc=michael.albinus@gmx.de \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).