From 0de3844f80822ad5eadaf94d4dd0308674353778 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 28 Mar 2026 09:50:00 +0100 Subject: [PATCH 1/2] Fix file-name-all-completions for symlinked directories in Tramp * lisp/net/tramp.el (tramp-skeleton-file-name-all-completions): * lisp/net/tramp-adb.el (tramp-adb-handle-file-name-all-completions): * lisp/net/tramp-crypt.el (tramp-crypt-handle-file-name-all-completions): * lisp/net/tramp-fuse.el (tramp-fuse-handle-file-name-all-completions): * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-name-all-completions): * lisp/net/tramp-sh.el (tramp-sh-handle-file-name-all-completions): * lisp/net/tramp-smb.el (tramp-smb-handle-file-name-all-completions): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-file-name-all-completions): Simplify. * tramp-tests.el (tramp-test32-shell-command): Adapt test. * lisp/net/tramp-ftp.el (tramp-disable-ange-ftp): Use `seq-difference'. * lisp/net/tramp-gvfs.el (tramp-gvfs-monitor-process-filter): Use `thread-last'. * lisp/net/tramp-sh.el (tramp-sh-handle-insert-directory): Use `seq-difference'. (tramp-sh-gio-monitor-process-filter): Use `thread-last'. * lisp/net/tramp-smb.el (tramp-smb-get-file-entries): Do not add virtual entry ""; it isn't needed anymore. * lisp/net/tramp.el (tramp-make-tramp-hop-name): Use `thread-last'. (tramp-completion-handle-file-directory-p): Use `tramp-prefix-format'. (tramp-fnac-add-trailing-slash): New defvar. (tramp-skeleton-file-name-all-completions): Handle also symlinked directories. (tramp-skeleton-directory-files): Use `tramp-fnac-add-trailing-slash'. (tramp-handle-file-name-completion): Use `seq-difference'. (tramp-handle-make-process): Handle "%w" format specifier. * test/lisp/net/tramp-tests.el (tramp-test26-file-name-completion) (tramp-test32-shell-command, tramp-test36-vc-registered): Adapt tests. --- lisp/net/tramp-adb.el | 22 ++-- lisp/net/tramp-crypt.el | 22 ++-- lisp/net/tramp-ftp.el | 2 +- lisp/net/tramp-fuse.el | 5 +- lisp/net/tramp-gvfs.el | 26 ++--- lisp/net/tramp-sh.el | 85 +++++++------- lisp/net/tramp-smb.el | 19 +--- lisp/net/tramp-sudoedit.el | 28 ++--- lisp/net/tramp.el | 209 ++++++++++++++++++++--------------- test/lisp/net/tramp-tests.el | 39 ++++--- 10 files changed, 221 insertions(+), 236 deletions(-) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index c20b5df9b59..f6bfd9ebbea 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -451,21 +451,13 @@ Emacs dired can't find files." (defun tramp-adb-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." (tramp-skeleton-file-name-all-completions filename directory - (all-completions - filename - (with-parsed-tramp-file-name (expand-file-name directory) nil - (with-tramp-file-property v localname "file-name-all-completions" - (when (tramp-adb-do-ls v "-a" localname) - (mapcar - (lambda (f) - (if (file-directory-p (expand-file-name f directory)) - (file-name-as-directory f) - f)) - (with-current-buffer (tramp-get-buffer v) - (mapcar - (lambda (l) - (and (not (string-match-p (rx bol (* blank) eol) l)) l)) - (split-string (buffer-string) "\n" 'omit)))))))))) + (with-parsed-tramp-file-name (expand-file-name directory) nil + (when (tramp-adb-do-ls v "-a" localname) + (with-current-buffer (tramp-get-buffer v) + (mapcar + (lambda (l) + (and (not (string-match-p (rx bol (* blank) eol) l)) l)) + (split-string (buffer-string) "\n" 'omit))))))) (defun tramp-adb-handle-file-local-copy (filename) "Like `file-local-copy' for Tramp files." diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 59e4cea2edb..4400f4fecd3 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -741,18 +741,16 @@ absolute file names." (defun tramp-crypt-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." (tramp-skeleton-file-name-all-completions filename directory - (all-completions - filename - (let* (completion-regexp-list - tramp-crypt-enabled - (directory (file-name-as-directory directory)) - (enc-dir (tramp-crypt-encrypt-file-name directory))) - (mapcar - (lambda (x) - (substring - (tramp-crypt-decrypt-file-name (concat enc-dir x)) - (length directory))) - (file-name-all-completions "" enc-dir)))))) + (let* (completion-regexp-list + tramp-crypt-enabled + (directory (file-name-as-directory directory)) + (enc-dir (tramp-crypt-encrypt-file-name directory))) + (mapcar + (lambda (x) + (substring + (tramp-crypt-decrypt-file-name (concat enc-dir x)) + (length directory))) + (file-name-all-completions "" enc-dir))))) (defun tramp-crypt-handle-file-readable-p (filename) "Like `file-readable-p' for Tramp files." diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el index 7e140a0e372..601690befd6 100644 --- a/lisp/net/tramp-ftp.el +++ b/lisp/net/tramp-ftp.el @@ -49,7 +49,7 @@ present for backward compatibility." (let ((a1 (rassq 'ange-ftp-hook-function file-name-handler-alist)) (a2 (rassq 'ange-ftp-completion-hook-function file-name-handler-alist))) (setq file-name-handler-alist - (delete a1 (delete a2 file-name-handler-alist))))) + (seq-difference file-name-handler-alist (list a1 a2))))) (with-eval-after-load 'ange-ftp (tramp-disable-ange-ftp)) diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el index b3e59063cd8..f7abddab1a1 100644 --- a/lisp/net/tramp-fuse.el +++ b/lisp/net/tramp-fuse.el @@ -102,10 +102,7 @@ "Like `file-name-all-completions' for Tramp files." (tramp-skeleton-file-name-all-completions filename directory (tramp-fuse-remove-hidden-files - (all-completions - filename - (file-name-all-completions - filename (tramp-fuse-local-file-name directory)))))) + (file-name-all-completions "" (tramp-fuse-local-file-name directory))))) ;; This function isn't used. (defun tramp-fuse-handle-insert-directory diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 0f68e4d768a..a5919e071c3 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1479,19 +1479,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." (defun tramp-gvfs-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." (tramp-skeleton-file-name-all-completions filename directory - (unless (string-search "/" filename) - (all-completions - filename - (with-parsed-tramp-file-name (expand-file-name directory) nil - (with-tramp-file-property v localname "file-name-all-completions" - (let (result) - ;; Get a list of directories and files. - (dolist (item - (tramp-gvfs-get-directory-attributes directory) - result) - (if (string-equal (cdr (assoc "type" item)) "directory") - (push (file-name-as-directory (car item)) result) - (push (car item) result)))))))))) + (mapcar #'car (tramp-gvfs-get-directory-attributes directory)))) (defun tramp-gvfs-handle-file-notify-add-watch (file-name flags _callback) "Like `file-notify-add-watch' for Tramp files." @@ -1545,11 +1533,13 @@ If FILE-SYSTEM is non-nil, return file system attributes." (when rest-string (tramp-message proc 10 "Previous string:\n%s" rest-string)) (tramp-message proc 6 "%S\n%s" proc string) - (setq string (concat rest-string string) - ;; Fix action names. - string (string-replace "attributes changed" "attribute-changed" string) - string (string-replace "changes done" "changes-done-hint" string) - string (string-replace "renamed to" "moved" string)) + (setq string + (thread-last + (concat rest-string string) + ;; Fix action names. + (string-replace "attributes changed" "attribute-changed") + (string-replace "changes done" "changes-done-hint") + (string-replace "renamed to" "moved"))) ;; https://bugs.launchpad.net/bugs/1742946 (when (string-match-p diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index c83a7a9978d..08a44c81f08 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1993,48 +1993,39 @@ ID-FORMAT valid values are `string' and `integer'." "Like `file-name-all-completions' for Tramp files." (tramp-skeleton-file-name-all-completions filename directory (with-parsed-tramp-file-name (expand-file-name directory) nil - (when (and (not (string-search "/" filename)) - (tramp-connectable-p v)) - (unless (string-search "/" filename) - (all-completions - filename - (with-tramp-file-property v localname "file-name-all-completions" - (let (result) - ;; Get a list of directories and files, including - ;; reliably tagging the directories with a trailing "/". - ;; Because I rock. --daniel@danann.net - (if (tramp-get-remote-perl v) - (tramp-maybe-send-script - v tramp-perl-file-name-all-completions - "tramp_perl_file_name_all_completions") - (tramp-maybe-send-script - v tramp-shell-file-name-all-completions - "tramp_shell_file_name_all_completions")) + (let (result) + ;; Get a list of directories and files, including reliably + ;; tagging the directories with a trailing "/". + ;; Because I rock. --daniel@danann.net + (if (tramp-get-remote-perl v) + (tramp-maybe-send-script + v tramp-perl-file-name-all-completions + "tramp_perl_file_name_all_completions") + (tramp-maybe-send-script + v tramp-shell-file-name-all-completions + "tramp_shell_file_name_all_completions")) - (dolist - (elt - (tramp-send-command-and-read - v (format - "%s %s" - (if (tramp-get-remote-perl v) - "tramp_perl_file_name_all_completions" - "tramp_shell_file_name_all_completions") - (tramp-shell-quote-argument localname)) - 'noerror) - result) - ;; Don't cache "." and "..". - (when (string-match-p - directory-files-no-dot-files-regexp - (file-name-nondirectory (car elt))) - (tramp-set-file-property v (car elt) "file-exists-p" (nth 1 elt)) - (tramp-set-file-property v (car elt) "file-readable-p" (nth 2 elt)) - (tramp-set-file-property v (car elt) "file-directory-p" (nth 3 elt)) - (tramp-set-file-property v (car elt) "file-executable-p" (nth 4 elt))) + (dolist + (elt + (tramp-send-command-and-read + v (format + "%s %s" + (if (tramp-get-remote-perl v) + "tramp_perl_file_name_all_completions" + "tramp_shell_file_name_all_completions") + (tramp-shell-quote-argument localname)) + 'noerror) + result) + ;; Don't cache "." and "..". + (when (string-match-p + directory-files-no-dot-files-regexp + (file-name-nondirectory (car elt))) + (tramp-set-file-property v (car elt) "file-exists-p" (nth 1 elt)) + (tramp-set-file-property v (car elt) "file-readable-p" (nth 2 elt)) + (tramp-set-file-property v (car elt) "file-directory-p" (nth 3 elt)) + (tramp-set-file-property v (car elt) "file-executable-p" (nth 4 elt))) - (push - (concat - (file-name-nondirectory (car elt)) (and (nth 3 elt) "/")) - result)))))))))) + (push (file-name-nondirectory (car elt)) result)))))) ;; cp, mv and ln @@ -2803,7 +2794,7 @@ The method used must be an out-of-band method." (append switches (split-string (tramp-sh--quoting-style-options v)) (when dired `(,dired)))) (unless dired - (setq switches (delete "-N" (delete "--dired" switches))))) + (setq switches (seq-difference switches '("-N" "--dired"))))) (when wildcard (setq wildcard (tramp-run-real-handler #'file-name-nondirectory (list localname))) @@ -3917,11 +3908,13 @@ Fall back to normal file name handler if no Tramp handler exists." (when rest-string (tramp-message proc 10 "Previous string:\n%s" rest-string)) (tramp-message proc 6 "%S\n%s" proc string) - (setq string (concat rest-string string) - ;; Fix action names. - string (string-replace "attributes changed" "attribute-changed" string) - string (string-replace "changes done" "changes-done-hint" string) - string (string-replace "renamed to" "moved" string)) + (setq string + (thread-last + (concat rest-string string) + ;; Fix action names. + (string-replace "attributes changed" "attribute-changed") + (string-replace "changes done" "changes-done-hint") + (string-replace "renamed to" "moved"))) (catch 'doesnt-work ;; https://bugs.launchpad.net/bugs/1742946 diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 554aa354c00..bda033b7838 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1068,18 +1068,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (defun tramp-smb-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." (tramp-skeleton-file-name-all-completions filename directory - (all-completions - filename - (when (file-directory-p directory) - (with-parsed-tramp-file-name (expand-file-name directory) nil - (with-tramp-file-property v localname "file-name-all-completions" - (mapcar - (lambda (x) - (list - (if (string-search "d" (nth 1 x)) - (file-name-as-directory (nth 0 x)) - (nth 0 x)))) - (tramp-smb-get-file-entries directory)))))))) + (mapcar #'car (tramp-smb-get-file-entries directory)))) (defun tramp-smb-handle-file-system-info (filename) "Like `file-system-info' for Tramp files." @@ -1752,9 +1741,6 @@ Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)." (unless share (tramp-set-connection-property v "share-cache" res))) - ;; Add directory itself. - (push '("" "drwxrwxrwx" 0 (0 0)) res) - ;; Return entries. (delq nil res))))) @@ -2295,9 +2281,6 @@ SHARE will be passed to the call of `tramp-smb-get-localname'." ;; * Return more comprehensive file permission string. ;; -;; * Try to remove the inclusion of dummy "" directory. Seems to be at -;; several places, especially in `tramp-smb-handle-insert-directory'. -;; ;; * Keep a separate connection process per share. ;; ;; * Keep a permanent connection process for `process-file'. diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 9511c899b2b..8bf6a9f50b0 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -498,24 +498,16 @@ the result will be a local, non-Tramp, file name." (defun tramp-sudoedit-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." (tramp-skeleton-file-name-all-completions filename directory - (all-completions - filename - (with-parsed-tramp-file-name (expand-file-name directory) nil - (with-tramp-file-property v localname "file-name-all-completions" - (tramp-sudoedit-send-command - v "ls" "-a1" "--quoting-style=literal" "--show-control-chars" - (if (tramp-string-empty-or-nil-p localname) - "" (file-name-unquote localname))) - (mapcar - (lambda (f) - (if (ignore-errors (file-directory-p (expand-file-name f directory))) - (file-name-as-directory f) - f)) - (mapcar - (lambda (l) (and (not (string-match-p (rx bol (* blank) eol) l)) l)) - (split-string - (tramp-get-buffer-string (tramp-get-connection-buffer v)) - "\n" 'omit)))))))) + (with-parsed-tramp-file-name (expand-file-name directory) nil + (tramp-sudoedit-send-command + v "ls" "-a1" "--quoting-style=literal" "--show-control-chars" + (if (tramp-string-empty-or-nil-p localname) + "" (file-name-unquote localname))) + (mapcar + (lambda (l) (and (not (string-match-p (rx bol (* blank) eol) l)) l)) + (split-string + (tramp-get-buffer-string (tramp-get-connection-buffer v)) + "\n" 'omit))))) (defun tramp-sudoedit-handle-file-readable-p (filename) "Like `file-readable-p' for Tramp files." diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 5441a26d7a0..d67d77fadc6 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2002,12 +2002,11 @@ expected to be a string, which will be used." "Construct a Tramp hop name from VEC." (concat (tramp-file-name-hop vec) - (replace-regexp-in-string - tramp-prefix-regexp "" - (replace-regexp-in-string - (rx (regexp tramp-postfix-host-regexp) eos) - tramp-postfix-hop-format - (tramp-make-tramp-file-name (tramp-file-name-unify vec)))))) + (thread-last + (replace-regexp-in-string + (rx (regexp tramp-postfix-host-regexp) eos) tramp-postfix-hop-format + (tramp-make-tramp-file-name (tramp-file-name-unify vec))) + (replace-regexp-in-string tramp-prefix-regexp "")))) (defun tramp-completion-make-tramp-file-name (method user host localname) "Construct a Tramp file name from METHOD, USER, HOST and LOCALNAME. @@ -2957,7 +2956,7 @@ not in completion mode." (or (and (cond ;; Completion styles like `flex' and `substring' check for ;; the file name "/". This does exist. - ((string-equal filename "/")) + ((string-equal filename tramp-prefix-format)) ;; Is it a valid method? ((and (not (string-empty-p tramp-postfix-method-format)) (string-match @@ -3001,30 +3000,59 @@ not in completion mode." (tramp-run-real-handler #'file-exists-p (list filename)))) +(defvar tramp-fnac-add-trailing-slash t + "Whether `file-name-all-completions' shall add a trailing slash. +This is not desired, if that function is used in `directory-files', or +in `tramp-completion-handle-file-name-all-completions'.") + (defmacro tramp-skeleton-file-name-all-completions (filename directory &rest body) "Skeleton for `tramp-*-handle-filename-all-completions'. BODY is the backend specific code." (declare (indent 2) (debug t)) `(ignore-error file-missing - (seq-uniq (delq nil (delete "" - (let* ((case-fold-search read-file-name-completion-ignore-case) - (result (progn ,@body))) - ;; Some storage systems do not return "." and "..". - (when (tramp-tramp-file-p ,directory) - (dolist (elt '(".." ".")) - (when (string-prefix-p ,filename elt) - (setq result (cons (concat elt "/") result))))) - (if (consp completion-regexp-list) - ;; Discriminate over `completion-regexp-list'. - (mapcar - (lambda (x) - (when (stringp x) - (catch 'match - (dolist (elt completion-regexp-list x) - (unless (string-match-p elt x) (throw 'match nil)))))) - result) - result))))))) + (all-completions + ,filename + (when (file-directory-p ,directory) + (seq-uniq (delq nil + (let* ((case-fold-search read-file-name-completion-ignore-case) + (result + (if (tramp-tramp-file-p ,directory) + (with-parsed-tramp-file-name + (expand-file-name ,directory) nil + (when (and (not (string-search "/" ,filename)) + (tramp-connectable-p v)) + (with-tramp-file-property + v localname + (format + "file-name-all-completions-%s" + tramp-fnac-add-trailing-slash) + ;; Mark symlinked directories. Other + ;; directories are already marked. + (mapcar + (lambda (x) + (let ((f (file-name-concat ,directory x))) + (if (and tramp-fnac-add-trailing-slash + (not (string-suffix-p "/" x)) + (file-directory-p + (if (file-symlink-p f) + (file-truename f) f))) + (concat x "/") x))) + ;; Some storage systems do not return "." and "..". + (seq-union + (seq-difference (progn ,@body) '("." "..")) + '("./" "../")))))) + ,@body))) + ;; Discriminate over `completion-regexp-list'. + (if (consp completion-regexp-list) + (mapcar + (lambda (x) + (when (stringp x) + (catch 'match + (dolist (elt completion-regexp-list x) + (unless (string-match-p elt x) (throw 'match nil)))))) + result) + result)))))))) (defvar tramp--last-hop-directory nil "Tracks the directory from which to run login programs.") @@ -3035,72 +3063,74 @@ BODY is the backend specific code." ;; completions. (defun tramp-completion-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for partial Tramp files." - (tramp-skeleton-file-name-all-completions filename directory - (let ((fullname - (tramp-drop-volume-letter (expand-file-name filename directory))) - (directory (tramp-drop-volume-letter directory)) - tramp--last-hop-directory hop result result1) + (let (tramp-fnac-add-trailing-slash) + (tramp-skeleton-file-name-all-completions filename directory + (let ((fullname + (tramp-drop-volume-letter (expand-file-name filename directory))) + (directory (tramp-drop-volume-letter directory)) + tramp--last-hop-directory hop result result1) - ;; Suppress hop from completion. - (when (string-match - (rx - (regexp tramp-prefix-regexp) - (group (+ (regexp tramp-remote-file-name-spec-regexp) - (regexp tramp-postfix-hop-regexp)))) - fullname) - (setq hop (match-string 1 fullname) - fullname (replace-match "" nil nil fullname 1) - tramp--last-hop-directory - (tramp-make-tramp-file-name (tramp-dissect-hop-name hop)))) + ;; Suppress hop from completion. + (when (string-match + (rx + (regexp tramp-prefix-regexp) + (group (+ (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-hop-regexp)))) + fullname) + (setq hop (match-string 1 fullname) + fullname (replace-match "" nil nil fullname 1) + tramp--last-hop-directory + (tramp-make-tramp-file-name (tramp-dissect-hop-name hop)))) - (let (tramp-default-user tramp-default-user-alist - tramp-default-host tramp-default-host-alist) + (let (tramp-default-user tramp-default-user-alist + tramp-default-host tramp-default-host-alist) - ;; Possible completion structures. - (dolist (elt (tramp-completion-dissect-file-name fullname)) - (let* ((method (tramp-file-name-method elt)) - (user (tramp-file-name-user elt)) - (host (tramp-file-name-host elt)) - (localname (tramp-file-name-localname elt)) - (m (tramp-find-method method user host)) - all-user-hosts) + ;; Possible completion structures. + (dolist (elt (tramp-completion-dissect-file-name fullname)) + (let* ((method (tramp-file-name-method elt)) + (user (tramp-file-name-user elt)) + (host (tramp-file-name-host elt)) + (localname (tramp-file-name-localname elt)) + (m (tramp-find-method method user host)) + all-user-hosts) - (unless localname ;; Nothing to complete. - (if (or user host) - ;; Method dependent user / host combinations. - (progn - (mapc - (lambda (x) - (setq all-user-hosts - (append all-user-hosts - (funcall (nth 0 x) (nth 1 x))))) - (tramp-get-completion-function m)) + (unless localname ;; Nothing to complete. + (if (or user host) + ;; Method dependent user / host combinations. + (progn + (mapc + (lambda (x) + (setq all-user-hosts + (append all-user-hosts + (funcall (nth 0 x) (nth 1 x))))) + (tramp-get-completion-function m)) - (setq result - (append result - (mapcar - (lambda (x) - (tramp-get-completion-user-host - method user host (nth 0 x) (nth 1 x))) - all-user-hosts)))) + (setq result + (append result + (mapcar + (lambda (x) + (tramp-get-completion-user-host + method user host (nth 0 x) (nth 1 x))) + all-user-hosts)))) - ;; Possible methods. - (setq result - (append result (tramp-get-completion-methods m hop))))))) + ;; Possible methods. + (setq result + (append result (tramp-get-completion-methods m hop))))))) - ;; Add hop. - (dolist (elt result) - (when elt - (setq elt (replace-regexp-in-string - tramp-prefix-regexp (concat tramp-prefix-format hop) elt)) - (push (substring elt (length directory)) result1))) + ;; Add hop. + (dolist (elt result) + (when elt + (setq elt (replace-regexp-in-string + tramp-prefix-regexp + (concat tramp-prefix-format hop) elt)) + (push (substring elt (length directory)) result1))) - ;; Complete local parts. - (append - result1 - (ignore-errors - (tramp-run-real-handler - #'file-name-all-completions (list filename directory)))))))) + ;; Complete local parts. + (append + result1 + (ignore-errors + (tramp-run-real-handler + #'file-name-all-completions (list filename directory))))))))) ;; Method, host name and user name completion for a file. (defun tramp-completion-handle-file-name-completion @@ -3659,9 +3689,10 @@ BODY is the backend specific code." (signal 'error nil) (setf ,directory (file-name-as-directory (expand-file-name ,directory))) - (let ((temp - (with-tramp-file-property v localname "directory-files" ,@body)) - result item) + (let* (tramp-fnac-add-trailing-slash + (temp + (with-tramp-file-property v localname "directory-files" ,@body)) + result item) (while temp (setq item (directory-file-name (pop temp))) (when (or (null ,match) (string-match-p ,match item)) @@ -4496,8 +4527,8 @@ Let-bind it when necessary.") ;; "." and ".." are never interesting as completions, and are ;; actually in the way in a directory with only one file. See ;; file_name_completion() in dired.c. - (when (and (consp fnac) (length= (delete "./" (delete "../" fnac)) 1)) - (setq fnac (delete "./" (delete "../" fnac)))) + (when (and (consp fnac) (length= (seq-difference fnac '("./" "../")) 1)) + (setq fnac (seq-difference fnac '("./" "../")))) (or (try-completion filename fnac @@ -5487,7 +5518,7 @@ processes." v 'tramp-login-args nil ?h (or host "") ?u (or user "") ?p (or port "") ?c (format-spec (or options "") (format-spec-make ?t tmpfile)) - ?d (or device "") ?a (or pta "") ?l "")))) + ?w "" ?d (or device "") ?a (or pta "") ?l "")))) ;; Suppress `internal-default-process-sentinel', which is set ;; when :sentinel is nil. (Bug#71049) p (make-process diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 149fa1d2537..3972e5faa45 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -5078,6 +5078,21 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (sort (file-name-all-completions "b" tmp-name) #'string-lessp) '("bold" "boz/"))) (should-not (file-name-all-completions "a" tmp-name)) + ;; Symbolic links. + (tramp--test-ignore-make-symbolic-link-error + (make-symbolic-link + (file-name-concat tmp-name "foo") + (file-name-concat tmp-name "link1")) + (should (file-exists-p (expand-file-name "link1" tmp-name))) + (make-symbolic-link + (file-name-concat tmp-name "boz") + (file-name-concat tmp-name "link2")) + (should (file-exists-p (expand-file-name "link2" tmp-name))) + (should (equal (file-name-completion "li" tmp-name) "link")) + (should (member "link1" (file-name-all-completions "" tmp-name))) + (should (member "link2/" (file-name-all-completions "" tmp-name))) + (delete-file (file-name-concat tmp-name "link1")) + (delete-file (file-name-concat tmp-name "link2"))) ;; `completion-regexp-list' restricts the completion to ;; files which match all expressions in this list. ;; Ange-FTP does not complete "". @@ -6329,9 +6344,12 @@ INPUT, if non-nil, is a string sent to the process." this-shell-command "echo foo >&2; echo bar" (current-buffer) stderr) (should (string-equal "bar\n" (buffer-string))) - ;; Check stderr. + ;; Check stderr. Some shells echo, for example the + ;; "adb" or container methods. (should - (string-equal "foo\n" (tramp-get-buffer-string stderr)))) + (string-match-p + (rx bol (** 1 2 "foo\n") eol) + (tramp-get-buffer-string stderr)))) ;; Cleanup. (ignore-errors (kill-buffer stderr)))))) @@ -6896,8 +6914,7 @@ INPUT, if non-nil, is a string sent to the process." "Check `vc-registered'." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) - (skip-unless (tramp--test-sh-p)) - (skip-unless (not (tramp--test-crypt-p))) + (skip-unless (tramp--test-supports-processes-p)) (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) ;; We must use `file-truename' for the temporary directory, in @@ -6912,17 +6929,9 @@ INPUT, if non-nil, is a string sent to the process." (inhibit-message (not (ignore-errors (edebug-mode)))) (vc-handled-backends (cond - ((tramp-find-executable - tramp-test-vec vc-git-program - (tramp-get-remote-path tramp-test-vec)) - '(Git)) - ((tramp-find-executable - tramp-test-vec vc-hg-program - (tramp-get-remote-path tramp-test-vec)) - '(Hg)) - ((tramp-find-executable - tramp-test-vec vc-bzr-program - (tramp-get-remote-path tramp-test-vec)) + ((executable-find vc-git-program 'remote) '(Git)) + ((executable-find vc-hg-program 'remote) '(Hg)) + ((executable-find vc-bzr-program 'remote) (setq tramp-remote-process-environment (cons (format "BZR_HOME=%s" (file-remote-p tmp-name1 'localname)) From a481b5807e134df69305268dd3407d0d1d8e06f5 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 28 Mar 2026 09:54:40 +0100 Subject: [PATCH 2/2] Fix tramp-smb-handle-copy-file * lisp/net/tramp-smb.el (tramp-smb-handle-copy-file): Suppress `jka-compr-handler'. Reported by Seppo Ronkainen . (Bug#80667) --- lisp/net/tramp-smb.el | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index bda033b7838..8eec0e1bd08 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -603,12 +603,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (copy-directory filename newname keep-date 'parents 'copy-contents) (tramp-barf-if-file-missing v filename - ;; `file-local-copy' returns a file name also for a local - ;; file with `jka-compr-handler', so we cannot trust its - ;; result as indication for a remote file name. - (if-let* ((tmpfile - (and (tramp-tramp-file-p filename) - (file-local-copy filename)))) + ;; Suppress `jka-compr-handler'. + (if-let* ((jka-compr-inhibit t) + (tmpfile (file-local-copy filename))) ;; Remote filename. (condition-case err (rename-file tmpfile newname ok-if-already-exists)