[Emacs-diffs] emacs/lisp/net tramp.el

[Michael Albinus]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Michael Albinus <albinus>       09/08/09 14:27:46

Modified files:
        lisp/net       : tramp.el 

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

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/net/tramp.el?cvsroot=emacs&r1=1.248&r2=1.249

Patches:
Index: tramp.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/net/tramp.el,v
retrieving revision 1.248
retrieving revision 1.249
diff -u -b -r1.248 -r1.249
--- tramp.el    4 Aug 2009 03:31:51 -0000       1.248
+++ tramp.el    9 Aug 2009 14:27:45 -0000       1.249
@@ -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
+      (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))))))
+          (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