From: Michael Albinus <michael.albinus@gmx.de>
Date: Mon, 30 May 2016 13:00:14 +0000 (+0200)
Subject: Fix Bug#23631 for Tramp
X-Git-Url: https://code.delx.au/gnu-emacs/commitdiff_plain/1535aaf2873ddc6bcf113261800fc137a611e661

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'.
---

diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index c39d24e866..1281dbbd72 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -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
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 1775c82a85..9677392806 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -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."
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index a5d09af10a..bfa3cc62ae 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -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
 
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index b75eee9c8a..fbd7cd3000 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -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."
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 7a57cbc08a..e3755533b9 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -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."
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 49e73a1a9b..a8d89e87c2 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -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))))))