[Emacs-diffs] /srv/bzr/emacs/trunk r99496: * files.el (insert-directory): When WILDCARD-REGEXP and

[Michael Albinus]

------------------------------------------------------------
revno: 99496
committer: Michael Albinus <address@hidden>
branch nick: trunk
timestamp: Sun 2010-02-14 10:23:52 +0100
message:
  * 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)
modified:
  lisp/ChangeLog
  lisp/files.el
  lisp/net/ange-ftp.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2010-02-14 00:20:31 +0000
+++ b/lisp/ChangeLog    2010-02-14 09:23:52 +0000
@@ -1,3 +1,12 @@
+2010-02-14  Michael Albinus  <address@hidden>
+
+       * 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  <address@hidden>
 
        * man.el (Man-fontify-manpage, Man-cleanup-manpage):

=== modified file 'lisp/files.el'
--- a/lisp/files.el     2010-01-27 03:36:36 +0000
+++ b/lisp/files.el     2010-02-14 09:23:52 +0000
@@ -5699,6 +5699,11 @@
                                 (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

=== modified file 'lisp/net/ange-ftp.el'
--- a/lisp/net/ange-ftp.el      2010-02-05 11:15:28 +0000
+++ b/lisp/net/ange-ftp.el      2010-02-14 09:23:52 +0000
@@ -4517,44 +4517,54 @@
     ;; 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))