Commit 1535aaf2 authored by Michael Albinus's avatar Michael Albinus

Fix Bug#23631 for Tramp

* lisp/net/tramp-adb.el (tramp-adb-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):
Fix caching problems.

* lisp/net/tramp-sh.el (tramp-perl-file-name-all-completions): Simplify.

* lisp/net/tramp-smb.el (tramp-smb-handle-directory-files):
Move duplicate deletion ...
(tramp-smb-handle-file-name-all-completions): ... here.

* lisp/net/tramp.el (tramp-handle-file-name-completion):
Handle `completion-ignored-extensions'.  (Bug#23631)

* test/lisp/net/tramp-tests.el (tramp-test24-file-name-completion):
Test also `completion-regexp-list' and `completion-ignored-extensions'.
parent 76fb19b3
......@@ -535,7 +535,7 @@ Emacs dired can't find files."
"Like `file-name-all-completions' for Tramp files."
(all-completions
filename
(with-parsed-tramp-file-name directory nil
(with-parsed-tramp-file-name (expand-file-name directory) nil
(with-tramp-file-property v localname "file-name-all-completions"
(save-match-data
(tramp-adb-send-command
......
......@@ -1020,69 +1020,21 @@ file names."
(defun tramp-gvfs-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
(unless (save-match-data (string-match "/" filename))
(with-parsed-tramp-file-name (expand-file-name directory) nil
(all-completions
filename
(mapcar
'list
(or
;; Try cache entries for filename, filename with last
;; character removed, filename with last two characters
;; removed, ..., and finally the empty string - all
;; concatenated to the local directory name.
(let ((remote-file-name-inhibit-cache
(or remote-file-name-inhibit-cache
tramp-completion-reread-directory-timeout)))
;; This is inefficient for very long filenames, pity
;; `reduce' is not available...
(car
(apply
'append
(mapcar
(lambda (x)
(let ((cache-hit
(tramp-get-file-property
v
(concat localname (substring filename 0 x))
"file-name-all-completions"
nil)))
(when cache-hit (list cache-hit))))
;; We cannot use a length of 0, because file properties
;; for "foo" and "foo/" are identical.
(number-sequence (length filename) 1 -1)))))
;; Cache expired or no matching cache entry found so we need
;; to perform a remote operation.
(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 '("./" "../"))
entry)
;; Get a list of directories and files.
(dolist (item (tramp-gvfs-get-directory-attributes directory))
(dolist (item (tramp-gvfs-get-directory-attributes directory) result)
(setq entry
(or ;; Use display-name if available (google-drive).
;(cdr (assoc "standard::display-name" item))
(car item)))
(when (string-match filename entry)
(if (string-equal (cdr (assoc "type" item)) "directory")
(push (file-name-as-directory entry) result)
(push entry result))))
;; Because the remote op went through OK we know the
;; directory we `cd'-ed to exists.
(tramp-set-file-property v localname "file-exists-p" t)
;; Because the remote op went through OK we know every
;; file listed by `ls' exists.
(mapc (lambda (entry)
(tramp-set-file-property
v (concat localname entry) "file-exists-p" t))
result)
;; Store result in the cache.
(tramp-set-file-property
v (concat localname filename)
"file-name-all-completions" result))))))))
(if (string-equal (cdr (assoc "type" item)) "directory")
(push (file-name-as-directory entry) result)
(push entry result)))))))))
(defun tramp-gvfs-handle-file-notify-add-watch (file-name flags _callback)
"Like `file-notify-add-watch' for Tramp files."
......
......@@ -662,29 +662,19 @@ Escape sequence %s is replaced with name of Perl binary.
This string is passed to `format', so percent characters need to be doubled.")
(defconst tramp-perl-file-name-all-completions
"%s -e 'sub case {
my $str = shift;
if ($ARGV[2]) {
return lc($str);
}
else {
return $str;
}
}
"%s -e '
opendir(d, $ARGV[0]) || die(\"$ARGV[0]: $!\\nfail\\n\");
@files = readdir(d); closedir(d);
foreach $f (@files) {
if (case(substr($f, 0, length($ARGV[1]))) eq case($ARGV[1])) {
if (-d \"$ARGV[0]/$f\") {
print \"$f/\\n\";
}
else {
print \"$f\\n\";
}
if (-d \"$ARGV[0]/$f\") {
print \"$f/\\n\";
}
else {
print \"$f\\n\";
}
}
print \"ok\\n\"
' \"$1\" \"$2\" \"$3\" 2>/dev/null"
' \"$1\" 2>/dev/null"
"Perl script to produce output suitable for use with
`file-name-all-completions' on the remote file system. Escape
sequence %s is replaced with name of Perl binary. This string is
......@@ -1868,135 +1858,63 @@ be non-negative integers."
(defun tramp-sh-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
(unless (save-match-data (string-match "/" filename))
(with-parsed-tramp-file-name (expand-file-name directory) nil
(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, including reliably
;; tagging the directories with a trailing "/". Because I
;; rock. --daniel@danann.net
(tramp-send-command
v
(if (tramp-get-remote-perl v)
(progn
(tramp-maybe-send-script
v tramp-perl-file-name-all-completions
"tramp_perl_file_name_all_completions")
(format "tramp_perl_file_name_all_completions %s"
(tramp-shell-quote-argument localname)))
(format (concat
"(cd %s 2>&1 && %s -a 2>/dev/null"
" | while IFS= read f; do"
" if %s -d \"$f\" 2>/dev/null;"
" then \\echo \"$f/\"; else \\echo \"$f\"; fi; done"
" && \\echo ok) || \\echo fail")
(tramp-shell-quote-argument localname)
(tramp-get-ls-command v)
(tramp-get-test-command v))))
(all-completions
filename
(mapcar
'list
(or
;; Try cache entries for `filename', `filename' with last
;; character removed, `filename' with last two characters
;; removed, ..., and finally the empty string - all
;; concatenated to the local directory name.
(let ((remote-file-name-inhibit-cache
(or remote-file-name-inhibit-cache
tramp-completion-reread-directory-timeout)))
;; This is inefficient for very long file names, pity
;; `reduce' is not available...
(car
(apply
'append
(mapcar
(lambda (x)
(let ((cache-hit
(tramp-get-file-property
v
(concat localname (substring filename 0 x))
"file-name-all-completions"
nil)))
(when cache-hit (list cache-hit))))
;; We cannot use a length of 0, because file properties
;; for "foo" and "foo/" are identical.
(number-sequence (length filename) 1 -1)))))
;; Cache expired or no matching cache entry found so we need
;; to perform a remote operation.
(let (result)
;; Get a list of directories and files, including reliably
;; tagging the directories with a trailing '/'. Because I
;; rock. --daniel@danann.net
;; Changed to perform `cd' in the same remote op and only
;; get entries starting with `filename'. Capture any `cd'
;; error messages. Ensure any `cd' and `echo' aliases are
;; ignored.
(tramp-send-command
v
(if (tramp-get-remote-perl v)
(progn
(tramp-maybe-send-script
v tramp-perl-file-name-all-completions
"tramp_perl_file_name_all_completions")
(format "tramp_perl_file_name_all_completions %s %s %d"
(tramp-shell-quote-argument localname)
(tramp-shell-quote-argument filename)
(if read-file-name-completion-ignore-case 1 0)))
(format (concat
"(cd %s 2>&1 && (%s -a %s 2>/dev/null"
;; `ls' with wildcard might fail with `Argument
;; list too long' error in some corner cases; if
;; `ls' fails after `cd' succeeded, chances are
;; that's the case, so let's retry without
;; wildcard. This will return "too many" entries
;; but that isn't harmful.
" || %s -a 2>/dev/null)"
" | while IFS= read f; do"
" if %s -d \"$f\" 2>/dev/null;"
" then \\echo \"$f/\"; else \\echo \"$f\"; fi; done"
" && \\echo ok) || \\echo fail")
(tramp-shell-quote-argument localname)
(tramp-get-ls-command v)
;; When `filename' is empty, just `ls' without
;; `filename' argument is more efficient than `ls *'
;; for very large directories and might avoid the
;; `Argument list too long' error.
;;
;; With and only with wildcard, we need to add
;; `-d' to prevent `ls' from descending into
;; sub-directories.
(if (zerop (length filename))
"."
(format "-d %s*" (tramp-shell-quote-argument filename)))
(tramp-get-ls-command v)
(tramp-get-test-command v))))
;; Now grab the output.
(with-current-buffer (tramp-get-buffer v)
(goto-char (point-max))
;; Check result code, found in last line of output.
(forward-line -1)
(if (looking-at "^fail$")
(progn
;; Grab error message from line before last line
;; (it was put there by `cd 2>&1').
(forward-line -1)
(tramp-error
v 'file-error
"tramp-sh-handle-file-name-all-completions: %s"
(buffer-substring (point) (point-at-eol))))
;; For peace of mind, if buffer doesn't end in `fail'
;; then it should end in `ok'. If neither are in the
;; buffer something went seriously wrong on the remote
;; side.
(unless (looking-at "^ok$")
(tramp-error
v 'file-error
"\
;; Now grab the output.
(with-current-buffer (tramp-get-buffer v)
(goto-char (point-max))
;; Check result code, found in last line of output.
(forward-line -1)
(if (looking-at "^fail$")
(progn
;; Grab error message from line before last line
;; (it was put there by `cd 2>&1').
(forward-line -1)
(tramp-error
v 'file-error
"tramp-sh-handle-file-name-all-completions: %s"
(buffer-substring (point) (point-at-eol))))
;; For peace of mind, if buffer doesn't end in `fail'
;; then it should end in `ok'. If neither are in the
;; buffer something went seriously wrong on the remote
;; side.
(unless (looking-at "^ok$")
(tramp-error
v 'file-error
"\
tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
(tramp-shell-quote-argument localname) (buffer-string))))
(while (zerop (forward-line -1))
(push (buffer-substring (point) (point-at-eol)) result)))
;; Because the remote op went through OK we know the
;; directory we `cd'-ed to exists.
(tramp-set-file-property v localname "file-exists-p" t)
;; Because the remote op went through OK we know every
;; file listed by `ls' exists.
(mapc (lambda (entry)
(tramp-set-file-property
v (concat localname entry) "file-exists-p" t))
result)
;; Store result in the cache.
(tramp-set-file-property
v (concat localname filename)
"file-name-all-completions" result))))))))
(tramp-shell-quote-argument localname) (buffer-string))))
(while (zerop (forward-line -1))
(push (buffer-substring (point) (point-at-eol)) result)))
result))))))
;; cp, mv and ln
......
......@@ -663,8 +663,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
result)))
;; Sort them if necessary.
(unless nosort (setq result (sort result 'string-lessp)))
;; Remove double entries.
(delete-dups result)))
result))
(defun tramp-smb-handle-expand-file-name (name &optional dir)
"Like `expand-file-name' for Tramp files."
......@@ -907,16 +906,17 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
"Like `file-name-all-completions' for Tramp files."
(all-completions
filename
(with-parsed-tramp-file-name directory nil
(with-parsed-tramp-file-name (expand-file-name directory) nil
(with-tramp-file-property v localname "file-name-all-completions"
(save-match-data
(mapcar
(lambda (x)
(list
(if (string-match "d" (nth 1 x))
(file-name-as-directory (nth 0 x))
(nth 0 x))))
(tramp-smb-get-file-entries directory)))))))
(delete-dups
(mapcar
(lambda (x)
(list
(if (string-match "d" (nth 1 x))
(file-name-as-directory (nth 0 x))
(nth 0 x))))
(tramp-smb-get-file-entries directory))))))))
(defun tramp-smb-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files."
......
......@@ -2867,11 +2867,21 @@ User is always nil."
(error
"tramp-handle-file-name-completion invoked on non-tramp directory `%s'"
directory))
(try-completion
filename
(mapcar 'list (file-name-all-completions filename directory))
(when predicate
(lambda (x) (funcall predicate (expand-file-name (car x) directory))))))
(let (hits-ignored-extensions)
(or
(try-completion
filename (file-name-all-completions filename directory)
(lambda (x)
(when (funcall (or predicate 'identity) (expand-file-name x directory))
(not
(and
completion-ignored-extensions
(string-match
(concat (regexp-opt completion-ignored-extensions 'paren) "$") x)
;; We remember the hit.
(push x hits-ignored-extensions))))))
;; No match. So we try again for ignored files.
(try-completion filename hits-ignored-extensions))))
(defun tramp-handle-file-name-directory (file)
"Like `file-name-directory' but aware of Tramp files."
......
......@@ -1405,10 +1405,15 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(make-directory tmp-name)
(should (file-directory-p tmp-name))
(write-region "foo" nil (expand-file-name "foo" tmp-name))
(should (file-exists-p (expand-file-name "foo" tmp-name)))
(write-region "bar" nil (expand-file-name "bold" tmp-name))
(should (file-exists-p (expand-file-name "bold" tmp-name)))
(make-directory (expand-file-name "boz" tmp-name))
(should (file-directory-p (expand-file-name "boz" tmp-name)))
(should (equal (file-name-completion "fo" tmp-name) "foo"))
(should (equal (file-name-completion "foo" tmp-name) t))
(should (equal (file-name-completion "b" tmp-name) "bo"))
(should-not (file-name-completion "a" tmp-name))
(should
(equal
(file-name-completion "b" tmp-name 'file-directory-p) "boz/"))
......@@ -1416,7 +1421,32 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(should
(equal
(sort (file-name-all-completions "b" tmp-name) 'string-lessp)
'("bold" "boz/"))))
'("bold" "boz/")))
(should-not (file-name-all-completions "a" tmp-name))
;; `completion-regexp-list' restricts the completion to
;; files which match all expressions in this list.
(let ((completion-regexp-list
`(,directory-files-no-dot-files-regexp "b")))
(should
(equal (file-name-completion "" tmp-name) "bo"))
(should
(equal
(sort (file-name-all-completions "" tmp-name) 'string-lessp)
'("bold" "boz/"))))
;; `file-name-completion' ignores file names that end in
;; any string in `completion-ignored-extensions'.
(let ((completion-ignored-extensions '(".ext")))
(write-region "foo" nil (expand-file-name "foo.ext" tmp-name))
(should (file-exists-p (expand-file-name "foo.ext" tmp-name)))
(should (equal (file-name-completion "fo" tmp-name) "foo"))
(should (equal (file-name-completion "foo" tmp-name) t))
(should (equal (file-name-completion "foo." tmp-name) "foo.ext"))
(should (equal (file-name-completion "foo.ext" tmp-name) t))
;; `file-name-all-completions' is not affected.
(should
(equal
(sort (file-name-all-completions "" tmp-name) 'string-lessp)
'("../" "./" "bold" "boz/" "foo" "foo.ext")))))
;; Cleanup.
(ignore-errors (delete-directory tmp-name 'recursive))))))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment