# HG changeset patch # User Michael Albinus # Date 1249828065 0 # Node ID bf65b05e8cf15f15db7df0dc21fc2cf4234cc0c8 # Parent eec5a3966960025edbaf53481a50f93471e4a4f4 * net/tramp.el (tramp-get-ls-command-with-dired): New defun. (tramp-handle-insert-directory): Handle "--dired". (Bug#4075) diff -r eec5a3966960 -r bf65b05e8cf1 lisp/net/tramp.el --- 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