From 97776f295d652aff97be91431ad53db5618ad2a2 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 7 May 2016 22:52:30 +0200 Subject: [PATCH] Continue to fix Bug#10085 * lisp/net/tramp.el (tramp-completion-file-name-handler-alist) : Add handler. (tramp-completion-handle-expand-file-name): New defun. (tramp-handle-file-name-as-directory): Handle completion mode case. * test/lisp/net/tramp-tests.el (tramp-test06-directory-file-name): Fix test. (tramp-test24-file-name-completion): Extend test. --- lisp/net/tramp.el | 31 ++++++++++++++--- test/lisp/net/tramp-tests.el | 67 ++++++++++++++++++++++++++---------- 2 files changed, 75 insertions(+), 23 deletions(-) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 3da60e93b78..87ccae12ca2 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1010,7 +1010,9 @@ means to use always cached values for the directory contents." ;;;###autoload (defconst tramp-completion-file-name-handler-alist - '((file-name-all-completions . tramp-completion-handle-file-name-all-completions) + '((expand-file-name . tramp-completion-handle-expand-file-name) + (file-name-all-completions + . tramp-completion-handle-file-name-all-completions) (file-name-completion . tramp-completion-handle-file-name-completion)) "Alist of completion handler functions. Used for file names matching `tramp-file-name-regexp'. Operations @@ -2261,6 +2263,23 @@ not in completion mode." (p (tramp-get-connection-process v))) (and p (processp p) (memq (process-status p) '(run open)))))))) +;;;###autoload +(defun tramp-completion-handle-expand-file-name + (name &optional dir) + "Like `expand-file-name' for Tramp files." + (if (tramp-completion-mode-p) + (progn + ;; If DIR is not given, use `default-directory' or "/". + (setq dir (or dir default-directory "/")) + ;; Unless NAME is absolute, concat DIR and NAME. + (unless (file-name-absolute-p name) + (setq name (concat (file-name-as-directory dir) name))) + ;; Return NAME. + name) + + (tramp-completion-run-real-handler + 'expand-file-name (list name dir)))) + ;; 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 completions. @@ -2817,13 +2836,17 @@ User is always nil." ;; `file-name-as-directory' would be sufficient except localname is ;; the empty string. (let ((v (tramp-dissect-file-name file t))) - ;; Run the command on the localname portion only. + ;; Run the command on the localname portion only unless we are in + ;; completion mode. (tramp-make-tramp-file-name (tramp-file-name-method v) (tramp-file-name-user v) (tramp-file-name-host v) - (tramp-run-real-handler - 'file-name-as-directory (list (or (tramp-file-name-localname v) ""))) + (if (and (tramp-completion-mode-p) + (zerop (length (tramp-file-name-localname v)))) + "" + (tramp-run-real-handler + 'file-name-as-directory (list (or (tramp-file-name-localname v) "")))) (tramp-file-name-hop v)))) (defun tramp-handle-file-name-completion diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index efb19e9f506..a85eed0302a 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -649,7 +649,9 @@ This checks also `file-name-as-directory', `file-name-directory', (setq file (format "/%s:" file)) (should (string-equal (directory-file-name file) file)) (should - (string-equal (file-name-as-directory file) (concat file "./"))) + (string-equal + (file-name-as-directory file) + (if (tramp-completion-mode-p) file (concat file "./")))) (should (string-equal (file-name-directory file) file)) (should (string-equal (file-name-nondirectory file) ""))))))) @@ -1367,25 +1369,52 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." "Check `file-name-completion' and `file-name-all-completions'." (skip-unless (tramp--test-enabled)) - (let ((tmp-name (tramp--test-make-temp-name))) - (unwind-protect - (progn - (make-directory tmp-name) - (should (file-directory-p tmp-name)) - (write-region "foo" nil (expand-file-name "foo" tmp-name)) - (write-region "bar" nil (expand-file-name "bold" tmp-name)) - (make-directory (expand-file-name "boz" tmp-name)) - (should (equal (file-name-completion "fo" tmp-name) "foo")) - (should (equal (file-name-completion "b" tmp-name) "bo")) - (should - (equal (file-name-completion "b" tmp-name 'file-directory-p) "boz/")) - (should (equal (file-name-all-completions "fo" tmp-name) '("foo"))) - (should - (equal (sort (file-name-all-completions "b" tmp-name) 'string-lessp) - '("bold" "boz/")))) + (dolist (n-e '(nil t)) + (let ((non-essential n-e) + (tmp-name (tramp--test-make-temp-name)) + (method (file-remote-p tramp-test-temporary-file-directory 'method)) + (host (file-remote-p tramp-test-temporary-file-directory 'host))) + + (unwind-protect + (progn + ;; Method and host name in completion mode. + (when (tramp-completion-mode-p) + (unless (zerop (length method)) + (should + (member + (format "%s:" method) + (file-name-all-completions (substring method 0 1) "/")))) + (unless (zerop (length host)) + (should + (member + (format "%s:" host) + (file-name-all-completions (substring host 0 1) "/")))) + (unless (or (zerop (length method)) (zerop (length host))) + (should + (member + (format "%s:" host) + (file-name-all-completions + (substring host 0 1) (format "/%s:" method)))))) + + ;; Local files. + (make-directory tmp-name) + (should (file-directory-p tmp-name)) + (write-region "foo" nil (expand-file-name "foo" tmp-name)) + (write-region "bar" nil (expand-file-name "bold" tmp-name)) + (make-directory (expand-file-name "boz" tmp-name)) + (should (equal (file-name-completion "fo" tmp-name) "foo")) + (should (equal (file-name-completion "b" tmp-name) "bo")) + (should + (equal + (file-name-completion "b" tmp-name 'file-directory-p) "boz/")) + (should (equal (file-name-all-completions "fo" tmp-name) '("foo"))) + (should + (equal + (sort (file-name-all-completions "b" tmp-name) 'string-lessp) + '("bold" "boz/")))) - ;; Cleanup. - (ignore-errors (delete-directory tmp-name 'recursive))))) + ;; Cleanup. + (ignore-errors (delete-directory tmp-name 'recursive)))))) (ert-deftest tramp-test25-load () "Check `load'." -- 2.39.2