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

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

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index b95de0d804b40874edae6cdf6261b8d19d003e33..85242eacf7b43be4a7da7d76c3aabba2eb6b963c 100644 (file)
--- 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 4ccf2ab6e58e68792f0c30485a47f7038a1c18f0..94b4858a074461c5f1102a585cc8002628861e51 100644 (file)
--- 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