diff options
| author | Michael Albinus | 2010-02-14 10:23:52 +0100 |
|---|---|---|
| committer | Michael Albinus | 2010-02-14 10:23:52 +0100 |
| commit | ecbaeb7bf5fd06f67347240a19b054a7a3698708 (patch) | |
| tree | f88b19ffe803ed292963f3aebbef40a8d6444c02 | |
| parent | 91e3333fc5d5a23ee763a5f0a3440c27eb62a6f1 (diff) | |
| download | emacs-ecbaeb7bf5fd06f67347240a19b054a7a3698708.tar.gz emacs-ecbaeb7bf5fd06f67347240a19b054a7a3698708.zip | |
* 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)
| -rw-r--r-- | lisp/ChangeLog | 9 | ||||
| -rw-r--r-- | lisp/files.el | 5 | ||||
| -rw-r--r-- | 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 @@ | |||
| 1 | 2010-02-14 Michael Albinus <michael.albinus@gmx.de> | ||
| 2 | |||
| 3 | * files.el (insert-directory): When WILDCARD-REGEXP and | ||
| 4 | FULL-DIRECTORY-P are nil, insert the file entry instead of the | ||
| 5 | whole directory. (Bug#5551) | ||
| 6 | |||
| 7 | * net/ange-ftp.el (ange-ftp-insert-directory): Insert " " for | ||
| 8 | dired's alignment sanity. (Bug#5516) | ||
| 9 | |||
| 1 | 2010-02-14 Juri Linkov <juri@jurta.org> | 10 | 2010-02-14 Juri Linkov <juri@jurta.org> |
| 2 | 11 | ||
| 3 | * man.el (Man-fontify-manpage, Man-cleanup-manpage): | 12 | * 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 | |||
| 5699 | (shell-quote-wildcard-pattern pattern)))) | 5699 | (shell-quote-wildcard-pattern pattern)))) |
| 5700 | ;; SunOS 4.1.3, SVr4 and others need the "." to list the | 5700 | ;; SunOS 4.1.3, SVr4 and others need the "." to list the |
| 5701 | ;; directory if FILE is a symbolic link. | 5701 | ;; directory if FILE is a symbolic link. |
| 5702 | (unless full-directory-p | ||
| 5703 | (setq switches | ||
| 5704 | (if (stringp switches) | ||
| 5705 | (concat switches " -d") | ||
| 5706 | (add-to-list 'switches "-d" 'append)))) | ||
| 5702 | (apply 'call-process | 5707 | (apply 'call-process |
| 5703 | insert-directory-program nil t nil | 5708 | insert-directory-program nil t nil |
| 5704 | (append | 5709 | (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.") | |||
| 4517 | ;; because some FTP servers react to "ls foo" by listing the symlink foo | 4517 | ;; because some FTP servers react to "ls foo" by listing the symlink foo |
| 4518 | ;; rather than the directory it points to. Now that ange-ftp-ls uses | 4518 | ;; rather than the directory it points to. Now that ange-ftp-ls uses |
| 4519 | ;; "cd foo; ls" instead, this is not necesssary any more. | 4519 | ;; "cd foo; ls" instead, this is not necesssary any more. |
| 4520 | (insert | 4520 | (let ((beg (point)) |
| 4521 | (cond | 4521 | (end (point-marker))) |
| 4522 | (wildcard | 4522 | (set-marker-insertion-type end t) |
| 4523 | (let ((default-directory (file-name-directory file))) | 4523 | (insert |
| 4524 | (ange-ftp-ls (file-name-nondirectory file) switches nil nil t))) | 4524 | (cond |
| 4525 | (full | 4525 | (wildcard |
| 4526 | (ange-ftp-ls file switches 'parse)) | 4526 | (let ((default-directory (file-name-directory file))) |
| 4527 | (t | 4527 | (ange-ftp-ls (file-name-nondirectory file) switches nil nil t))) |
| 4528 | ;; If `full' is nil we're going to do `ls' for a single file. | 4528 | (full |
| 4529 | ;; Problem is that for various reasons, ange-ftp-ls needs to cd and | 4529 | (ange-ftp-ls file switches 'parse)) |
| 4530 | ;; then do an ls of current dir, which obviously won't work if we | 4530 | (t |
| 4531 | ;; want to ls a file. So instead, we get a full listing of the | 4531 | ;; If `full' is nil we're going to do `ls' for a single file. |
| 4532 | ;; parent directory and extract the line corresponding to `file'. | 4532 | ;; Problem is that for various reasons, ange-ftp-ls needs to cd and |
| 4533 | (when (string-match "-?d\\'" switches) | 4533 | ;; then do an ls of current dir, which obviously won't work if we |
| 4534 | ;; Remove "d" which dired added to `switches'. | 4534 | ;; want to ls a file. So instead, we get a full listing of the |
| 4535 | (setq switches (substring switches 0 (match-beginning 0)))) | 4535 | ;; parent directory and extract the line corresponding to `file'. |
| 4536 | (setq file (directory-file-name file)) | 4536 | (when (string-match "-?d\\'" switches) |
| 4537 | (let* ((dirlist (ange-ftp-ls (or (file-name-directory file) ".") | 4537 | ;; Remove "d" which dired added to `switches'. |
| 4538 | switches 'parse)) | 4538 | (setq switches (substring switches 0 (match-beginning 0)))) |
| 4539 | (filename (file-name-nondirectory file)) | 4539 | (setq file (directory-file-name file)) |
| 4540 | (case-fold-search nil)) | 4540 | (let* ((dirlist (ange-ftp-ls (or (file-name-directory file) ".") |
| 4541 | ;; FIXME: This presumes a particular output format, which is | 4541 | switches 'parse)) |
| 4542 | ;; basically Unix. | 4542 | (filename (file-name-nondirectory file)) |
| 4543 | (if (string-match (concat "^.+[^ ] " (regexp-quote filename) | 4543 | (case-fold-search nil)) |
| 4544 | "\\( -> .*\\)?[@/*=]?\n") dirlist) | 4544 | ;; FIXME: This presumes a particular output format, which is |
| 4545 | (match-string 0 dirlist) | 4545 | ;; basically Unix. |
| 4546 | ""))))) | 4546 | (if (string-match (concat "^.+[^ ] " (regexp-quote filename) |
| 4547 | 4547 | "\\( -> .*\\)?[@/*=]?\n") dirlist) | |
| 4548 | ;; The inserted file could be from somewhere else. | 4548 | (match-string 0 dirlist) |
| 4549 | (when (and (not wildcard) (not full) | 4549 | ""))))) |
| 4550 | (search-backward | 4550 | |
| 4551 | (if (zerop (length (file-name-nondirectory | 4551 | ;; Insert " " for dired's alignment sanity. |
| 4552 | (expand-file-name file)))) | 4552 | (goto-char beg) |
| 4553 | "." | 4553 | (while (re-search-forward "^\\(\\S-\\)" end 'move) |
| 4554 | (file-name-nondirectory file)) | 4554 | (replace-match " \\1")) |
| 4555 | nil 'noerror)) | 4555 | |
| 4556 | (replace-match (file-relative-name (expand-file-name file)) t) | 4556 | ;; The inserted file could be from somewhere else. |
| 4557 | (goto-char (point-max))))) | 4557 | (when (and (not wildcard) (not full) |
| 4558 | (search-backward | ||
| 4559 | (if (zerop (length (file-name-nondirectory | ||
| 4560 | (expand-file-name file)))) | ||
| 4561 | "." | ||
| 4562 | (file-name-nondirectory file)) | ||
| 4563 | nil 'noerror)) | ||
| 4564 | (replace-match (file-relative-name (expand-file-name file)) t) | ||
| 4565 | (goto-char end)) | ||
| 4566 | |||
| 4567 | (set-marker end nil)))) | ||
| 4558 | 4568 | ||
| 4559 | (defun ange-ftp-dired-uncache (dir) | 4569 | (defun ange-ftp-dired-uncache (dir) |
| 4560 | (if (ange-ftp-ftp-name (expand-file-name dir)) | 4570 | (if (ange-ftp-ftp-name (expand-file-name dir)) |