From: Michael Albinus Date: Fri, 12 Apr 2024 08:09:45 +0000 (+0200) Subject: Improve D-Bus byte-array conversion X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=81c53105f19e1be736551a5dbae80d3af52e5294;p=emacs.git Improve D-Bus byte-array conversion * doc/misc/dbus.texi (Type Conversion): Adapt dbus-byte-array-to-string. * etc/NEWS: D-Bus byte array conversion works over raw UTF-8 bytes. Fix typos. * lisp/net/dbus.el (dbus-string-to-byte-array) (dbus-byte-array-to-string): BYTE-ARRAY must be an UTF-8 raw bytes sequence. Make optional argument MULTIBYTE obsolete. (Bug#70301) (dbus-call-method-handler, dbus-register-signal) (dbus-escape-as-identifier): Use `length=' and `length>'. * test/lisp/net/dbus-tests.el (dbus--test-method-handler) (dbus-test09-get-managed-objects): Use `length='. (dbus-test01-type-conversion): Extend test. * test/lisp/net/secrets-tests.el (secrets-test03-items): Extend test. (cherry picked from commit a69890eea946beb0858273a20d260a170485b79a) --- diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi index 28ee64d6b89..c0a478d6ff6 100644 --- a/doc/misc/dbus.texi +++ b/doc/misc/dbus.texi @@ -1154,11 +1154,10 @@ The signal @code{PropertyModified}, discussed as an example in (@var{integer} ((@var{string} @var{bool} @var{bool}) (@var{string} @var{bool} @var{bool}) @dots{})) @end lisp -@defun dbus-byte-array-to-string byte-array &optional multibyte +@defun dbus-byte-array-to-string byte-array If a D-Bus method or signal returns an array of bytes, which are known to represent a UTF-8 string, this function converts @var{byte-array} -to the corresponding string. The string is unibyte encoded, unless -@var{multibyte} is non-@code{nil}. Example: +to the corresponding UTF-8 string. Example: @lisp (dbus-byte-array-to-string '(47 101 116 99 47 104 111 115 116 115)) diff --git a/etc/NEWS b/etc/NEWS index 0f51e2d68ba..e77654e7495 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -76,7 +76,7 @@ more details. ** Mouse wheel events should now always be 'wheel-up/down/left/right'. At those places where the old 'mouse-4/5/6/7' events could still occur -(i.e. X11 input in the absence of XInput2, and 'xterm-mouse-mode'), +(i.e., X11 input in the absence of XInput2, and 'xterm-mouse-mode'), we remap them to the corresponding 'wheel-up/down/left/right' event, according to the new variable 'mouse-wheel-buttons'. The old variables 'mouse-wheel-up-event', 'mouse-wheel-down-event', @@ -87,7 +87,7 @@ obsolete. In order to help the use of those Tree-Sitter modes, they are now declared to have the corresponding non-Tree-Sitter mode as an additional parent. -This way, things like `.dir-locals.el` settings, and YASnippet +This way, things like ".dir-locals.el" settings, and YASnippet collections of snippets automatically apply to the new Tree-Sitter modes. Note that those modes still do not inherit from the non-TS mode, so @@ -111,7 +111,7 @@ see the variable 'url-request-extra-headers'. ** 'describe-function' now shows the type of the function object. The text used to say things like "car is is a built-in function" whereas it now says "car is a primitive-function" where "primitive-function" -is the symbol returned by `cl-type-of` and you can click on it to get +is the symbol returned by 'cl-type-of' and you can click on it to get information about that type. ** 'advice-remove' is now an interactive command. @@ -251,7 +251,7 @@ value when installing GNU coreutils using something like ports or Homebrew. +++ -** cl-print +** CL Print +++ *** You can expand the "..." truncation everywhere. @@ -497,7 +497,7 @@ By default this is disabled. --- *** Users in CJK locales can control width of some non-CJK characters. Some characters are considered by Unicode as "ambiguous" with respect -to their display width: either "full-width" (i.e. taking 2 columns on +to their display width: either "full-width" (i.e., taking 2 columns on display) or "narrow" (taking 1 column). The actual width depends on the fonts used for these characters by Emacs or (for text-mode frames) by the terminal emulator. Traditionally, font sets in CJK locales @@ -544,7 +544,7 @@ only to specify the 'mouse-4/5/6/7' events that might still happen to be generated by some old packages (or if 'mouse-wheel-buttons' has been set to nil). -** 'xterm-mouse-mode' +** Xterm Mouse mode This mode now emits 'wheel-up/down/right/left' events instead of 'mouse-4/5/6/7' events for the mouse wheel. It uses the new variable 'mouse-wheel-buttons' to decide which button @@ -571,7 +571,7 @@ This requires the 'lzip' program to be installed on your system. ** New command 'lldb'. Run the LLDB debugger, analogous to the 'gud-gdb' command. -** gdb-mi +** GDB MI --- *** Variable order and truncation can now be configured in 'gdb-many-windows'. @@ -1210,7 +1210,7 @@ would add a duplicate entry to the end of the history list each time. This made it impossible to navigate to the "end" of the history list. Now, navigating through history in EWW simply changes your position in the history list, allowing you to reach the end as expected. In -addition, when browsing to a new page from a "historical" one (i.e. a +addition, when browsing to a new page from a "historical" one (i.e., a page loaded by navigating back through history), EWW deletes the history entries newer than the current page. To change the behavior when browsing from "historical" pages, you can customize @@ -1234,7 +1234,7 @@ display only the readable parts by default. For more details, see When non-nil (the default), calling 'eww-readable' adds a new entry to the EWW page history. -** go-ts-mode +** Go-ts mode +++ *** New command 'go-ts-mode-docstring'. @@ -1363,12 +1363,11 @@ This allows the user to specify command line arguments to the non interactive Python interpreter specified by 'python-interpreter'. ** Scheme mode - -Scheme mode now handles regular expression literal #/regexp/ that is +Scheme mode now handles regular expression literal '#/regexp/' that is available in some Scheme implementations. Also, it should now handle nested sexp-comments. -** use-package +** Use package +++ *** New ':vc' keyword. @@ -1538,13 +1537,13 @@ without specifying a file, like this: ** Image +++ -*** Image :map property is now recomputed when image is transformed. +*** Image ':map' property is now recomputed when image is transformed. Now images with clickable maps work as expected after you run commands -such as `image-increase-size', `image-decrease-size', `image-rotate', -`image-flip-horizontally', and `image-flip-vertically'. +such as 'image-increase-size', 'image-decrease-size', 'image-rotate', +'image-flip-horizontally', and 'image-flip-vertically'. +++ -*** New user option 'image-recompute-map-p' +*** New user option 'image-recompute-map-p'. Set this option to nil to prevent Emacs from recomputing image maps. ** Image Dired @@ -1679,7 +1678,7 @@ to the old behavior of not remembering input history between sessions. *** New user option 'xwidget-webkit-disable-javascript'. This allows disabling JavaScript in xwidget Webkit sessions. -** ls-lisp +** Ls Lisp --- *** 'ls-lisp--insert-directory' supports more long options of 'ls'. @@ -1892,6 +1891,11 @@ non-interactively. This special behavior is removed in this version of Emacs, for consistency with the common Emacs behavior where minibuffer history is reserved for past minibuffer inputs. ++++ +** 'dbus-{string-to-byte-array,byte-array-to-string}' are strict UTF-8 conform. +Both work over UTF-8 raw bytes only. The optional parameter MULTIBYTE +of 'dbus-byte-array-to-string' is obsolete now. + * Lisp Changes in Emacs 30.1 @@ -1927,18 +1931,18 @@ This function is like 'type-of' except that it sometimes returns a more precise type. For example, for nil and t it returns 'null' and 'boolean' respectively, instead of just 'symbol'. -** New functions `primitive-function-p` and `cl-functionp`. -`primitive-function-p` is like `subr-primitive-p` except that it returns +** New functions 'primitive-function-p' and 'cl-functionp'. +'primitive-function-p' is like 'subr-primitive-p' except that it returns t only if the argument is a function rather than a special-form, -and `cl-functionp` is like `functionp` except it return nil +and 'cl-functionp' is like 'functionp' except it returns nil for lists and symbols. ** Built-in types have now corresponding classes. -At the Lisp level, this means that things like (cl-find-class 'integer) +At the Lisp level, this means that things like '(cl-find-class 'integer)' will now return a class object, and at the UI level it means that things like 'C-h o integer RET' will show some information about that type. -** New var 'major-mode-remap-defaults' and function 'major-mode-remap'. +** New variable 'major-mode-remap-defaults' and function 'major-mode-remap'. The first is like Emacs-29's 'major-mode-remap-alist' but to be set by packages (instead of users). The second looks up those two variables. @@ -2072,7 +2076,7 @@ capabilities of the 'notifications-notify' function in a manner analogous to 'w32-notification-notify'. ** New variable 'haiku-pass-control-tab-to-system'. -This sets whether Emacs should pass C-TAB on to the system instead of +This sets whether Emacs should pass 'C-TAB' on to the system instead of handling it, fixing a problem where window switching would not activate if an Emacs frame had focus on the Haiku operation system. @@ -2160,7 +2164,6 @@ It returns the last position of a marker in its buffer even if that buffer has been killed. ('marker-position' would return nil in that case.) - ** Functions and variables to transpose sexps +++ @@ -2516,16 +2519,16 @@ is the value of the property to context menus shown when clicking on the text which as this property. --- -** Detecting the end of an iteration of a keyboard macro +** Detecting the end of an iteration of a keyboard macro. 'read-event', 'read-char', and 'read-char-exclusive' no longer return -1 -when called at the end of an iteration of a the execution of a keyboard +when called at the end of an iteration of the execution of a keyboard macro. Instead, they will transparently continue reading available input (e.g., from the keyboard). If you need to detect the end of a macro iteration, check the following condition before calling one of the aforementioned functions: (and (arrayp executing-kbd-macro) - (>= executing-kbd-macro-index (length executing-kbd-macro)))) + (>= executing-kbd-macro-index (length executing-kbd-macro))) +++ ** 'vtable-update-object' updates an existing object with just two arguments. @@ -2550,7 +2553,7 @@ It will now signal 'json-utf8-decode-error' for inputs that are not correctly UTF-8 encoded. --- -*** The parser and encoder now accept arbitarily large integers. +*** The parser and encoder now accept arbitrarily large integers. Previously, they were limited to the range of signed 64-bit integers. ** New tree-sitter functions and variables for defining and using "things" diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index 46f85daba24..31a5eae5182 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -270,7 +270,7 @@ The result will be made available in `dbus-return-values-table'." (result (gethash key dbus-return-values-table))) (when (consp result) (setcar result :complete) - (setcdr result (if (= (length args) 1) (car args) args))))) + (setcdr result (if (length= args 1) (car args) args))))) (defun dbus-notice-synchronous-call-errors (ev er) "Detect errors resulting from pending synchronous calls." @@ -773,7 +773,7 @@ Example: ;; Signals are sent always with the unique name as sender. Note: ;; the unique name of `dbus-service-dbus' is that string itself. (if (and (stringp service) - (not (zerop (length service))) + (length> service 0) (not (string-equal service dbus-service-dbus)) (/= (string-to-char service) ?:)) (setq uname (dbus-get-name-owner bus service)) @@ -994,20 +994,25 @@ association to the service from D-Bus." (defun dbus-string-to-byte-array (string) "Transform STRING to list (:array :byte C1 :byte C2 ...). -STRING shall be UTF-8 coded." - (if (zerop (length string)) +The resulting byte array contains the raw bytes of the UTF-8 encoded +STRING.." + (if (length= string 0) '(:array :signature "y") - (cons :array (mapcan (lambda (c) (list :byte c)) string)))) + (cons :array + (mapcan (lambda (c) (list :byte c)) + (let (last-coding-system-used) + (encode-coding-string string 'utf-8 'nocopy)))))) -(defun dbus-byte-array-to-string (byte-array &optional multibyte) +(defun dbus-byte-array-to-string (byte-array &optional _multibyte) "Transform BYTE-ARRAY into UTF-8 coded string. -BYTE-ARRAY must be a list of structure (c1 c2 ...), or a byte -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) - (unless (equal byte-array '(:array :signature "y")) - (seq-filter #'characterp byte-array)))) +BYTE-ARRAY must be a list of structure (c1 c2 ...), or a byte array as +produced by `dbus-string-to-byte-array'." + (declare (advertised-calling-convention (byte-array) "30.1")) + (if-let ((bytes (seq-filter #'characterp byte-array)) + (string (apply #'unibyte-string bytes))) + (let (last-coding-system-used) + (decode-coding-string string 'utf-8 'nocopy)) + "")) (defun dbus-escape-as-identifier (string) "Escape an arbitrary STRING so it follows the rules for a C identifier. @@ -1026,7 +1031,7 @@ escaped to \"_\". Returns the escaped string. Algorithm taken from telepathy-glib's `tp_escape_as_identifier'." - (if (zerop (length string)) + (if (length= string 0) "_" (replace-regexp-in-string "\\`[0-9]\\|[^A-Za-z0-9]" diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el index fec252e12dd..413901b0205 100644 --- a/test/lisp/net/dbus-tests.el +++ b/test/lisp/net/dbus-tests.el @@ -68,22 +68,35 @@ "Check type conversion functions." (skip-unless dbus--test-enabled-session-bus) - (let ((ustr "0123abc_xyz\x01\xff") - (mstr "Grüß Göttin")) + (let ((ustr (string-to-unibyte "0123abc_xyz\x01\xff")) + (mstr (string-to-multibyte "Grüß Göttin")) + (kstr (encode-coding-string "парола" 'koi8))) (should (string-equal (dbus-byte-array-to-string (dbus-string-to-byte-array "")) "")) (should (string-equal - (dbus-byte-array-to-string (dbus-string-to-byte-array ustr)) ustr)) + (dbus-byte-array-to-string (dbus-string-to-byte-array nil)) "")) (should (string-equal - (dbus-byte-array-to-string (dbus-string-to-byte-array mstr) 'multibyte) - mstr)) - ;; Should not work for multibyte strings. - (should-not + ;; The conversion could return a multibyte string, so we make it unibyte. + (string-to-unibyte + (dbus-byte-array-to-string (dbus-string-to-byte-array ustr))) + ustr)) + (should + (string-equal + ;; The conversion could return a multibyte string, so we make it unibyte. + (string-to-unibyte (dbus-byte-array-to-string (mapcar 'identity ustr))) + ustr)) + (should (string-equal (dbus-byte-array-to-string (dbus-string-to-byte-array mstr)) mstr)) + (should + (string-equal + ;; The conversion could return a multibyte string, so we make it unibyte. + (string-to-unibyte + (dbus-byte-array-to-string (dbus-string-to-byte-array kstr))) + kstr)) (should (string-equal @@ -565,10 +578,10 @@ This includes initialization and closing the bus." ((null args) :ignore) ;; One argument. - ((= 1 (length args)) + ((length= args 1) (car args)) ;; Two arguments. - ((= 2 (length args)) + ((length= args 2) `(:error ,dbus-error-invalid-args ,(format-message "Wrong arguments %s" args))) ;; More than two arguments. @@ -1952,7 +1965,7 @@ The argument EXPECTED-ARGS is a list of expected arguments for the method." (let ((result (dbus-get-all-managed-objects :session dbus--test-service dbus--test-path))) (should - (= 3 (length result))) + (length= result 3)) (dolist (interface interfaces) (pcase-let ((`(,iname ,objs) interface)) @@ -1970,7 +1983,7 @@ The argument EXPECTED-ARGS is a list of expected arguments for the method." :session dbus--test-service (concat dbus--test-path "/obj0")))) (should - (= 2 (length result))) + (length= result 2)) (dolist (interface interfaces) (pcase-let ((`(,iname ,objs) interface)) @@ -1989,7 +2002,7 @@ The argument EXPECTED-ARGS is a list of expected arguments for the method." :session dbus--test-service (concat dbus--test-path "/obj0/obj2")))) (should - (= 1 (length result))) + (length= result 1)) (dolist (interface interfaces) (pcase-let ((`(,iname ,objs) interface)) diff --git a/test/lisp/net/secrets-tests.el b/test/lisp/net/secrets-tests.el index 9feba514413..1d9c1446e26 100644 --- a/test/lisp/net/secrets-tests.el +++ b/test/lisp/net/secrets-tests.el @@ -173,6 +173,10 @@ (should (secrets-create-item "session" "foo" "geheim")) (should (equal (secrets-list-items "session") '("foo" "foo"))) + ;; Create another item with a non-latin password. (Bug#70301) + (should (secrets-create-item "session" "parola" "парола")) + (string-equal (secrets-get-secret "session" "parola") "парола") + ;; Create an item with attributes. (should (setq item-path