From 907fd1f7ff402f9d226ebb3b891ea5b54fac1d1c Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 6 Feb 2023 18:13:22 +0100 Subject: [PATCH] Improve Tramp file name completion This fixes Bug#51386, Bug#52758, Bug#53513, Bug#54042 and Bug#60505. * doc/misc/tramp.texi (File name completion): Remove completion styles restrictions. * lisp/minibuffer.el (completion-styles): Fix docstring. * lisp/net/tramp.el (tramp-methods) <->: Add. (tramp-completion-file-name-handler-alist): Add `expand-file-name', `file-exists-p', `file-name-directory' and `file-name-nondirectory'. (tramp-dissect-file-name): Do not extra check for `tramp-default-method-marker'. (tramp-completion-handle-expand-file-name) (tramp-completion-handle-file-exists-p) (tramp-completion-handle-file-name-directory) (tramp-completion-handle-file-name-nondirectory): New defuns. (tramp-completion-handle-file-name-all-completions): Remove duplicates. * test/lisp/net/tramp-tests.el (tramp-test26-interactive-file-name-completion): New test. --- doc/misc/tramp.texi | 12 +-- lisp/minibuffer.el | 6 +- lisp/net/tramp.el | 94 ++++++++++++++++++++-- test/lisp/net/tramp-tests.el | 150 ++++++++++++++++++++++++++++++++--- 4 files changed, 226 insertions(+), 36 deletions(-) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index d344feb2d63..7f6182ae17c 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -3469,12 +3469,7 @@ much more appropriate. @value{tramp} can complete the following @value{tramp} file name components: method names, user names, host names, and file names -located on remote hosts. User name and host name completion is -activated only, if file name completion has one of the styles -@code{basic}, @code{emacs21}, or @code{emacs22}. -@ifinfo -@xref{Completion Styles, , , emacs}. -@end ifinfo +located on remote hosts. For example, type @kbd{C-x C-f @value{prefixwithspace} s @key{TAB}}, @value{tramp} completion choices show up as @@ -3508,10 +3503,7 @@ directory @file{/sbin} on your local host. Type @kbd{s h @value{postfixhop}} for the minibuffer completion to @samp{@value{prefix}ssh@value{postfixhop}}. Typing @kbd{@key{TAB}} shows host names @value{tramp} extracts from @file{~/.ssh/config} -@c bug#50387 -file, for example@footnote{Some completion styles, like -@code{substring} or @code{flex}, require to type at least one -character after the trailing @samp{@value{postfixhop}}.}. +file, for example: @example @group diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 21d4607e7cf..01894689623 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1087,11 +1087,7 @@ and DOC describes the way this style of completion works.") The available styles are listed in `completion-styles-alist'. Note that `completion-category-overrides' may override these -styles for specific categories, such as files, buffers, etc. - -Note that Tramp host name completion (e.g., \"/ssh:ho\") -currently doesn't work if this list doesn't contain at least one -of `basic', `emacs22' or `emacs21'." +styles for specific categories, such as files, buffers, etc." :type completion--styles-type :version "23.1") diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 21dbd40b1d2..69812506e48 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -441,6 +441,8 @@ See `tramp-methods' for a list of possibilities for METHOD." (defconst tramp-default-method-marker "-" "Marker for default method in remote file names.") +(add-to-list 'tramp-methods `(,tramp-default-method-marker)) + (defcustom tramp-default-user nil "Default user to use for transferring files. It is nil by default; otherwise settings in configuration files like @@ -1414,9 +1416,13 @@ This shouldn't be set explicitly. It is let-bound, for example during direct remote copying with scp.") (defconst tramp-completion-file-name-handler-alist - '((file-name-all-completions + '((expand-file-name . tramp-completion-handle-expand-file-name) + (file-exists-p . tramp-completion-handle-file-exists-p) + (file-name-all-completions . tramp-completion-handle-file-name-all-completions) - (file-name-completion . tramp-completion-handle-file-name-completion)) + (file-name-completion . tramp-completion-handle-file-name-completion) + (file-name-directory . tramp-completion-handle-file-name-directory) + (file-name-nondirectory . tramp-completion-handle-file-name-nondirectory)) "Alist of completion handler functions. Used for file names matching `tramp-completion-file-name-regexp'. Operations not mentioned here will be handled by Tramp's file @@ -1707,7 +1713,6 @@ default values are used." :port port :localname localname :hop hop)) ;; The method must be known. (unless (or nodefault non-essential - (string-equal method tramp-default-method-marker) (assoc method tramp-methods)) (tramp-user-error v "Method `%s' is not known." method)) @@ -2941,6 +2946,50 @@ not in completion mode." (and vec (process-live-p (get-process (tramp-buffer-name vec)))) (not non-essential)))) +(defun tramp-completion-handle-expand-file-name (filename &optional directory) + "Like `expand-file-name' for partial Tramp files." + (if (file-name-absolute-p filename) + filename + (concat (or directory default-directory "/") filename))) + +(defun tramp-completion-handle-file-exists-p (filename) + "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@host" or "/[method/user@host" as existent, if + ;; "user@host" is a valid file name completion. + (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) + (group (regexp tramp-method-regexp)) + (? (regexp tramp-postfix-method-regexp)) + eos) + filename)) + (assoc (match-string 1 filename) tramp-methods)) + ;; Is it a valid user@host? + ((string-match + (rx + (regexp tramp-prefix-regexp) + (group (regexp tramp-remote-file-name-spec-regexp)) + eos) + filename) + (member + (concat + (file-name-nondirectory filename) tramp-postfix-host-format) + (file-name-all-completions + (file-name-nondirectory filename) + (file-name-directory filename))))) + t) + + (tramp-run-real-handler #'file-exists-p (list filename)))) + ;; Method, host name and user name completion. ;; `tramp-completion-dissect-file-name' returns a list of ;; `tramp-file-name' structures. For all of them we return possible @@ -3014,11 +3063,12 @@ not in completion mode." result1))) ;; Complete local parts. - (append - result1 - (ignore-errors - (tramp-run-real-handler - #'file-name-all-completions (list filename directory)))))) + (delete-dups + (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 @@ -3176,6 +3226,34 @@ PARTIAL-USER must match USER, PARTIAL-HOST must match HOST." (unless (zerop (+ (length user) (length host))) (tramp-completion-make-tramp-file-name method user host nil))) +(defun tramp-completion-handle-file-name-directory (filename) + "Like `file-name-directory' for partial Tramp files." + ;; We need special handling only when a method is needed. Then we + ;; return "/method:" or "/[method/", if "method" is a valid Tramp + ;; method. In the `separate' file name syntax, we return "/[" when + ;; `filename' is "/[string" w/o a trailing method separator "/". + (cond + ((and (not (string-empty-p tramp-method-regexp)) + (string-match + (rx (group + (regexp tramp-prefix-regexp) + (group (regexp tramp-method-regexp)) + (regexp tramp-postfix-method-regexp))) + filename) + ;; Is it a valid method? + (assoc (match-string 2 filename) tramp-methods)) + (match-string 1 filename)) + ((string-match + (rx (group (regexp tramp-prefix-regexp)) + (regexp tramp-completion-method-regexp) eos) + filename) + (match-string 1 filename)) + (t (tramp-run-real-handler #'file-name-directory (list filename))))) + +(defun tramp-completion-handle-file-name-nondirectory (filename) + "Like `file-name-nondirectory' for partial Tramp files." + (tramp-compat-string-replace (file-name-directory filename) "" filename)) + (defun tramp-parse-default-user-host (method) "Return a list of (user host) tuples allowed to access for METHOD. This function is added always in `tramp-get-completion-function' diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index cc93970be28..d903ba626b9 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4529,24 +4529,22 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (setq host (match-string 1 host))) (unwind-protect - (dolist - (syntax - (if (tramp--test-expensive-test-p) - (tramp-syntax-values) `(,orig-syntax))) + (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. (tramp-set-connection-property tramp-test-vec "property" nil) - (let ;; This is needed for the `separate' syntax. - ((prefix-format (substring tramp-prefix-format 1)) - ;; This is needed for the IPv6 host name syntax. - (ipv6-prefix - (and (string-match-p tramp-ipv6-regexp host) - tramp-prefix-ipv6-format)) - (ipv6-postfix - (and (string-match-p tramp-ipv6-regexp host) - tramp-postfix-ipv6-format))) + (let (;; This is needed for the `separate' syntax. + (prefix-format (substring tramp-prefix-format 1)) + ;; This is needed for the IPv6 host name syntax. + (ipv6-prefix + (and (string-match-p tramp-ipv6-regexp host) + tramp-prefix-ipv6-format)) + (ipv6-postfix + (and (string-match-p tramp-ipv6-regexp host) + tramp-postfix-ipv6-format))) ;; Complete method name. (unless (or (tramp-string-empty-or-nil-p method) (string-empty-p tramp-method-regexp)) @@ -4637,6 +4635,132 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Cleanup. (ignore-errors (delete-directory tmp-name 'recursive))))))) +;; This test is inspired by Bug#51386, Bug#52758, Bug#53513, Bug#54042 +;; and Bug#60505. +;; TODO: Add tests for user names and multi-hop file names. +(ert-deftest tramp-test26-interactive-file-name-completion () + "Check interactive completion with different `completion-styles'." + ;; Method and host name in completion mode. This kind of completion + ;; does not work on MS Windows. + (unless (memq system-type '(cygwin windows-nt)) + (let ((method (file-remote-p ert-remote-temporary-file-directory 'method)) + (host (file-remote-p ert-remote-temporary-file-directory 'host)) + (orig-syntax tramp-syntax) + (non-essential t)) + (when (and (stringp host) (string-match tramp-host-with-port-regexp host)) + (setq host (match-string 1 host))) + + (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. + (tramp-set-connection-property tramp-test-vec "property" nil) + + (dolist + (style + (if (tramp--test-expensive-test-p) + ;; It doesn't work for `initials' and `shorthand' + ;; completion styles. Should it? + '(emacs21 emacs22 basic partial-completion substring flex) + '(basic))) + + (let (;; Force the real minibuffer in batch mode. + (executing-kbd-macro t) + (completion-styles `(,style)) + (completions-format 'one-column) + completion-category-defaults + completion-category-overrides + ;; This is needed for the `simplified' syntax, + (tramp-default-method method) + (method-string + (unless (string-empty-p tramp-method-regexp) + (concat method tramp-postfix-method-format))) + ;; This is needed for the IPv6 host name syntax. + (ipv6-prefix + (and (string-match-p tramp-ipv6-regexp host) + tramp-prefix-ipv6-format)) + (ipv6-postfix + (and (string-match-p tramp-ipv6-regexp host) + tramp-postfix-ipv6-format)) + test result completions) + + ;; Complete method name. + (unless (string-empty-p tramp-method-regexp) + (ignore-errors (kill-buffer "*Completions*")) + (discard-input) + (setq test (concat + tramp-prefix-format + (substring-no-properties method 0 2)) + unread-command-events + (mapcar #'identity (concat test "\t\n")) + completions nil + result (read-file-name "Prompt: ")) + (if (not (get-buffer "*Completions*")) + (progn + (tramp--test-message + "syntax: %s style: %s test: %s result: %s" + syntax style test result) + (should + (string-prefix-p + (concat tramp-prefix-format method-string) + result))) + (with-current-buffer "*Completions*" + (re-search-forward + (rx bol (1+ nonl) "possible completions:" eol)) + (forward-line 1) + (setq completions + (split-string + (buffer-substring-no-properties (point) (point-max)) + (rx (any "\r\n")) 'omit))) + (tramp--test-message + "syntax: %s style: %s test: %s result: %s completions: %S" + syntax style test result completions) + (should (member method-string completions)))) + + ;; Complete host name. + (unless (or (tramp-string-empty-or-nil-p host) + (tramp--test-gvfs-p method)) + (ignore-errors (kill-buffer "*Completions*")) + (discard-input) + (setq test (concat + tramp-prefix-format method-string + (substring-no-properties host 0 2)) + unread-command-events + (mapcar #'identity (concat test "\t\n")) + completions nil + result (read-file-name "Prompt: ")) + (if (not (get-buffer "*Completions*")) + (progn + (tramp--test-message + "syntax: %s style: %s test: %s result: %s" + syntax style test result) + (should + (string-equal + (concat + tramp-prefix-format method-string + ipv6-prefix host ipv6-postfix tramp-postfix-host-format) + result))) + (with-current-buffer "*Completions*" + (re-search-forward + (rx bol (1+ nonl) "possible completions:" eol)) + (forward-line 1) + (setq completions + (split-string + (buffer-substring-no-properties (point) (point-max)) + (rx (any "\r\n")) 'omit))) + (tramp--test-message + "syntax: %s style: %s test: %s result: %s completions: %S" + syntax style test result completions) + (should + (member + (concat host tramp-postfix-host-format) + completions))))))) + + ;; Cleanup. + (tramp-change-syntax orig-syntax))))) + (ert-deftest tramp-test27-load () "Check `load'." (skip-unless (tramp--test-enabled)) -- 2.39.5