changeset 104216:bf65b05e8cf1

* net/tramp.el (tramp-get-ls-command-with-dired): New defun. (tramp-handle-insert-directory): Handle "--dired". (Bug#4075)

--- a/lisp/net/tramp.el	Sun Aug 09 02:57:45 2009 +0000
+++ b/lisp/net/tramp.el	Sun Aug 09 14:27:45 2009 +0000
@@ -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 @@
 	     (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 @@
 		   (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 @@
 	       (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 @@
 ;;   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 @@
 ;; * 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