From ecbaeb7bf5fd06f67347240a19b054a7a3698708 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 14 Feb 2010 10:23:52 +0100 Subject: [PATCH] * files.el (insert-directory): When WILDCARD-REGEXP and FULL-DIRECTORY-P are nil, insert the file entry instead of the whole directory. (Bug#5551) * net/ange-ftp.el (ange-ftp-insert-directory): Insert " " for dired's alignment sanity. (Bug#5516) --- lisp/ChangeLog | 9 +++++ lisp/files.el | 5 +++ lisp/net/ange-ftp.el | 86 ++++++++++++++++++++++++-------------------- 3 files changed, 62 insertions(+), 38 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 9590f800640..2d18bbbaf9e 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,12 @@ +2010-02-14 Michael Albinus + + * files.el (insert-directory): When WILDCARD-REGEXP and + FULL-DIRECTORY-P are nil, insert the file entry instead of the + whole directory. (Bug#5551) + + * net/ange-ftp.el (ange-ftp-insert-directory): Insert " " for + dired's alignment sanity. (Bug#5516) + 2010-02-14 Juri Linkov * man.el (Man-fontify-manpage, Man-cleanup-manpage): diff --git a/lisp/files.el b/lisp/files.el index d372ff3420a..41cddcd4f62 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5699,6 +5699,11 @@ normally equivalent short `-D' option is just passed on to (shell-quote-wildcard-pattern pattern)))) ;; SunOS 4.1.3, SVr4 and others need the "." to list the ;; directory if FILE is a symbolic link. + (unless full-directory-p + (setq switches + (if (stringp switches) + (concat switches " -d") + (add-to-list 'switches "-d" 'append)))) (apply 'call-process insert-directory-program nil t nil (append diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index 97a334a50ff..6e468386749 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -4517,44 +4517,54 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") ;; because some FTP servers react to "ls foo" by listing the symlink foo ;; rather than the directory it points to. Now that ange-ftp-ls uses ;; "cd foo; ls" instead, this is not necesssary any more. - (insert - (cond - (wildcard - (let ((default-directory (file-name-directory file))) - (ange-ftp-ls (file-name-nondirectory file) switches nil nil t))) - (full - (ange-ftp-ls file switches 'parse)) - (t - ;; If `full' is nil we're going to do `ls' for a single file. - ;; Problem is that for various reasons, ange-ftp-ls needs to cd and - ;; then do an ls of current dir, which obviously won't work if we - ;; want to ls a file. So instead, we get a full listing of the - ;; parent directory and extract the line corresponding to `file'. - (when (string-match "-?d\\'" switches) - ;; Remove "d" which dired added to `switches'. - (setq switches (substring switches 0 (match-beginning 0)))) - (setq file (directory-file-name file)) - (let* ((dirlist (ange-ftp-ls (or (file-name-directory file) ".") - switches 'parse)) - (filename (file-name-nondirectory file)) - (case-fold-search nil)) - ;; FIXME: This presumes a particular output format, which is - ;; basically Unix. - (if (string-match (concat "^.+[^ ] " (regexp-quote filename) - "\\( -> .*\\)?[@/*=]?\n") dirlist) - (match-string 0 dirlist) - ""))))) - - ;; The inserted file could be from somewhere else. - (when (and (not wildcard) (not full) - (search-backward - (if (zerop (length (file-name-nondirectory - (expand-file-name file)))) - "." - (file-name-nondirectory file)) - nil 'noerror)) - (replace-match (file-relative-name (expand-file-name file)) t) - (goto-char (point-max))))) + (let ((beg (point)) + (end (point-marker))) + (set-marker-insertion-type end t) + (insert + (cond + (wildcard + (let ((default-directory (file-name-directory file))) + (ange-ftp-ls (file-name-nondirectory file) switches nil nil t))) + (full + (ange-ftp-ls file switches 'parse)) + (t + ;; If `full' is nil we're going to do `ls' for a single file. + ;; Problem is that for various reasons, ange-ftp-ls needs to cd and + ;; then do an ls of current dir, which obviously won't work if we + ;; want to ls a file. So instead, we get a full listing of the + ;; parent directory and extract the line corresponding to `file'. + (when (string-match "-?d\\'" switches) + ;; Remove "d" which dired added to `switches'. + (setq switches (substring switches 0 (match-beginning 0)))) + (setq file (directory-file-name file)) + (let* ((dirlist (ange-ftp-ls (or (file-name-directory file) ".") + switches 'parse)) + (filename (file-name-nondirectory file)) + (case-fold-search nil)) + ;; FIXME: This presumes a particular output format, which is + ;; basically Unix. + (if (string-match (concat "^.+[^ ] " (regexp-quote filename) + "\\( -> .*\\)?[@/*=]?\n") dirlist) + (match-string 0 dirlist) + ""))))) + + ;; Insert " " for dired's alignment sanity. + (goto-char beg) + (while (re-search-forward "^\\(\\S-\\)" end 'move) + (replace-match " \\1")) + + ;; The inserted file could be from somewhere else. + (when (and (not wildcard) (not full) + (search-backward + (if (zerop (length (file-name-nondirectory + (expand-file-name file)))) + "." + (file-name-nondirectory file)) + nil 'noerror)) + (replace-match (file-relative-name (expand-file-name file)) t) + (goto-char end)) + + (set-marker end nil)))) (defun ange-ftp-dired-uncache (dir) (if (ange-ftp-ftp-name (expand-file-name dir)) -- 2.39.5