* net/tramp.el (tramp-get-ls-command-with-dired): New defun.

(tramp-handle-insert-directory): Handle "--dired".  (Bug#4075)

2 files changed, 50 insertions, 14 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index b95de0d804b..85242eacf7b 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
+2009-08-09  Michael Albinus  <michael.albinus@gmx.de>
+
+        * net/tramp.el (tramp-get-ls-command-with-dired): New defun.
+        (tramp-handle-insert-directory): Handle "--dired".  (Bug#4075)
+
 2009-08-09  Chong Yidong  <cyd@stupidchicken.com>
 
         * subr.el: Provide hashtable-print-readable.
@@ -290,7 +295,7 @@
 2009-08-04  Michael Albinus  <michael.albinus@gmx.de>
 
         * net/tramp.el (top): Make check for tramp-gvfs loading more
-        robust.
+        robust.  (Bug#3977)
         (tramp-handle-insert-file-contents): `unwind-protect' must be
         inside `with-parsed-tramp-file-name'.
 
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 4ccf2ab6e58..94b4858a074 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -141,7 +141,8 @@
          'tramp-fish
 
          ;; tramp-gvfs needs D-Bus messages.  Available since Emacs 23
-         ;; on some system types.
+         ;; on some system types.  We don't call `dbus-ping', because
+         ;; this would load dbus.el.
          (when (and (featurep 'dbusbind)
                     (condition-case nil
                         (funcall 'dbus-get-unique-name :session)
@@ -3641,10 +3642,8 @@ This is like `dired-recursive-delete-directory' for Tramp files."
              (not (symbol-value 'ls-lisp-use-insert-directory-program)))
         (tramp-run-real-handler
          'insert-directory (list filename switches wildcard full-directory-p))
-      ;; For the moment, we assume that the remote "ls" program does not
-      ;; grok "--dired".  In the future, we should detect this on
-      ;; connection setup.
-      (when (string-match "^--dired\\s-+" switches)
+      (when (and (string-match "^--dired\\s-+" switches)
+                 (not (tramp-get-ls-command-with-dired v)))
         (setq switches (replace-match "" nil t switches)))
       (tramp-message
        v 4 "Inserting directory `ls %s %s', wildcard %s, fulldir %s"
@@ -3693,12 +3692,38 @@ This is like `dired-recursive-delete-directory' for Tramp files."
                    (tramp-shell-quote-argument
                     (tramp-run-real-handler
                      'file-name-nondirectory (list localname)))))))
-      ;; We cannot use `insert-buffer-substring' because the Tramp buffer
-      ;; changes its contents before insertion due to calling
-      ;; `expand-file' and alike.
-      (insert
-       (with-current-buffer (tramp-get-buffer v)
-         (buffer-string))))))
+      (let ((beg (point)))
+        ;; We cannot use `insert-buffer-substring' because the Tramp
+        ;; buffer changes its contents before insertion due to calling
+        ;; `expand-file' and alike.
+        (insert
+         (with-current-buffer (tramp-get-buffer v)
+           (buffer-string)))
+
+        ;; Check for "--dired" output.
+        (goto-char (point-max))
+        (forward-line -2)
+        (when (looking-at "//DIRED//")
+          (let ((end (line-end-position))
+                (linebeg (point)))
+            ;; Now read the numeric positions of file names.
+            (goto-char linebeg)
+            (forward-word 1)
+            (forward-char 3)
+            (while (< (point) end)
+              (let ((start (+ beg (read (current-buffer))))
+                    (end (+ beg (read (current-buffer)))))
+                (if (memq (char-after end) '(?\n ?\s))
+                    ;; End is followed by \n or by " -> ".
+                    (put-text-property start end 'dired-filename t)))))
+          ;; Reove training lines.
+          (goto-char (point-max))
+          (forward-line -1)
+          (while (looking-at "//")
+            (forward-line 1)
+            (delete-region (match-beginning 0) (point))
+            (forward-line -1))))
+      (goto-char (point-max)))))
 
 (defun tramp-handle-unhandled-file-name-directory (filename)
   "Like `unhandled-file-name-directory' for Tramp files."
@@ -7359,6 +7384,13 @@ necessary only.  This function will be used in file name completion."
                (setq dl (cdr dl))))))
        (tramp-error vec 'file-error "Couldn't find a proper `ls' command")))))
 
+(defun tramp-get-ls-command-with-dired (vec)
+  (save-match-data
+    (with-connection-property vec "ls-dired"
+      (tramp-message vec 5 "Checking, whether `ls --dired' works")
+      (zerop (tramp-send-command-and-check
+              vec (format "%s --diredd /" (tramp-get-ls-command vec)))))))
+
 (defun tramp-get-test-command (vec)
   (with-connection-property vec "test"
     (with-current-buffer (tramp-get-buffer vec)
@@ -7814,7 +7846,6 @@ Only works for Bourne-like shells."
 ;;   within Tramp around one of its calls to accept-process-output (or
 ;;   around one of the loops that calls accept-process-output)
 ;;   (Stefan Monnier).
-;; * Autodetect if remote `ls' groks the "--dired" switch.
 ;; * Rewrite `tramp-shell-quote-argument' to abstain from using
 ;;   `shell-quote-argument'.
 ;; * In Emacs 21, `insert-directory' shows total number of bytes used
@@ -7831,7 +7862,7 @@ Only works for Bourne-like shells."
 ;; * Grok `append' parameter for `write-region'.
 ;; * Test remote ksh or bash for tilde expansion in `tramp-find-shell'?
 ;; * abbreviate-file-name
-;; * better error checking.  At least whenever we see something
+;; * Better error checking.  At least whenever we see something
 ;;   strange when doing zerop, we should kill the process and start
 ;;   again.  (Greg Stark)
 ;; * Provide a local cache of old versions of remote files for the rsync