[PATCH 1/1] tramp-file-name-all-completions optimizations with bugfixes

[Julian Scheid]

---
 lisp/ChangeLog |   11 +++
 lisp/tramp.el  |  204 +++++++++++++++++++++++++++++++++++++++++++++-----------
 2 files changed, 176 insertions(+), 39 deletions(-)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 4e75aed..313da54 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,14 @@
+2009-08-17  Julian Scheid  <address@hidden>
+
+        * tramp.el (tramp-perl-file-name-all-completions): New defconst.
+        (tramp-handle-file-name-all-completions): Try using Perl to get
+        partial completions.  When perl not available, combine `cd' and
+        `ls' into single remote operation and use shell expansion to get
+        partial remote directory contents.  Set `file-exists-p' cache for
+        directory and any files returned by ls.  Change cache handling to
+        support partial directory contents.  Use error message emitted by
+        remote `cd' or Perl code for local tramp-error.
+
 2009-08-16  Michael Albinus  <address@hidden>
 
        * tramp-cache.el (top): Autoload `tramp-time-less-p'.
diff --git a/lisp/tramp.el b/lisp/tramp.el
index c4019cb..3fe3d52 100644
--- a/lisp/tramp.el
+++ b/lisp/tramp.el
@@ -1605,6 +1605,35 @@ on the remote file system.
 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;
+ }
+}
+opendir(d, $ARGV[0]) || die(\"$ARGV[0]: $!\\nfail\\n\");
address@hidden = 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\";
+  }
+ }
+}
+print \"ok\\n\"
+' \"$1\" \"$2\" \"$3\" 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
+passed to `format', so percent characters need to be doubled.")
+
 ;; Perl script to implement `file-attributes' in a Lisp `read'able
 ;; output.  If you are hacking on this, note that you get *no* output
 ;; unless this spits out a complete line, including the '\n' at the
@@ -3152,50 +3181,147 @@ value of `default-file-modes', without execute 
permissions."
   "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
-      ;; Flush the directory cache.  There could be changed directory
-      ;; contents.
-      (when (and (integerp tramp-completion-reread-directory-timeout)
-                (> (tramp-time-diff
-                    (current-time)
-                    (tramp-get-file-property
-                     v localname "last-completion" '(0 0 0)))
-                   tramp-completion-reread-directory-timeout))
-       (tramp-flush-file-property v localname))
 
       (all-completions
        filename
        (mapcar
        'list
-       (with-file-property v localname "file-name-all-completions"
-         (let (result)
-          (tramp-barf-unless-okay
-           v
-           (format "cd %s" (tramp-shell-quote-argument localname))
-           "tramp-handle-file-name-all-completions: Couldn't `cd %s'"
-           (tramp-shell-quote-argument localname))
-
-          ;; Get a list of directories and files, including reliably
-          ;; tagging the directories with a trailing '/'.  Because I
-          ;; rock.  address@hidden
-          (tramp-send-command
-           v
-           (format (concat "%s -a 2>/dev/null | while read f; do "
-                           "if %s -d \"$f\" 2>/dev/null; "
-                           "then echo \"$f/\"; else echo \"$f\"; fi; done")
-                   (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))
-            (while (zerop (forward-line -1))
-              (push (buffer-substring
-                     (point) (tramp-compat-line-end-position))
-                    result)))
-
-          (tramp-set-file-property
-           v localname "last-completion" (current-time))
-          result)))))))
+        (or
+         ;; Try cache first
+         (and
+          ;; Ignore if expired
+          (or (not (integerp tramp-completion-reread-directory-timeout))
+              (<= (tramp-time-diff
+                   (current-time)
+                   (tramp-get-file-property
+                    v localname "last-completion" '(0 0 0)))
+                  tramp-completion-reread-directory-timeout))
+
+          ;; 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
+
+          ;; 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))))
+             (number-sequence (length filename) 0 -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.  address@hidden
+
+           ;; 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 %s -a 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 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))
+                          "."
+                        (concat (tramp-shell-quote-argument filename) "* -d"))
+                      (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-handle-file-name-all-completions: %s"
+                    (buffer-substring
+                     (point) (tramp-compat-line-end-position))))
+               ;; 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-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) (tramp-compat-line-end-position))
+                     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.
+           (mapcar (lambda (entry)
+                     (tramp-set-file-property
+                      v (concat localname entry) "file-exists-p" t))
+                   result)
+
+           (tramp-set-file-property
+            v localname "last-completion" (current-time))
+
+           ;; Store result in the cache
+           (tramp-set-file-property
+            v (concat localname filename)
+            "file-name-all-completions"
+            result))))))))
 
 ;; The following isn't needed for Emacs 20 but for 19.34?
 (defun tramp-handle-file-name-completion
-- 
1.6.4