From: Michael Albinus <michael.albinus@gmx.de>
Date: Sun, 9 Aug 2009 14:29:11 +0000 (+0000)
Subject: * net/tramp.el (tramp-get-ls-command-with-dired): New defun.
X-Git-Tag: emacs-pretest-23.1.90~1905
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=8e754ea218196646ce0d331ac5c2d8b1970a66da;p=emacs.git

* 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 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