Merge from emacs--devo--0
[bpt/emacs.git] / lisp / net / ange-ftp.el
index 5d205f5..3fa7510 100644 (file)
@@ -1,7 +1,7 @@
 ;;; ange-ftp.el --- transparent FTP support for GNU Emacs
 
 ;; Copyright (C) 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1998,
-;;   2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
+;;   2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
 
 ;; Author: Andy Norman (ange@hplb.hpl.hp.com)
 ;; Maintainer: FSF
@@ -1005,7 +1005,7 @@ Don't use any other value."
                 (const :tag "Allow" 1)))
 
 (defcustom ange-ftp-try-passive-mode nil
-  "It t, try to use passive mode in ftp, if the client program supports it."
+  "If t, try to use passive mode in ftp, if the client program supports it."
   :group 'ange-ftp
   :type 'boolean
   :version "21.1")
@@ -1298,6 +1298,8 @@ only return the directory part of FILE."
       (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)
 
@@ -1385,12 +1387,12 @@ only return the directory part of FILE."
          (if (or ange-ftp-disable-netrc-security-check
                  (and (eq (nth 2 attr) (user-uid)) ; Same uids.
                       (string-match ".r..------" (nth 8 attr))))
-             (save-excursion
+             (with-current-buffer
                ;; we are cheating a bit here.  I'm trying to do the equivalent
                ;; of find-file on the .netrc file, but then nuke it afterwards.
                ;; with the bit of logic below we should be able to have
                ;; encrypted .netrc files.
-               (set-buffer (generate-new-buffer "*ftp-.netrc*"))
+                  (generate-new-buffer "*ftp-.netrc*")
                (ange-ftp-real-insert-file-contents file)
                (setq buffer-file-name file)
                (setq default-directory (file-name-directory file))
@@ -1511,7 +1513,7 @@ then kill the related ftp process."
       (setq buffer (current-buffer))
     (setq buffer (get-buffer buffer)))
   (let ((file (or (buffer-file-name buffer)
-                 (save-excursion (set-buffer buffer) default-directory))))
+                 (with-current-buffer buffer default-directory))))
     (if file
        (let ((parsed (ange-ftp-ftp-name (expand-file-name file))))
          (if parsed
@@ -1592,8 +1594,7 @@ good, skip, fatal, or unknown."
     (if proc
        (let ((buf (process-buffer proc)))
          (if buf
-             (save-excursion
-               (set-buffer buf)
+             (with-current-buffer buf
                (setq ange-ftp-xfer-size
                      ;; For very large files, BYTES can be a float.
                      (if (integerp bytes)
@@ -1641,81 +1642,75 @@ good, skip, fatal, or unknown."
 ;; on to ange-ftp-process-handle-line to deal with.
 
 (defun ange-ftp-process-filter (proc str)
-  (let ((buffer (process-buffer proc))
-       (old-buffer (current-buffer)))
-
-    ;; Eliminate nulls.
-    (while (string-match "\000+" str)
-      (setq str (replace-match "" nil nil str)))
-
-    ;; see if the buffer is still around... it could have been deleted.
-    (if (buffer-name buffer)
-       (unwind-protect
-           (progn
-             (set-buffer (process-buffer proc))
-
-             ;; handle hash mark printing
-             (and ange-ftp-process-busy
-                  (string-match "\\`#+\\'" str)
-                  (setq str (ange-ftp-process-handle-hash str)))
-             (comint-output-filter proc str)
-             ;; Replace STR by the result of the comint processing.
-             (setq str (buffer-substring comint-last-output-start
-                                         (process-mark proc)))
-             (if ange-ftp-process-busy
-                 (progn
-                   (setq ange-ftp-process-string (concat ange-ftp-process-string
-                                                         str))
-
-                   ;; if we gave an empty password to the USER command earlier
-                   ;; then we should send a null password now.
-                   (if (string-match "Password: *$" ange-ftp-process-string)
-                       (process-send-string proc "\n"))))
-             (while (and ange-ftp-process-busy
-                         (string-match "\n" ange-ftp-process-string))
-               (let ((line (substring ange-ftp-process-string
-                                      0
-                                      (match-beginning 0)))
-                      (seen-prompt nil))
-                 (setq ange-ftp-process-string (substring ange-ftp-process-string
-                                                          (match-end 0)))
-                 (while (string-match "\\`ftp> *" line)
-                    (setq seen-prompt t)
-                   (setq line (substring line (match-end 0))))
-                  (if (not (and seen-prompt ange-ftp-pending-error-line))
-                      (ange-ftp-process-handle-line line proc)
-                    ;; If we've seen a potential error message and it
-                    ;; hasn't been cancelled by a good message before
-                    ;; seeing a propt, then the error was real.
-                    (delete-process proc)
-                    (setq ange-ftp-process-busy nil
-                          ange-ftp-process-result-line ange-ftp-pending-error-line))))
-
-             ;; has the ftp client finished?  if so then do some clean-up
-             ;; actions.
-             (if (not ange-ftp-process-busy)
-                 (progn
-                   ;; reset the xfer size
-                   (setq ange-ftp-xfer-size 0)
-
-                   ;; issue the "done" message since we've finished.
-                   (if (and ange-ftp-process-msg
-                            ange-ftp-process-verbose
-                            ange-ftp-process-result)
-                       (progn
-                         (ange-ftp-message "%s...done" ange-ftp-process-msg)
-                         (ange-ftp-repaint-minibuffer)
-                         (setq ange-ftp-process-msg nil)))
-
-                   ;; is there a continuation we should be calling?  if so,
-                   ;; we'd better call it, making sure we only call it once.
-                   (if ange-ftp-process-continue
-                       (let ((cont ange-ftp-process-continue))
-                         (setq ange-ftp-process-continue nil)
-                         (ange-ftp-call-cont cont
-                                             ange-ftp-process-result
-                                             ange-ftp-process-result-line))))))
-         (set-buffer old-buffer)))))
+  ;; Eliminate nulls.
+  (while (string-match "\000+" str)
+    (setq str (replace-match "" nil nil str)))
+
+  ;; see if the buffer is still around... it could have been deleted.
+  (when (buffer-live-p (process-buffer proc))
+    (with-current-buffer (process-buffer proc)
+
+      ;; handle hash mark printing
+      (and ange-ftp-process-busy
+           (string-match "^#+$" str)
+           (setq str (ange-ftp-process-handle-hash str)))
+      (comint-output-filter proc str)
+      ;; Replace STR by the result of the comint processing.
+      (setq str (buffer-substring comint-last-output-start
+                                  (process-mark proc)))
+      (if ange-ftp-process-busy
+          (progn
+            (setq ange-ftp-process-string (concat ange-ftp-process-string
+                                                  str))
+
+            ;; if we gave an empty password to the USER command earlier
+            ;; then we should send a null password now.
+            (if (string-match "Password: *$" ange-ftp-process-string)
+                (process-send-string proc "\n"))))
+      (while (and ange-ftp-process-busy
+                  (string-match "\n" ange-ftp-process-string))
+        (let ((line (substring ange-ftp-process-string
+                               0
+                               (match-beginning 0)))
+              (seen-prompt nil))
+          (setq ange-ftp-process-string (substring ange-ftp-process-string
+                                                   (match-end 0)))
+          (while (string-match "\\`ftp> *" line)
+            (setq seen-prompt t)
+            (setq line (substring line (match-end 0))))
+          (if (not (and seen-prompt ange-ftp-pending-error-line))
+              (ange-ftp-process-handle-line line proc)
+            ;; If we've seen a potential error message and it
+            ;; hasn't been cancelled by a good message before
+            ;; seeing a propt, then the error was real.
+            (delete-process proc)
+            (setq ange-ftp-process-busy nil
+                  ange-ftp-process-result-line ange-ftp-pending-error-line))))
+
+      ;; has the ftp client finished?  if so then do some clean-up
+      ;; actions.
+      (if (not ange-ftp-process-busy)
+          (progn
+            ;; reset the xfer size
+            (setq ange-ftp-xfer-size 0)
+
+            ;; issue the "done" message since we've finished.
+            (if (and ange-ftp-process-msg
+                     ange-ftp-process-verbose
+                     ange-ftp-process-result)
+                (progn
+                  (ange-ftp-message "%s...done" ange-ftp-process-msg)
+                  (ange-ftp-repaint-minibuffer)
+                  (setq ange-ftp-process-msg nil)))
+
+            ;; is there a continuation we should be calling?  if so,
+            ;; we'd better call it, making sure we only call it once.
+            (if ange-ftp-process-continue
+                (let ((cont ange-ftp-process-continue))
+                  (setq ange-ftp-process-continue nil)
+                  (ange-ftp-call-cont cont
+                                      ange-ftp-process-result
+                                      ange-ftp-process-result-line))))))))
 
 (defun ange-ftp-process-sentinel (proc str)
   "When ftp process changes state, nuke all file-entries in cache."
@@ -1769,8 +1764,7 @@ good, skip, fatal, or unknown."
 
 (defun ange-ftp-gwp-filter (proc str)
   (comint-output-filter proc str)
-  (save-excursion
-    (set-buffer (process-buffer proc))
+  (with-current-buffer (process-buffer proc)
     ;; Replace STR by the result of the comint processing.
     (setq str (buffer-substring comint-last-output-start (process-mark proc))))
   (cond ((string-match "login: *$" str)
@@ -1795,8 +1789,7 @@ good, skip, fatal, or unknown."
 
 (defun ange-ftp-gwp-start (host user name args)
   "Login to the gateway machine and fire up an ftp process."
-  (let* ((gw-user (ange-ftp-get-user ange-ftp-gateway-host))
-        ;; It would be nice to make process-connection-type nil,
+  (let* (;; It would be nice to make process-connection-type nil,
         ;; but that doesn't work: ftp never responds.
         ;; Can anyone find a fix for that?
         (proc (let ((process-connection-type t))
@@ -1807,8 +1800,7 @@ good, skip, fatal, or unknown."
     (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
@@ -1914,8 +1906,7 @@ been queued with no result.  CONT will still be called, however."
                                   ange-ftp-nslookup-program host)))
            (res host))
        (set-process-query-on-exit-flag proc nil)
-       (save-excursion
-         (set-buffer (process-buffer proc))
+       (with-current-buffer (process-buffer proc)
          (while (memq (process-status proc) '(run open))
            (accept-process-output proc))
          (goto-char (point-min))
@@ -1954,8 +1945,7 @@ on the gateway machine to do the ftp instead."
          ;; Copy this so we don't alter it permanently.
          (process-environment (copy-tree process-environment))
          (buffer (get-buffer-create name)))
-      (save-excursion
-       (set-buffer buffer)
+      (with-current-buffer buffer
        (internal-ange-ftp-mode))
       ;; This tells GNU ftp not to output any fancy escape sequences.
       (setenv "TERM" "dumb")
@@ -1967,8 +1957,7 @@ on the gateway machine to do the ftp instead."
                                            ange-ftp-gateway-host)
                                      args))))
        (setq proc (apply 'start-process name name args))))
-    (save-excursion
-      (set-buffer (process-buffer proc))
+    (with-current-buffer (process-buffer proc)
       (goto-char (point-max))
       (set-marker (process-mark proc) (point)))
     (set-process-query-on-exit-flag proc nil)
@@ -2134,10 +2123,8 @@ suffix of the form #PORT to specify a non-default port"
 
 (defun ange-ftp-guess-hash-mark-size (proc)
   (if ange-ftp-send-hash
-      (save-excursion
-       (set-buffer (process-buffer proc))
+      (with-current-buffer (process-buffer proc)
        (let* ((status (ange-ftp-raw-send-cmd proc "hash"))
-              (result (car status))
               (line (cdr status)))
          (save-match-data
            (if (string-match ange-ftp-hash-mark-msgs line)
@@ -2316,6 +2303,14 @@ and NOWAIT."
           (not (string-match "R" cmd3))
           (setq cmd1 (concat cmd1 ".")))
 
+      ;; Using "ls -flags foo" has several problems:
+      ;; - if foo is a symlink, we may get a single line showing the symlink
+      ;;   rather than the listing of the directory it points to.
+      ;; - if "foo" has spaces, the parsing of the command may be done wrong.
+      ;; - some version of netbsd's ftpd only accept a single argument after
+      ;;   `ls', which can either be the directory or the flags.
+      ;; So to work around those problems, we use "cd foo; ls -flags".
+
       ;; If the dir name contains a space, some ftp servers will
       ;; refuse to list it.  We instead change directory to the
       ;; directory in question and ls ".".
@@ -2332,14 +2327,14 @@ and NOWAIT."
        ;; 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 ".")
@@ -2604,7 +2599,7 @@ away in the internal cache."
            (if wildcard
                (progn
                  (ange-ftp-cd host user (file-name-directory name))
-                 (setq lscmd (list 'dir file temp lsargs)))
+                 (setq lscmd (list 'ls file temp lsargs)))
              (setq lscmd (list 'dir name temp lsargs)))
            (unwind-protect
                (if (car (setq result (ange-ftp-send-cmd
@@ -2614,9 +2609,8 @@ away in the internal cache."
                                       (format "Listing %s"
                                               (ange-ftp-abbreviate-filename
                                                ange-ftp-this-file)))))
-                   (save-excursion
-                     (set-buffer (get-buffer-create
-                                  ange-ftp-data-buffer-name))
+                   (with-current-buffer (get-buffer-create
+                                          ange-ftp-data-buffer-name)
                      (erase-buffer)
                      (if (ange-ftp-real-file-readable-p temp)
                          (ange-ftp-real-insert-file-contents temp)
@@ -2672,31 +2666,6 @@ away in the internal cache."
 ;;;; Directory information caching support.
 ;;;; ------------------------------------------------------------
 
-(defconst ange-ftp-date-regexp
-  (let* ((l "\\([A-Za-z]\\|[^\0-\177]\\)")
-        ;; In some locales, month abbreviations are as short as 2 letters,
-        ;; and they can be padded on the right with spaces.
-        ;; weiand: changed: month ends with . or , or .,
-;;old   (month (concat l l "+ *"))
-        (month (concat l l "+[.]?,? *"))
-        ;; Recognize any non-ASCII character.
-        ;; The purpose is to match a Kanji character.
-        (k "[^\0-\177]")
-        (s " ")
-        (mm "[ 0-1][0-9]")
-        ;; weiand: changed: day ends with .
-;;old   (dd "[ 0-3][0-9]")
-        (dd "[ 0-3][0-9][.]?")
-        (western (concat "\\(" month s dd "\\|" dd s month "\\)"))
-        (japanese (concat mm k s dd k)))
-        ;; Require the previous column to end in a digit.
-        ;; This avoids recognizing `1 may 1997' as a date in the line:
-        ;; -r--r--r--   1 may      1997        1168 Oct 19 16:49 README
-    (concat "[0-9]" s "\\(" western "\\|" japanese "\\)" s))
-  "Regular expression to match up to the column before the file name in a
-directory listing.  This regular expression is designed to recognize dates
-regardless of the language.")
-
 (defvar ange-ftp-add-file-entry-alist nil
   "Alist saying how to add file entries on certain OS types.
 Association list of pairs \( TYPE \. FUNC \), where FUNC
@@ -2731,13 +2700,8 @@ The main reason for this alist is to deal with file versions in VMS.")
   ;;Extract the filename from the current line of a dired-like listing.
   `(let ((eol (progn (end-of-line) (point))))
      (beginning-of-line)
-     (if (re-search-forward ange-ftp-date-regexp eol t)
-         (progn
-           (skip-chars-forward " ")
-           (skip-chars-forward "^ " eol)
-           (skip-chars-forward " " eol)
-           ;; We bomb on filenames starting with a space.
-           (buffer-substring (point) eol)))))
+     (if (re-search-forward directory-listing-before-filename-regexp eol t)
+        (buffer-substring (point) eol))))
 
 ;; This deals with the F switch. Should also do something about
 ;; unquoting names obtained with the SysV b switch and the GNU Q
@@ -2852,7 +2816,7 @@ match subdirectories as well.")
       ;; (3) The twilight zone.
       ;; We'll assume (1) for now.
       nil)
-     ((re-search-forward ange-ftp-date-regexp nil t)
+     ((re-search-forward directory-listing-before-filename-regexp nil t)
       (beginning-of-line)
       (ange-ftp-ls-parser switches))
      ((re-search-forward "^[^ \n\t]+ +\\([0-9]+\\|-\\|=\\) " nil t)
@@ -3030,8 +2994,7 @@ this also returns nil."
   (let ((result (ange-ftp-send-cmd host user '(type "binary"))))
     (if (not (car result))
        (ange-ftp-error host user (concat "BINARY failed: " (cdr result)))
-      (save-excursion
-       (set-buffer (process-buffer (ange-ftp-get-process host user)))
+      (with-current-buffer (process-buffer (ange-ftp-get-process host user))
        (and ange-ftp-binary-hash-mark-size
             (setq ange-ftp-hash-mark-unit
                   (ash ange-ftp-binary-hash-mark-size -4)))))))
@@ -3041,8 +3004,7 @@ this also returns nil."
   (let ((result (ange-ftp-send-cmd host user '(type "ascii"))))
     (if (not (car result))
        (ange-ftp-error host user (concat "ASCII failed: " (cdr result)))
-      (save-excursion
-       (set-buffer (process-buffer (ange-ftp-get-process host user)))
+      (with-current-buffer (process-buffer (ange-ftp-get-process host user))
        (and ange-ftp-ascii-hash-mark-size
             (setq ange-ftp-hash-mark-unit
                   (ash ange-ftp-ascii-hash-mark-size -4)))))))
@@ -3182,7 +3144,7 @@ logged in as user USER and cd'd to directory DIR."
         (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) ?~)
@@ -3297,7 +3259,7 @@ system TYPE.")
                    ;; cleanup forms
                    (setq coding-system-used last-coding-system-used)
                    (setq buffer-file-name filename)
-                   (set-buffer-modified-p mod-p)))
+                   (restore-buffer-modified-p mod-p)))
                (if binary
                    (ange-ftp-set-binary-mode host user))
 
@@ -3456,7 +3418,9 @@ system TYPE.")
       (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))))
@@ -3648,8 +3612,7 @@ Value is (0 0) if the modification time cannot be determined."
 ;;       (set (make-local-variable 'copy-cont) cont))))
 ;;
 ;; (defun ange-ftp-copy-file-locally-sentinel (proc status)
-;;   (save-excursion
-;;     (set-buffer (process-buffer proc))
+;;   (with-current-buffer (process-buffer proc)
 ;;     (let ((cont copy-cont)
 ;;       (result (buffer-string)))
 ;;       (unwind-protect
@@ -4014,7 +3977,7 @@ E.g.,
                                                          ange-ftp-this-dir))
        (ange-ftp-real-file-name-all-completions file ange-ftp-this-dir)))))
 
-(defun ange-ftp-file-name-completion (file dir)
+(defun ange-ftp-file-name-completion (file dir &optional predicate)
   (let ((ange-ftp-this-dir (expand-file-name dir)))
     (if (ange-ftp-ftp-name ange-ftp-this-dir)
        (progn
@@ -4042,8 +4005,13 @@ E.g.,
           file
           (nconc (ange-ftp-generate-root-prefixes)
                  (ange-ftp-real-file-name-all-completions
-                  file ange-ftp-this-dir)))
-       (ange-ftp-real-file-name-completion file ange-ftp-this-dir)))))
+                  file ange-ftp-this-dir))
+          predicate)
+       (if predicate
+           (ange-ftp-real-file-name-completion
+            file ange-ftp-this-dir predicate)
+         (ange-ftp-real-file-name-completion
+          file ange-ftp-this-dir))))))
 
 
 (defun ange-ftp-file-name-completion-1 (file tbl dir &optional predicate)
@@ -4164,8 +4132,15 @@ directory, so that Emacs will know its current contents."
                                       (format "Getting %s" fn1))
          tmp1))))
 
-(defun ange-ftp-file-remote-p (file)
-  (ange-ftp-replace-name-component file ""))
+(defun ange-ftp-file-remote-p (file &optional connected)
+  (and (or (not connected)
+          (let* ((parsed (ange-ftp-ftp-name file))
+                 (host (nth 0 parsed))
+                 (user (nth 1 parsed))
+                 (proc (get-process (ange-ftp-ftp-process-buffer host user))))
+            (and proc (processp proc)
+                 (memq (process-status proc) '(run open)))))
+       (ange-ftp-replace-name-component file "")))
 
 (defun ange-ftp-load (file &optional noerror nomessage nosuffix)
   (if (ange-ftp-ftp-name file)
@@ -4392,7 +4367,10 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
 ;; This returns nil for any file name as argument.
 (put 'vc-registered 'ange-ftp 'null)
 
-(put 'dired-call-process 'ange-ftp 'ange-ftp-dired-call-process)
+;; We can handle process-file in a restricted way (just for chown).
+;; Nothing possible for start-file-process.
+(put 'process-file 'ange-ftp 'ange-ftp-process-file)
+(put 'start-file-process 'ange-ftp 'ignore)
 (put 'shell-command 'ange-ftp 'ange-ftp-shell-command)
 \f
 ;;; Define ways of getting at unmodified Emacs primitives,
@@ -4484,22 +4462,38 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
 ;; `ange-ftp-ls' handles this.
 
 (defun ange-ftp-insert-directory (file switches &optional wildcard full)
-  (let ((short (ange-ftp-abbreviate-filename file))
-       (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)
+    ;; We used to follow symlinks on `file' here.  Apparently it was done
+    ;; 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))))
+       (let* ((dirlist (ange-ftp-ls (or (file-name-directory file) ".")
+                                    switches nil))
+              (filename (file-name-nondirectory (directory-file-name 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)
+           "")))))))
 
 (defun ange-ftp-dired-uncache (dir)
   (if (ange-ftp-ftp-name (expand-file-name dir))
@@ -4511,11 +4505,8 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
 (defun ange-ftp-file-name-sans-versions (file keep-backup-version)
   (let* ((short (ange-ftp-abbreviate-filename file))
         (parsed (ange-ftp-ftp-name short))
-        host-type func)
-    (if parsed
-       (setq host-type (ange-ftp-host-type (car parsed))
-             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))))
 
@@ -4542,8 +4533,8 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
       ;; default-directory is in ange-ftp syntax for remote file names.
       (ange-ftp-real-shell-command command output-buffer error-buffer))))
 
-;;; This is the handler for call-process.
-(defun ange-ftp-dired-call-process (program discard &rest arguments)
+;;; This is the handler for process-file.
+(defun ange-ftp-process-file (program infile buffer display &rest arguments)
   ;; PROGRAM is always one of those below in the cond in dired.el.
   ;; The ARGUMENTS are (nearly) always files.
   (if (ange-ftp-ftp-name default-directory)
@@ -4563,7 +4554,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
                   1)
        (error (insert (format "%s\n" (nth 1 oops)))
               1))
-    (apply 'call-process program nil (not discard) nil arguments)))
+    (apply 'call-process program infile buffer display arguments)))
 
 ;; Handle an attempt to run chmod on a remote file
 ;; by using the ftp chmod command.
@@ -4659,10 +4650,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
 ;;                    target marker-char buffer overwrite-query
 ;;                    overwrite-backup-query failures skipped
 ;;                    success-count total)
-;;  (let ((old-buf (current-buffer)))
-;;    (unwind-protect
-;;     (progn
-;;       (set-buffer buffer)
+;;  (with-current-buffer buffer
 ;;       (if (null fn-list)
 ;;           (ange-ftp-dcf-3 failures operation total skipped
 ;;                           success-count buffer)
@@ -4734,8 +4722,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
 ;;                                  overwrite-query
 ;;                                  overwrite-backup-query
 ;;                                  failures skipped success-count
-;;                                  total))))))))
-;;      (set-buffer old-buf))))
+;;                                  total)))))))))
 
 ;;(defun ange-ftp-dcf-2 (result line err
 ;;                           file-creator operation fn-list
@@ -4749,10 +4736,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
 ;;                           overwrite-backup-query
 ;;                           failures skipped success-count
 ;;                           total)
-;;  (let ((old-buf (current-buffer)))
-;;    (unwind-protect
-;;     (progn
-;;       (set-buffer buffer)
+;;  (with-current-buffer buffer
 ;;       (if (or err (not result))
 ;;           (progn
 ;;             (setq failures (cons (dired-make-relative from) failures))
@@ -4775,15 +4759,11 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
 ;;                       overwrite-query
 ;;                       overwrite-backup-query
 ;;                       failures skipped success-count
-;;                       total))
-;;      (set-buffer old-buf))))
+;;                       total)))
 
 ;;(defun ange-ftp-dcf-3 (failures operation total skipped success-count
 ;;                             buffer)
-;;  (let ((old-buf (current-buffer)))
-;;    (unwind-protect
-;;     (progn
-;;       (set-buffer buffer)
+;;  (with-current-buffer buffer
 ;;       (cond
 ;;        (failures
 ;;         (dired-log-summary
@@ -4798,8 +4778,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
 ;;        (t
 ;;         (message "%s: %s file%s."
 ;;                  operation success-count (dired-plural-s success-count))))
-;;       (dired-move-to-filename))
-;;      (set-buffer old-buf))))
+;;       (dired-move-to-filename)))
 \f
 ;;;; -----------------------------------------------
 ;;;; Unix Descriptive Listing (dl) Support
@@ -5533,7 +5512,7 @@ Other orders of $ and _ seem to all work just fine.")
   (let ((tbl (make-hash-table :test 'equal)))
     (goto-char (point-min))
     (save-match-data
-      (while (re-search-forward ange-ftp-date-regexp nil t)
+      (while (re-search-forward directory-listing-before-filename-regexp nil t)
        (end-of-line)
        (skip-chars-backward " ")
        (let ((end (point)))