commit 8c71ef0f8edc91d2dc0b220447856cf656f33f57 (HEAD, refs/remotes/origin/master) Author: Mattias Engdegård Date: Fri Aug 29 16:24:02 2025 +0200 ; use modern sort calls in more places * lisp/emacs-lisp/regexp-opt.el (regexp-opt, regexp-opt-group): * lisp/emacs-lisp/rx.el (rx--parse-any): New-style calls, also faster. diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el index 6c2350e9548..3edaca78e32 100644 --- a/lisp/emacs-lisp/regexp-opt.el +++ b/lisp/emacs-lisp/regexp-opt.el @@ -140,7 +140,7 @@ usually more efficient than that of a simplified version: (open (cond ((stringp paren) paren) (paren "\\("))) (re (if strings (regexp-opt-group - (delete-dups (sort (copy-sequence strings) 'string-lessp)) + (delete-dups (sort strings)) (or open t) (not open)) ;; No strings: return an unmatchable regexp. (concat (or open "\\(?:") regexp-unmatchable "\\)")))) @@ -250,7 +250,7 @@ Merges keywords to avoid backtracking in Emacs's regexp matcher." (prefixes ;; Sorting is necessary in cases such as ("ad" "d"). (sort (mapcar (lambda (s) (substring s 0 n)) strings) - 'string-lessp))) + :in-place t))) (concat open-group (regexp-opt-group prefixes t t) (regexp-quote (nreverse xiffus)) diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el index c512d42cd15..58f95c7d89a 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -581,7 +581,7 @@ a list of named character classes in the order they occur in BODY." (cons (rx--condense-intervals (sort (append conses (mapcan #'rx--string-to-intervals strings)) - #'car-less-than-car)) + :key #'car :in-place t)) (nreverse classes)))) (defun rx--generate-alt (negated intervals classes) commit 8d3554683f5def6ac85a1ba02876575ea3d498a8 Author: Juri Linkov Date: Fri Aug 29 19:35:58 2025 +0300 * lisp/treesit-x.el (treesit-generic-mode-font-lock-map): Extend. Add more font-lock mappings based on existing settings in ts-modes. diff --git a/admin/tree-sitter/treesit-admin.el b/admin/tree-sitter/treesit-admin.el index 2e85d6b0d8c..1f1fa1ce752 100644 --- a/admin/tree-sitter/treesit-admin.el +++ b/admin/tree-sitter/treesit-admin.el @@ -316,7 +316,7 @@ Return non-nil if all queries are valid, nil otherwise." ;; TODO: A more generic way to find all queries. (let ((c-ts-mode-enable-doxygen t) (c-ts-mode-enable-doxygen t) - (java-ts-mode-enabel-doxygen t)) + (java-ts-mode-enable-doxygen t)) (funcall mode)) (font-lock-mode -1) treesit-font-lock-settings))) diff --git a/lisp/treesit-x.el b/lisp/treesit-x.el index 65845ed0ac0..308e2c23f8c 100644 --- a/lisp/treesit-x.el +++ b/lisp/treesit-x.el @@ -155,16 +155,21 @@ of `define-treesit-generic-mode'. (defvar treesit-generic-mode-font-lock-map '( + ("@attribute" . "@font-lock-preprocessor-face") ("@boolean" . "@font-lock-constant-face") ("@comment" . "@font-lock-comment-face") + ("@constructor" . "@font-lock-type-face") ("@constant" . "@font-lock-constant-face") + ("@constant.builtin" . "@font-lock-builtin-face") ("@delimiter" . "@font-lock-delimiter-face") ("@error" . "@font-lock-warning-face") ("@escape" . "@font-lock-escape-face") ("@function" . "@font-lock-function-name-face") + ("@function.builtin" . "@font-lock-builtin-face") ("@function.call" . "@font-lock-function-call-face") ("@keyword" . "@font-lock-keyword-face") ("@keyword.operator" . "@font-lock-operator-face") + ("@module" . "@font-lock-keyword-face") ("@number" . "@font-lock-number-face") ("@operator" . "@font-lock-operator-face") ("@property" . "@font-lock-property-name-face") @@ -174,9 +179,11 @@ of `define-treesit-generic-mode'. ("@string" . "@font-lock-string-face") ("@string.regexp" . "@font-lock-regexp-face") ("@string.special" . "@font-lock-string-face") + ("@tag" . "@font-lock-function-name-face") ("@tag.delimiter" . "@font-lock-delimiter-face") ("@text.reference" . "@font-lock-doc-face") ("@type" . "@font-lock-type-face") + ("@type.builtin" . "@font-lock-builtin-face") ("@variable" . "@font-lock-variable-name-face") ("@variable.builtin" . "@font-lock-builtin-face") ("@variable.parameter" . "@font-lock-variable-name-face") commit 35f8ce783558e7a4c02983b5b360cba9e1cb6503 Author: Juri Linkov Date: Fri Aug 29 19:32:22 2025 +0300 * lisp/textmodes/markdown-ts-mode.el: Fix embed settings. (markdown-ts--range-settings): Move embed settings for html/toml/yaml to 'markdown-ts-setup'. (markdown-ts-setup): Append range rules to 'treesit-range-settings' only when grammars for html/toml/yaml are installed. diff --git a/lisp/textmodes/markdown-ts-mode.el b/lisp/textmodes/markdown-ts-mode.el index 7f705ddb8b2..4929f2d91ee 100644 --- a/lisp/textmodes/markdown-ts-mode.el +++ b/lisp/textmodes/markdown-ts-mode.el @@ -307,25 +307,6 @@ the same features enabled in MODE." :range-fn #'treesit-range-fn-exclude-children '((inline) @markdown-inline) - :embed 'yaml - :host 'markdown - :local t - '((minus_metadata) @yaml) - - :embed 'toml - :host 'markdown - :local t - '((plus_metadata) @toml) - - :embed 'html - :host 'markdown - :local t - '((html_block) @html) - - :embed 'html - :host 'markdown-inline - '((html_tag) @html) - :embed #'markdown-ts--convert-code-block-language :host 'markdown :local t @@ -350,7 +331,18 @@ the same features enabled in MODE." (setq-local treesit-font-lock-feature-list (treesit-merge-font-lock-feature-list treesit-font-lock-feature-list - html-ts-mode--treesit-font-lock-feature-list))) + html-ts-mode--treesit-font-lock-feature-list)) + (setq-local treesit-range-settings + (append treesit-range-settings + (treesit-range-rules + :embed 'html + :host 'markdown + :local t + '((html_block) @html) + + :embed 'html + :host 'markdown-inline + '((html_tag) @html))))) (when (treesit-ready-p 'yaml t) (require 'yaml-ts-mode) @@ -362,7 +354,14 @@ the same features enabled in MODE." (setq-local treesit-font-lock-feature-list (treesit-merge-font-lock-feature-list treesit-font-lock-feature-list - yaml-ts-mode--font-lock-feature-list))) + yaml-ts-mode--font-lock-feature-list)) + (setq-local treesit-range-settings + (append treesit-range-settings + (treesit-range-rules + :embed 'yaml + :host 'markdown + :local t + '((minus_metadata) @yaml))))) (when (treesit-ready-p 'toml t) (require 'toml-ts-mode) @@ -374,7 +373,14 @@ the same features enabled in MODE." (setq-local treesit-font-lock-feature-list (treesit-merge-font-lock-feature-list treesit-font-lock-feature-list - toml-ts-mode--font-lock-feature-list))) + toml-ts-mode--font-lock-feature-list)) + (setq-local treesit-range-settings + (append treesit-range-settings + (treesit-range-rules + :embed 'toml + :host 'markdown + :local t + '((plus_metadata) @toml))))) (treesit-major-mode-setup)) commit b8ad7c38aebeb457f81e8298d9be10d9d30f2921 Author: Juri Linkov Date: Fri Aug 29 19:27:32 2025 +0300 * lisp/progmodes/python.el: Use 'treesit-major-mode-remap-alist'. (python-ts-mode): Don't duplicate 'auto-mode-alist' and 'interpreter-mode-alist' settings in Emacs 31 (bug#79180). Add ts-mode mapping to 'treesit-major-mode-remap-alist'. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 3cd20d6babf..649f47f6e69 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -7424,12 +7424,19 @@ implementations: `python-mode' and `python-ts-mode'." (when python-indent-guess-indent-offset (python-indent-guess-indent-offset)) - (add-to-list 'auto-mode-alist (cons python--auto-mode-alist-regexp 'python-ts-mode)) - (add-to-list 'interpreter-mode-alist '("python[0-9.]*" . python-ts-mode)))) + (unless (boundp 'treesit-major-mode-remap-alist) ; Emacs 31.1 + (add-to-list 'auto-mode-alist (cons python--auto-mode-alist-regexp 'python-ts-mode)) + (add-to-list 'interpreter-mode-alist '("python[0-9.]*" . python-ts-mode))))) (when (fboundp 'derived-mode-add-parents) ; Emacs 30.1 (derived-mode-add-parents 'python-ts-mode '(python-mode))) +;;;###autoload +(when (and (fboundp 'treesit-available-p) (treesit-available-p) + (boundp 'treesit-major-mode-remap-alist)) ; Emacs 31.1 + (add-to-list 'treesit-major-mode-remap-alist + '(python-mode . python-ts-mode))) + ;;; Completion predicates for M-x ;; Commands that only make sense when editing Python code. (dolist (sym '(python-add-import commit f7188ed77f82b71e856e21aab6c266f68bf21ee2 Author: Michael Albinus Date: Fri Aug 29 17:29:54 2025 +0200 ; Fix last commit * lisp/net/tramp.el (tramp-parse-default-user-host): Fix thinko. (tramp-handle-file-directory-p): Extend simple check. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 1b9efd3dab6..c7450bc015d 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3345,7 +3345,7 @@ for all methods. Resulting data are derived from default settings." (let ((user (tramp-find-user method nil nil)) (host (tramp-find-host method nil nil))) (when (or user host) - `(,user ,host)))) + `((,user ,host))))) ;;;###tramp-autoload (defcustom tramp-completion-multi-hop-methods nil @@ -4340,11 +4340,13 @@ Let-bind it when necessary.") (defun tramp-handle-file-directory-p (filename) "Like `file-directory-p' for Tramp files." (or - ;; `file-directory-p' is used as predicate for file name completion. - ;; Sometimes, when a connection is not established yet, it is - ;; desirable to return t immediately for "/method:foo:". It can be - ;; expected that this is always a directory. + ;; `file-directory-p' is used as predicate for file name + ;; completion. Sometimes, when a connection is not established + ;; yet, it is desirable to return t immediately for "/method:foo:" + ;; or "/method:foo:/". It can be expected that this is always a + ;; directory. (tramp-string-empty-or-nil-p (tramp-file-local-name filename)) + (string-equal (tramp-file-local-name filename) "/") ;; `file-truename' could raise an error, for example due to a ;; cyclic symlink. (ignore-errors commit 4e44c149a61373074346cc0f55d874ad993b88ba Merge: 95232f556ed bebba6be3da Author: Michael Albinus Date: Fri Aug 29 13:48:10 2025 +0200 Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs commit 95232f556ed70a39c2c5c24868b8a4aaf0e82484 Author: Michael Albinus Date: Fri Aug 29 13:47:51 2025 +0200 `Fix read-directory-name' for Tramp files * lisp/minibuffer.el (completion-file-name-table): Improve bypass for directory checking. (Bug#79236) * lisp/net/tramp.el (tramp-user-regexp): Exclude "[" and "]". (tramp-completion-make-tramp-file-name): Handle port for IPv6 hosts. (tramp-completion-handle-file-directory-p) (tramp-completion-handle-file-exists-p): Simplify. (tramp-completion-handle-file-name-completion): Ignore PREDICATE. (tramp-completion-dissect-file-name): Handle ports. (tramp-parse-default-user-host): Suppress '(nil nil) result. (tramp-parse-file): Delete duplicates. (tramp-parse-shosts-group): Accept also IPv6 addresses. (tramp-handle-file-directory-p): Return t for filenames "/method:foo:". (tramp-parse-auth-sources, tramp-parse-netrc): * lisp/net/tramp-cache.el (tramp-parse-connection-properties): * lisp/net/tramp-gvfs.el (tramp-gvfs-parse-device-names): Use `tramp-compat-seq-keep'. * test/lisp/net/tramp-tests.el (edebug-mode): Declare. (tramp--test-message): Write also trace value. (tramp-test26-file-name-completion): (tramp-test26-interactive-file-name-completion): Extend tests. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 55b6d79a813..64eb5d93fe6 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3522,9 +3522,15 @@ same as `substitute-in-file-name'." (unless (memq pred '(nil file-exists-p)) (let ((comp ()) (pred - (if (eq pred 'file-directory-p) + (if (and (eq pred 'file-directory-p) + (not (string-match-p + (or (bound-and-true-p + tramp-completion-file-name-regexp) + (rx unmatchable)) + string))) ;; Brute-force speed up for directory checking: ;; Discard strings which don't end in a slash. + ;; Unless it is a Tramp construct like "/ssh:". (lambda (s) (let ((len (length s))) (and (> len 0) (eq (aref s (1- len)) ?/)))) diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 721b7be123f..4ecc804bf20 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -647,17 +647,18 @@ your laptop to different networks frequently." "Return a list of (user host) tuples allowed to access for METHOD. This function is added always in `tramp-get-completion-function' for all methods. Resulting data are derived from connection history." - (mapcar - (lambda (key) - (let ((tramp-verbose 0)) - (and (tramp-file-name-p key) - (string-equal method (tramp-file-name-method key)) - (not (tramp-file-name-localname key)) - (tramp-get-method-parameter - key 'tramp-completion-use-cache tramp-completion-use-cache) - (list (tramp-file-name-user key) - (tramp-file-name-host key))))) - (hash-table-keys tramp-cache-data))) + (delete-dups + (tramp-compat-seq-keep + (lambda (key) + (let ((tramp-verbose 0)) + (and (tramp-file-name-p key) + (string-equal method (tramp-file-name-method key)) + (not (tramp-file-name-localname key)) + (tramp-get-method-parameter + key 'tramp-completion-use-cache tramp-completion-use-cache) + (list (tramp-file-name-user key) + (tramp-file-name-host key))))) + (hash-table-keys tramp-cache-data)))) ;; When "emacs -Q" has been called, both variables are nil. We do not ;; load the persistency file then, in order to have a clean test environment. diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 5db8f1f61da..feda8943be5 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -251,7 +251,7 @@ value is the default binding of the variable." ;; ;; * Use `ensure-list'. ;; -;; * Starting with Emacs 29.1, use `buffer-match-p'. +;; * Starting with Emacs 29.1, use `buffer-match-p' and `match-buffers'. ;; ;; * Starting with Emacs 29.1, use `string-split'. ;; diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index b5f1135a60d..7f3ac945bb6 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -2557,7 +2557,7 @@ This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi." (shell-command-to-string (format "avahi-browse -trkp %s" service)) (rx (+ (any "\r\n"))) 'omit (rx bol "+;" (* nonl) eol))))) (delete-dups - (mapcar + (tramp-compat-seq-keep (lambda (x) (ignore-errors (let* ((list (split-string x ";")) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index e80a470957f..1b9efd3dab6 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -103,9 +103,9 @@ (put 'tramp--startup-hook 'tramp-suppress-trace t) - ;; TODO: once (autoload-macro expand) is available in all supported - ;; Emacs versions, this can be eliminated: - ;; backward compatibility for autoload-macro declare form + ;; TODO: Once (autoload-macro expand) is available in all supported + ;; Emacs versions (Emacs 31.1+), this can be eliminated: + ;; Backward compatibility for autoload-macro declare form. (unless (assq 'autoload-macro macro-declarations-alist) (push '(autoload-macro ignore) macro-declarations-alist)) @@ -1047,7 +1047,7 @@ Used in `tramp-make-tramp-file-name'.") "Regexp matching delimiter between method and user or host names. Derived from `tramp-postfix-method-format'.") -(defconst tramp-user-regexp (rx (+ (not (any "/:|" blank)))) +(defconst tramp-user-regexp (rx (+ (not (any "/:|[]" blank)))) "Regexp matching user names.") (defconst tramp-prefix-domain-format "%" @@ -2001,10 +2001,21 @@ necessary only. This function will be used in file name completion." (concat user tramp-postfix-user-format)) (unless (tramp-string-empty-or-nil-p host) (concat - (if (string-match-p tramp-ipv6-regexp host) - (concat - tramp-prefix-ipv6-format host tramp-postfix-ipv6-format) - host) + (cond + (;; ipv6#port -> [ipv6]#port + (string-match + (rx (group (regexp tramp-ipv6-regexp)) + (group (regexp tramp-prefix-port-regexp) + (regexp tramp-port-regexp))) + host) + (concat + tramp-prefix-ipv6-format (match-string 1 host) + tramp-postfix-ipv6-format (match-string 2 host))) + (;; ipv6 -> [ipv6] + (string-match-p tramp-ipv6-regexp host) + (concat + tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)) + (t host)) tramp-postfix-host-format)) localname)) @@ -2910,19 +2921,23 @@ not in completion mode." ;; We need special handling only when a method is needed. Then we ;; regard all files "/method:" or "/[method/" as existent, if ;; "method" is a valid Tramp method. - (or (string-equal filename "/") - (and ;; Is it a valid method? - (not (string-empty-p tramp-postfix-method-format)) - (string-match - (rx - (regexp tramp-prefix-regexp) - (* (regexp tramp-remote-file-name-spec-regexp) - (regexp tramp-postfix-hop-regexp)) - (group-n 9 (regexp tramp-method-regexp)) - (? (regexp tramp-postfix-method-regexp)) - eos) - filename) - (assoc (match-string 9 filename) tramp-methods) + (or (and (cond + ;; Completion styles like `flex' and `substring' check for + ;; the file name "/". This does exist. + ((string-equal filename "/")) + ;; Is it a valid method? + ((and (not (string-empty-p tramp-postfix-method-format)) + (string-match + (rx + (regexp tramp-prefix-regexp) + (* (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-hop-regexp)) + (group-n 9 (regexp tramp-method-regexp)) + (| (regexp tramp-postfix-method-regexp) eos)) + filename)) + (assoc (match-string 9 filename) tramp-methods)) + ;; Is it a completion file name? + ((string-match-p tramp-completion-file-name-regexp filename))) t) (tramp-run-real-handler #'file-directory-p (list filename)))) @@ -2931,10 +2946,7 @@ not in completion mode." "Like `file-exists-p' for partial Tramp files." ;; We need special handling only when a method is needed. Then we ;; regard all files "/method:" or "/[method/" as existent, if - ;; "method" is a valid Tramp method. And we regard all files - ;; "/method:user@", "/user@" or "/[method/user@" as existent, if - ;; "user@" is a valid file name completion. Host completion is - ;; performed in the respective backend operation. + ;; "method" is a valid Tramp method. (or (and (cond ;; Completion styles like `flex' and `substring' check for ;; the file name "/". This does exist. @@ -2947,28 +2959,11 @@ not in completion mode." (* (regexp tramp-remote-file-name-spec-regexp) (regexp tramp-postfix-hop-regexp)) (group-n 9 (regexp tramp-method-regexp)) - (? (regexp tramp-postfix-method-regexp)) - eos) + (| (regexp tramp-postfix-method-regexp) eos)) filename)) (assoc (match-string 9 filename) tramp-methods)) - ;; Is it a valid user? - ((string-match - (rx - (regexp tramp-prefix-regexp) - (* (regexp tramp-remote-file-name-spec-regexp) - (regexp tramp-postfix-hop-regexp)) - (group-n 10 - (regexp tramp-method-regexp) - (regexp tramp-postfix-method-regexp)) - (group-n 11 - (regexp tramp-user-regexp) - (regexp tramp-postfix-user-regexp)) - eos) - filename) - (member - (match-string 11 filename) - (file-name-all-completions - "" (concat tramp-prefix-format (match-string 10 filename)))))) + ;; Is it a completion file name? + ((string-match-p tramp-completion-file-name-regexp filename))) t) (tramp-run-real-handler #'file-exists-p (list filename)))) @@ -3083,15 +3078,14 @@ BODY is the backend specific code." ;; Method, host name and user name completion for a file. (defun tramp-completion-handle-file-name-completion - (filename directory &optional predicate) - "Like `file-name-completion' for partial Tramp files." + (filename directory &optional _predicate) + "Like `file-name-completion' for partial Tramp files. +It ignores PREDICATE, because there's no meaningful result." ;; Suppress eager completion on not connected hosts. (let ((non-essential t)) (try-completion filename - (mapcar #'list (file-name-all-completions filename directory)) - (when (and predicate (tramp-connectable-p directory)) - (lambda (x) (funcall predicate (expand-file-name (car x) directory))))))) + (mapcar #'list (file-name-all-completions filename directory))))) ;; I misuse a little bit the `tramp-file-name' structure in order to ;; handle completion possibilities for partial methods / user names / @@ -3113,7 +3107,15 @@ BODY is the backend specific code." (defun tramp-completion-dissect-file-name (name) "Return a list of `tramp-file-name' structures for NAME. They are collected by `tramp-completion-dissect-file-name1'." - (let (;; "/method" "/[method" + ;; We don't need a special handling for "user%domain", because "%" + ;; is also hit by `tramp-user-regexp'. "host#port" is normalized + ;; for IPv6 hosts. + (let ((internal-name + (replace-regexp-in-string + (rx (regexp tramp-postfix-ipv6-regexp) + (regexp tramp-prefix-port-regexp)) + tramp-prefix-port-format name)) + ;; "/method" "/[method" (tramp-completion-file-name-structure1 (list (rx @@ -3170,16 +3172,75 @@ They are collected by `tramp-completion-dissect-file-name1'." (regexp tramp-postfix-user-regexp) (regexp tramp-prefix-ipv6-regexp) (group (? (regexp tramp-ipv6-regexp))) eol) + 1 2 3 nil)) + ;; "/method:host#port" "/[method/host#port" + (tramp-completion-file-name-structure7 + (list + (rx + (regexp tramp-prefix-regexp) + (group (regexp tramp-method-regexp)) + (regexp tramp-postfix-method-regexp) + (group (regexp tramp-host-regexp) + (regexp tramp-prefix-port-regexp) + (? (regexp tramp-port-regexp))) + eol) + 1 nil 2 nil)) + ;; "/method:[ipv6]#port" "/[method/ipv6#port" + (tramp-completion-file-name-structure8 + (list + (rx + (regexp tramp-prefix-regexp) + (group (regexp tramp-method-regexp)) + (regexp tramp-postfix-method-regexp) + (regexp tramp-prefix-ipv6-regexp) + (group (regexp tramp-ipv6-regexp) + (regexp tramp-prefix-port-regexp) + (? (regexp tramp-port-regexp))) + eol) + 1 nil 2 nil)) + ;; "/method:user@host#port" "/[method/user@host#port" + (tramp-completion-file-name-structure9 + (list + (rx + (regexp tramp-prefix-regexp) + (group (regexp tramp-method-regexp)) + (regexp tramp-postfix-method-regexp) + (group (regexp tramp-user-regexp)) + (regexp tramp-postfix-user-regexp) + (group (regexp tramp-host-regexp) + (regexp tramp-prefix-port-regexp) + (? (regexp tramp-port-regexp))) + eol) + 1 2 3 nil)) + ;; "/method:user@[ipv6]#port" "/[method/user@ipv6#port" + (tramp-completion-file-name-structure10 + (list + (rx + (regexp tramp-prefix-regexp) + (group (regexp tramp-method-regexp)) + (regexp tramp-postfix-method-regexp) + (group (regexp tramp-user-regexp)) + (regexp tramp-postfix-user-regexp) + (regexp tramp-prefix-ipv6-regexp) + (group (regexp tramp-ipv6-regexp) + (regexp tramp-prefix-port-regexp) + (? (regexp tramp-port-regexp))) + eol) 1 2 3 nil))) (tramp-compat-seq-keep - (lambda (structure) (tramp-completion-dissect-file-name1 structure name)) + (lambda (structure) + (tramp-completion-dissect-file-name1 structure internal-name)) (list tramp-completion-file-name-structure1 tramp-completion-file-name-structure2 tramp-completion-file-name-structure3 tramp-completion-file-name-structure4 tramp-completion-file-name-structure5 - tramp-completion-file-name-structure6)))) + tramp-completion-file-name-structure6 + tramp-completion-file-name-structure7 + tramp-completion-file-name-structure8 + tramp-completion-file-name-structure9 + tramp-completion-file-name-structure10)))) (defun tramp-completion-dissect-file-name1 (structure name) "Return a `tramp-file-name' structure for NAME matching STRUCTURE. @@ -3281,7 +3342,10 @@ PARTIAL-USER must match USER, PARTIAL-HOST must match HOST." "Return a list of (user host) tuples allowed to access for METHOD. This function is added always in `tramp-get-completion-function' for all methods. Resulting data are derived from default settings." - `((,(tramp-find-user method nil nil) ,(tramp-find-host method nil nil)))) + (let ((user (tramp-find-user method nil nil)) + (host (tramp-find-host method nil nil))) + (when (or user host) + `(,user ,host)))) ;;;###tramp-autoload (defcustom tramp-completion-multi-hop-methods nil @@ -3303,10 +3367,11 @@ as for \"~/.authinfo.gpg\"." This function is added always in `tramp-get-completion-function' for all methods. Resulting data are derived from default settings." (and tramp-completion-use-auth-sources - (mapcar - (lambda (x) `(,(plist-get x :user) ,(plist-get x :host))) - (auth-source-search - :port method :require '(:port) :max most-positive-fixnum)))) + (delete-dups + (tramp-compat-seq-keep + (lambda (x) `(,(plist-get x :user) ,(plist-get x :host))) + (auth-source-search + :port method :require '(:port) :max most-positive-fixnum))))) ;; Generic function. (defun tramp-parse-group (regexp match-level skip-chars) @@ -3331,7 +3396,8 @@ User is always nil." (with-temp-buffer (insert-file-contents-literally filename) (goto-char (point-min)) - (cl-loop while (not (eobp)) collect (funcall function)))))) + (delete-dups (delq nil + (cl-loop while (not (eobp)) collect (funcall function)))))))) (defun tramp-parse-rhosts (filename) "Return a list of (user host) tuples allowed to access. @@ -3359,7 +3425,9 @@ User is always nil." (defun tramp-parse-shosts-group () "Return a (user host) tuple allowed to access. User is always nil." - (tramp-parse-group (rx bol (group (regexp tramp-host-regexp))) 1 ",")) + (tramp-parse-group + (rx bol (group (| (regexp tramp-ipv6-regexp) (regexp tramp-host-regexp)))) + 1 ",")) (defun tramp-parse-sconfig (filename) "Return a list of (user host) tuples allowed to access. @@ -3465,11 +3533,12 @@ Host is always \"localhost\"." (defun tramp-parse-netrc (filename) "Return a list of (user host) tuples allowed to access. User may be nil." - (mapcar - (lambda (item) - (and (assoc "machine" item) - `(,(cdr (assoc "login" item)) ,(cdr (assoc "machine" item))))) - (tramp-compat-auth-source-netrc-parse-all filename))) + (delete-dups + (tramp-compat-seq-keep + (lambda (item) + (and (assoc "machine" item) + `(,(cdr (assoc "login" item)) ,(cdr (assoc "machine" item))))) + (tramp-compat-auth-source-netrc-parse-all filename)))) (defun tramp-parse-putty (registry-or-dirname) "Return a list of (user host) tuples allowed to access. @@ -4270,10 +4339,16 @@ Let-bind it when necessary.") (defun tramp-handle-file-directory-p (filename) "Like `file-directory-p' for Tramp files." - ;; `file-truename' could raise an error, for example due to a cyclic - ;; symlink. - (ignore-errors - (eq (file-attribute-type (file-attributes (file-truename filename))) t))) + (or + ;; `file-directory-p' is used as predicate for file name completion. + ;; Sometimes, when a connection is not established yet, it is + ;; desirable to return t immediately for "/method:foo:". It can be + ;; expected that this is always a directory. + (tramp-string-empty-or-nil-p (tramp-file-local-name filename)) + ;; `file-truename' could raise an error, for example due to a + ;; cyclic symlink. + (ignore-errors + (eq (file-attribute-type (file-attributes (file-truename filename))) t)))) (defun tramp-handle-file-equal-p (filename1 filename2) "Like `file-equal-p' for Tramp files." diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 58b5083b2c0..892e4ef519c 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -68,6 +68,7 @@ (require 'vc-git) (require 'vc-hg) +(declare-function edebug-mode "edebug") (declare-function project-mode-line-format "project") (declare-function tramp-check-remote-uname "tramp-sh") (declare-function tramp-find-executable "tramp-sh") @@ -215,7 +216,10 @@ is greater than 10. (kill-buffer buf)))))) (defsubst tramp--test-message (fmt-string &rest arguments) - "Emit a message into ERT *Messages*." + "Emit a message into \"ERT *Messages*\" and the trace buffer." + (declare (tramp-suppress-trace t)) + (when (get-buffer trace-buffer) + (trace-values (apply #'format fmt-string arguments))) (tramp--test-instrument-test-case 0 (apply #'tramp-message tramp-test-vec 0 fmt-string arguments))) @@ -4857,6 +4861,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (host (file-remote-p ert-remote-temporary-file-directory 'host)) (orig-syntax tramp-syntax) (minibuffer-completing-file-name t)) + ;; `file-remote-p' returns as host the string "host#port", which + ;; isn't useful. (when (and (stringp host) (string-match (rx (regexp tramp-prefix-port-regexp) (regexp tramp-port-regexp)) @@ -4868,7 +4874,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (tramp-syntax-values) `(,orig-syntax))) (tramp-change-syntax syntax) ;; This has cleaned up all connection data, which are used - ;; for completion. We must refill the cache. + ;; for completion. We must refill the cache in order to get + ;; at least one completion candidate. (tramp-set-connection-property tramp-test-vec "completion-use-cache" t) (let (;; This is needed for the `separate' syntax. @@ -4883,6 +4890,14 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Complete method name. (unless (or (tramp-string-empty-or-nil-p method) (string-empty-p tramp-method-regexp)) + ;; `read-directory-name' uses `file-directory-p'. + ;; `file-directory-p' works since Emacs 31. + ;; (Bug#79236) + (when (tramp--test-emacs31-p) + (should + (file-name-completion + (concat prefix-format (substring method 0 1)) + "/" #'file-directory-p))) (should (member (concat prefix-format method tramp-postfix-method-format) @@ -4892,6 +4907,14 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (unless (or (tramp-string-empty-or-nil-p method) (string-empty-p tramp-method-regexp) (tramp-string-empty-or-nil-p host)) + ;; `read-directory-name' uses `file-directory-p'. + ;; `file-directory-p' works since Emacs 31. + ;; (Bug#79236) + (when (tramp--test-emacs31-p) + (should + (file-name-completion + (concat prefix-format method tramp-postfix-method-format) + "/" #'file-directory-p))) (should (member (concat @@ -4983,6 +5006,17 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; and Bug#60505. (ert-deftest tramp-test26-interactive-file-name-completion () "Check interactive completion with different `completion-styles'." + (skip-unless (tramp--test-enabled)) + + ;; (when (get-buffer trace-buffer) (kill-buffer trace-buffer)) + ;; (dolist (elt (append + ;; (mapcar + ;; #'intern (all-completions "tramp-" obarray #'functionp)) + ;; tramp-trace-functions)) + ;; (unless (get elt 'tramp-suppress-trace) + ;; (trace-function-background elt))) + ;; (trace-function-background #'completion-file-name-table) + ;; (trace-function-background #'read-file-name) ;; Method, user and host name in completion mode. (let ((method (file-remote-p ert-remote-temporary-file-directory 'method)) @@ -4991,39 +5025,54 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (hop (file-remote-p ert-remote-temporary-file-directory 'hop)) (orig-syntax tramp-syntax) (non-essential t) - (inhibit-message t)) + (inhibit-message (not (ignore-errors (edebug-mode))))) + ;; `file-remote-p' returns as host the string "host#port", which + ;; isn't useful. (when (and (stringp host) (string-match (rx (regexp tramp-prefix-port-regexp) (regexp tramp-port-regexp)) host)) (setq host (replace-match "" nil nil host))) - ;; (trace-function #'tramp-completion-file-name-handler) - ;; (trace-function #'completion-file-name-table) (unwind-protect (dolist (syntax (if (tramp--test-expensive-test-p) (tramp-syntax-values) `(,orig-syntax))) (tramp-change-syntax syntax) ;; This has cleaned up all connection data, which are used - ;; for completion. We must refill the cache. + ;; for completion. We must refill the cache in order to get + ;; at least one completion candidate. (tramp-set-connection-property tramp-test-vec "completion-use-cache" t) (dolist (style (if (tramp--test-expensive-test-p) - ;; It doesn't work for `initials' and `shorthand' - ;; completion styles. Should it? + ;; FIXME: It doesn't work for `initials' and + ;; `shorthand' completion styles. Should it? ;; `orderless' passes the tests, but it is an ELPA package. - '(emacs21 emacs22 basic partial-completion substring flex) + ;; What about `company' backends, `consult', `cider', `helm'? + `(emacs21 emacs22 basic partial-completion substring + ;; FIXME: `flex' is not compatible with IPv6 hosts. + ,@(unless (string-match-p tramp-ipv6-regexp host) '(flex))) '(basic))) (when (assoc style completion-styles-alist) (let* (;; Force the real minibuffer in batch mode. (executing-kbd-macro noninteractive) + ;; FIXME: Is this TRT for test? + (minibuffer-completing-file-name t) + (confirm-nonexistent-file-or-buffer nil) (completion-styles `(,style)) completion-category-defaults completion-category-overrides - ;; This is needed for the `simplified' syntax, + ;; FIXME: Is this TRT for test? + (completion-pcm--delim-wild-regex + ;; "::1" is a complete word. ":" isn't a + ;; delimiter, therefore. + (rx-to-string + `(any + ,(string-replace + ":" "" completion-pcm-word-delimiters)))) + ;; This is needed for the `simplified' syntax. (tramp-default-method method) (method-string (unless (string-empty-p tramp-method-regexp) @@ -5101,60 +5150,78 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." user-string host-string) ,host-string))))) - (ignore-errors (kill-buffer "*Completions*")) - ;; (and (bufferp trace-buffer) (kill-buffer trace-buffer)) - (discard-input) - (setq test (car test-and-result) - unread-command-events - (mapcar #'identity (concat test "\t\t\n")) - completions nil - result (read-file-name "Prompt: ")) - - (if (or (not (get-buffer "*Completions*")) - (string-match-p - (if (string-empty-p tramp-method-regexp) + (dolist + (predicate + (if (and (tramp--test-expensive-test-p) + (tramp--test-emacs31-p)) + ;; `nil' will be expanded to `file-exists-p'. + ;; `read-directory-name' uses `file-directory-p'. + ;; `file-directory-p' works since Emacs 31. + ;; (Bug#79236) + '(file-exists-p file-directory-p) '(nil))) + + (ignore-errors (kill-buffer "*Completions*")) + ;; (when (get-buffer trace-buffer) + ;; (kill-buffer trace-buffer)) + (discard-input) + (setq test (car test-and-result) + unread-command-events + (append test '(tab tab return return)) + completions nil + result + (read-file-name + "Prompt: " nil nil 'confirm nil predicate)) + + (if (or (not (get-buffer "*Completions*")) + (string-match-p + (if (string-empty-p tramp-method-regexp) + (rx + (| (regexp tramp-postfix-user-regexp) + (regexp tramp-postfix-host-regexp)) + eos) (rx - (| (regexp tramp-postfix-user-regexp) + (| (regexp tramp-postfix-method-regexp) + (regexp tramp-postfix-user-regexp) (regexp tramp-postfix-host-regexp)) - eos) - (rx - (| (regexp tramp-postfix-method-regexp) - (regexp tramp-postfix-user-regexp) - (regexp tramp-postfix-host-regexp)) - eos)) - result)) - (progn - ;; (tramp--test-message - ;; "syntax: %s style: %s test: %s result: %s" - ;; syntax style test result) - (should (string-prefix-p (cadr test-and-result) result))) - - (with-current-buffer "*Completions*" - ;; We must remove leading `default-directory'. - (goto-char (point-min)) - (let ((inhibit-read-only t)) - (while (search-forward-regexp "//" nil 'noerror) - (delete-region (line-beginning-position) (point)))) - (goto-char (point-min)) - (search-forward-regexp - (rx bol (0+ nonl) - (any "Pp") "ossible completions" - (0+ nonl) eol)) - (forward-line 1) - (setq completions - (split-string - (buffer-substring-no-properties (point) (point-max)) - (rx (any "\r\n\t ")) 'omit))) - - ;; (tramp--test-message - ;; "syntax: %s style: %s test: %s result: %s completions: %S" - ;; syntax style test result completions) - (should (member (caddr test-and-result) completions)))))))) + eos)) + result)) + (progn + ;; (tramp--test-message + ;; (concat + ;; "syntax: %s style: %s predicate: %s " + ;; "test: %s result: %s") + ;; syntax style predicate test result) + (should + (string-prefix-p (cadr test-and-result) result))) + + (with-current-buffer "*Completions*" + ;; We must remove leading `default-directory'. + (goto-char (point-min)) + (let ((inhibit-read-only t)) + (while (search-forward-regexp "//" nil 'noerror) + (delete-region (line-beginning-position) (point)))) + (goto-char (point-min)) + (search-forward-regexp + (rx bol (0+ nonl) + (any "Pp") "ossible completions" + (0+ nonl) eol)) + (forward-line 1) + (setq completions + (split-string + (buffer-substring-no-properties + (point) (point-max)) + (rx (any "\r\n\t ")) 'omit))) + + ;; (tramp--test-message + ;; (concat + ;; "syntax: %s style: %s predicate: %s test: %s " + ;; "result: %s completions: %S") + ;; syntax style predicate test result completions) + (should + (member (caddr test-and-result) completions))))))))) ;; Cleanup. - ;; (tramp--test-message "%s" (tramp-get-buffer-string trace-buffer)) - ;; (untrace-function #'tramp-completion-file-name-handler) - ;; (untrace-function #'completion-file-name-table) + ;; (untrace-all) (tramp-change-syntax orig-syntax) (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)))) @@ -8815,6 +8882,12 @@ If INTERACTIVE is non-nil, the tests are run interactively." ;; * Use `skip-when' starting with Emacs 30.1. ;; * Revisit expensive tests, once problems in `tramp-error' are solved. ;; * Fix `tramp-test06-directory-file-name' for "ftp". +;; * In `tramp-test26-file-name-completion', check also user, domain, +;; port and hop. +;; * In `tramp-test26-interactive-file-name-completion', check `flex', +;; `initials' and `shorthand' completion styles. Should +;; `minibuffer-completing-file-name' and `completion-pcm--delim-wild-regex' +;; be bound? Check also domain, port and hop. ;; * Check, why a process filter t doesn't work in ;; `tramp-test29-start-file-process' and ;; `tramp-test30-make-process'. commit bebba6be3da6544ec5d8051d74a976dcd52314ef Author: Mattias Engdegård Date: Fri Aug 29 10:55:21 2025 +0200 Fix org-habit bug related to string mutation * lisp/org/org-habit.el (org-habit-build-graph): Rewrite without using string mutation (using vectors instead), fixing a bug where org-habit-completed-glyph and org-habit-today-glyph wouldn't display properly if in the U+0080..00FF range, discovered by the more restricted string mutation. Reported by Daniel Mendler in https://lists.gnu.org/archive/html/emacs-orgmode/2025-08/msg00224.html diff --git a/lisp/org/org-habit.el b/lisp/org/org-habit.el index 38975682152..010c9daa00e 100644 --- a/lisp/org/org-habit.el +++ b/lisp/org/org-habit.el @@ -333,7 +333,8 @@ current time." (start (time-to-days starting)) (now (time-to-days current)) (end (time-to-days ending)) - (graph (make-string (1+ (- end start)) ?\s)) + (graph (make-vector (1+ (- end start)) ?\s)) + (props nil) (index 0) last-done-date) (while (and done-dates (< (car done-dates) start)) @@ -411,17 +412,20 @@ current time." (not (eq face 'org-habit-overdue-face)) (not markedp)) (setq face (cdr faces))) - (put-text-property index (1+ index) 'face face graph) - (put-text-property index (1+ index) - 'help-echo - (concat (format-time-string - (org-time-stamp-format) - (time-add starting (days-to-time (- start (time-to-days starting))))) - (if donep " DONE" "")) - graph)) + (push (list index (1+ index) 'face face) props) + (push (list index (1+ index) + 'help-echo + (concat (format-time-string + (org-time-stamp-format) + (time-add starting (days-to-time (- start (time-to-days starting))))) + (if donep " DONE" ""))) + props)) (setq start (1+ start) index (1+ index))) - graph)) + (let ((graph-str (concat graph))) + (dolist (p props) + (put-text-property (nth 0 p) (nth 1 p) (nth 2 p) (nth 3 p) graph-str)) + graph-str))) (defun org-habit-insert-consistency-graphs (&optional line) "Insert consistency graph for any habitual tasks." commit bba28b744c0f3fda20d66d0a054917db2c0a2529 Author: john muhl Date: Fri Aug 29 09:47:24 2025 +0200 Make 'lua-prefix-key' option a 'key-sequence' This fixes a failure in 'test-custom-opts' caused by both strings and integers being used for 'lua-prefix-key'. * lisp/progmodes/lua-mode.el (lua-prefix-key): Convert option to 'key-sequence' type. (lua-mode-map, lua-prefix-key-update-bindings, lua-set-prefix-key) (lua--customize-set-prefix-key): Adjust to the change of type for 'lua-prefix-key'. (lua-prefix-mode-map): Use 'defvar-keymap'. (Bug#79335) diff --git a/lisp/progmodes/lua-mode.el b/lisp/progmodes/lua-mode.el index 2e051d6d552..d65154a38cd 100644 --- a/lisp/progmodes/lua-mode.el +++ b/lisp/progmodes/lua-mode.el @@ -210,37 +210,21 @@ Should be a list of strings." (defvar lua-process-buffer nil "Buffer used for communication with the Lua process.") -(defun lua--customize-set-prefix-key (prefix-key-sym prefix-key-val) - "Set PREFIX-KEY-SYM to PREFIX-KEY-VAL." - (unless (eq prefix-key-sym 'lua-prefix-key) - (error "Prefix doesn't match lua-prefix-key")) - (set prefix-key-sym (when (and prefix-key-val (> (length prefix-key-val) 0)) - ;; read-kbd-macro returns a string or a vector - ;; in both cases (elt x 0) is ok - (elt (read-kbd-macro prefix-key-val) 0))) - (when (fboundp 'lua-prefix-key-update-bindings) - (lua-prefix-key-update-bindings))) - (defcustom lua-prefix-key "\C-c" "Prefix for all `lua-mode' commands." - :type 'string - :set 'lua--customize-set-prefix-key + :type 'key-sequence + :initialize #'custom-initialize-default + :set #'lua--customize-set-prefix-key :get (lambda (sym) - (if-let* ((val (eval sym))) (single-key-description val) "")) + (let ((prefix-key (symbol-value sym))) + (if (eq 'ignore prefix-key) "" prefix-key))) :version "31.1") -(defvar lua-prefix-mode-map - (eval-when-compile - (let ((result-map (make-sparse-keymap))) - (mapc (lambda (key_defn) - (define-key - result-map (read-kbd-macro (car key_defn)) (cdr key_defn))) - '(("C-l" . lua-send-buffer) - ("C-f" . lua-search-documentation))) - result-map)) - "Keymap that is used to define keys accessible by `lua-prefix-key'. - -If the latter is nil, the keymap translates into `lua-mode-map' verbatim.") +(defvar-keymap lua-prefix-mode-map + :doc "Keymap that is used to define keys accessible by `lua-prefix-key'. +If the latter is nil, the keymap translates into `lua-mode-map' verbatim." + "C-l" #'lua-send-buffer + "C-f" #'lua-search-documentation) (defvar lua--electric-indent-chars (mapcar #'string-to-char '("}" "]" ")"))) @@ -261,11 +245,27 @@ If the latter is nil, the keymap translates into `lua-mode-map' verbatim.") ;; defined look it up in prefix-map ;; * if prefix is set, bind the prefix-map to that key (if lua-prefix-key - (define-key result-map (vector lua-prefix-key) lua-prefix-mode-map) + (define-key result-map lua-prefix-key lua-prefix-mode-map) (set-keymap-parent result-map lua-prefix-mode-map)) result-map) "Keymap used in `lua-mode' buffers.") +(defun lua--customize-set-prefix-key (prefix-key-sym prefix-key-val) + "Set PREFIX-KEY-SYM to PREFIX-KEY-VAL." + (unless (eq prefix-key-sym 'lua-prefix-key) + (error "Prefix doesn't match lua-prefix-key")) + (define-key lua-mode-map lua-prefix-key nil) + ;; `lua-set-prefix-key' uses an empty string to remove the prefix. + (when (and (equal 'string (type-of prefix-key-val)) + (string-blank-p prefix-key-val)) + (setq prefix-key-val (vector #'ignore))) + (if (eq 'ignore (elt prefix-key-val 0)) + (set-keymap-parent lua-mode-map lua-prefix-mode-map) + (define-key lua-mode-map prefix-key-val lua-prefix-mode-map)) + (set-default prefix-key-sym prefix-key-val) + (when (fboundp 'lua-prefix-key-update-bindings) + (lua-prefix-key-update-bindings))) + (defvar-local lua-electric-flag t "Non-nil means electric actions are enabled.") @@ -612,18 +612,17 @@ The arguments JUSTIFY and REGION control `fill-paragraph' (which see)." ;; Otherwise, look for it among children (when-let* ((old-cons (rassoc lua-prefix-mode-map lua-mode-map))) (delq old-cons lua-mode-map))) - (if (null lua-prefix-key) + (if (eq 'ignore (elt lua-prefix-key 0)) (set-keymap-parent lua-mode-map lua-prefix-mode-map) - (define-key lua-mode-map (vector lua-prefix-key) lua-prefix-mode-map))) + (define-key lua-mode-map lua-prefix-key lua-prefix-mode-map))) (defun lua-set-prefix-key (new-key-str) "Change `lua-prefix-key' to NEW-KEY-STR and update keymaps. This function replaces previous prefix-key binding with a new one." (interactive "sNew prefix key (empty string means no key): ") - (lua--customize-set-prefix-key 'lua-prefix-key new-key-str) - (message "Prefix key set to %S" (single-key-description lua-prefix-key)) - (lua-prefix-key-update-bindings)) + (lua--customize-set-prefix-key 'lua-prefix-key (kbd new-key-str)) + (message "Prefix key set to %S" lua-prefix-key)) (defun lua-string-p (&optional pos) "Return non-nil if point or POS is in a string."