# HG changeset patch # User Stefan Monnier # Date 1128114296 0 # Node ID 77dd61f8bf5139a504155e7f9167a951a5606dc1 # Parent eef36feee76a591fa22e1c487bcc7e6987e27220 (ange-ftp-gwp-start): Use with-current-buffer. (ange-ftp-file-directory-p): Fix the symlink case. (ange-ftp-insert-directory): When listing a single file, get a list of the parent buffer and extract the relevant line. Inspired from a patch by Katsumi Yamaoka . (ange-ftp-file-name-sans-versions): Simplify. diff -r eef36feee76a -r 77dd61f8bf51 lisp/net/ange-ftp.el --- a/lisp/net/ange-ftp.el Fri Sep 30 19:48:12 2005 +0000 +++ b/lisp/net/ange-ftp.el Fri Sep 30 21:04:56 2005 +0000 @@ -1298,6 +1298,8 @@ (setq file (if (file-name-absolute-p temp) temp + ;; Wouldn't `expand-file-name' be better than `concat' ? + ;; It would fail when `a/b/..' != `a', tho. --Stef (concat (file-name-directory file) temp))))) file) @@ -1800,8 +1802,7 @@ (set-process-query-on-exit-flag proc nil) (set-process-sentinel proc 'ange-ftp-gwp-sentinel) (set-process-filter proc 'ange-ftp-gwp-filter) - (save-excursion - (set-buffer (process-buffer proc)) + (with-current-buffer (process-buffer proc) (goto-char (point-max)) (set-marker (process-mark proc) (point))) (setq ange-ftp-gwp-running t @@ -2324,14 +2325,14 @@ ;; This works around a misfeature of some versions of netbsd ftpd ;; where `ls' can only take one argument: either one set of flags ;; or a file/directory name. - ;; FIXME: if we're trying to `ls' a single file, this fails since we + ;; If we're trying to `ls' a single file, this fails since we ;; can't cd to a file. We can't fix this problem here, tho, because ;; at this point we don't know whether the argument is a file or - ;; a directory. Such an `ls' is only every used (apparently) from + ;; a directory. Such an `ls' is only ever used (apparently) from ;; `insert-directory' when the `full-directory-p' argument is nil ;; (which seems to only be used by dired when updating its display - ;; after operating on a set of files). We should change - ;; ange-ftp-insert-directory so that this case is handled by getting + ;; after operating on a set of files). So we've changed + ;; `ange-ftp-insert-directory' such that in this case it gets ;; a full listing of the directory and extracting the line ;; corresponding to the requested file. (unless (equal cmd1 ".") @@ -3174,7 +3175,7 @@ (ange-ftp-real-file-name-directory n)))))) (defun ange-ftp-expand-file-name (name &optional default) - "Documented as original." + "Documented as `expand-file-name'." (save-match-data (setq default (or default default-directory)) (cond ((eq (string-to-char name) ?~) @@ -3448,7 +3449,9 @@ (let ((file-ent (ange-ftp-get-file-entry (ange-ftp-file-name-as-directory name)))) (if (stringp file-ent) - (file-directory-p + ;; Calling file-directory-p doesn't work because ange-ftp + ;; is temporarily disabled for this operation. + (ange-ftp-file-directory-p (ange-ftp-expand-symlink file-ent (file-name-directory (directory-file-name name)))) @@ -4476,21 +4479,41 @@ ;; `ange-ftp-ls' handles this. (defun ange-ftp-insert-directory (file switches &optional wildcard full) - (let ((parsed (ange-ftp-ftp-name (expand-file-name file))) - tem) - (if parsed - (if (and (not wildcard) - (setq tem (file-symlink-p (directory-file-name file)))) - (ange-ftp-insert-directory - (ange-ftp-expand-symlink - tem (file-name-directory (directory-file-name file))) - switches wildcard full) - (insert - (if wildcard - (let ((default-directory (file-name-directory file))) - (ange-ftp-ls (file-name-nondirectory file) switches nil nil t)) - (ange-ftp-ls file switches full)))) - (ange-ftp-real-insert-directory file switches wildcard full)))) + (if (not (ange-ftp-ftp-name (expand-file-name file))) + (ange-ftp-real-insert-directory file switches wildcard full) + ;; Follow symlinks. + (let (tem) + (while (and (not wildcard) + (stringp (setq tem (ange-ftp-get-file-entry + (directory-file-name file))))) + (setq file + (ange-ftp-expand-symlink + tem (file-name-directory (directory-file-name file)))))) + (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)))) + (let* ((dirlist (ange-ftp-ls (or (file-name-directory file) ".") + switches nil)) + (case-fold-search nil)) + ;; FIXME: This presumes a particular output format, which is + ;; basically Unix. + (if (string-match (concat "^.+[^ ] " (regexp-quote file) + "\\( -> .*\\)?[@/*=]?\n") dirlist) + (match-string 0 dirlist) + ""))))))) (defun ange-ftp-dired-uncache (dir) (if (ange-ftp-ftp-name (expand-file-name dir)) @@ -4502,10 +4525,8 @@ (defun ange-ftp-file-name-sans-versions (file keep-backup-version) (let* ((short (ange-ftp-abbreviate-filename file)) (parsed (ange-ftp-ftp-name short)) - func) - (if parsed - (setq func (cdr (assq (ange-ftp-host-type (car parsed)) - ange-ftp-sans-version-alist)))) + (func (if parsed (cdr (assq (ange-ftp-host-type (car parsed)) + ange-ftp-sans-version-alist))))) (if func (funcall func file keep-backup-version) (ange-ftp-real-file-name-sans-versions file keep-backup-version))))