If NOWAIT is given then the routine will return immediately the command has
been queued with no result. CONT will still be called, however."
(if (memq (process-status proc) '(run open))
- (save-excursion
- (set-buffer (process-buffer proc))
+ (with-current-buffer (process-buffer proc)
(ange-ftp-wait-not-busy proc)
(setq ange-ftp-process-string ""
ange-ftp-process-result-line ""
;; Wait for the ange-ftp process PROC not to be busy.
(defun ange-ftp-wait-not-busy (proc)
- (save-excursion
- (set-buffer (process-buffer proc))
+ (with-current-buffer (process-buffer proc)
(condition-case nil
;; This is a kludge to let user quit in case ftp gets hung.
;; It matters because this function can be called from the filter.
(ange-ftp-this-user user)
(ange-ftp-this-host host)
(ange-ftp-this-msg msg)
- cmd2 cmd3 host-type fix-name-func)
+ cmd2 cmd3 host-type fix-name-func result)
(cond
;; refuse to list it. We instead change directory to the
;; directory in question and ls ".".
(when (string-match " " cmd1)
- (ange-ftp-cd host user (nth 1 cmd))
+ ;; Keep the result. In case of failure, we will (see below)
+ ;; short-circuit CMD and return this result directly.
+ (setq result (ange-ftp-cd host user (nth 1 cmd) 'noerror))
(setq cmd1 "."))
;; If the remote ls can take switches, put them in
(and cmd2 (concat " " cmd2))))
;; Actually send the resulting command.
- (let (afsc-result
- afsc-line)
- (ange-ftp-raw-send-cmd
- (ange-ftp-get-process host user)
- cmd
- msg
- (list (lambda (result line host user cmd msg cont nowait)
- (or cont (setq afsc-result result
- afsc-line line))
- (if result (ange-ftp-call-cont cont result line)
+ (if (and (consp result) (null (car result)))
+ ;; `ange-ftp-cd' has failed, so there's no point sending `cmd'.
+ result
+ (let (afsc-result
+ afsc-line)
+ (ange-ftp-raw-send-cmd
+ (ange-ftp-get-process host user)
+ cmd
+ msg
+ (list (lambda (result line host user cmd msg cont nowait)
+ (or cont (setq afsc-result result
+ afsc-line line))
+ (if result (ange-ftp-call-cont cont result line)
(ange-ftp-raw-send-cmd
(ange-ftp-get-process host user)
cmd
(or cont (setq afsc-result result
afsc-line line))
(ange-ftp-call-cont cont result line))
- cont))
- nowait))
- host user cmd msg cont nowait)
- nowait)
-
- (if nowait
- nil
- (if cont
+ cont)
+ nowait)))
+ host user cmd msg cont nowait)
+ nowait)
+
+ (if nowait
nil
- (cons afsc-result afsc-line))))))
+ (if cont
+ nil
+ (cons afsc-result afsc-line)))))))
;; It might be nice to message users about the host type identified,
;; but there is so much other messaging going on, it would not be
"Normal hook run after parsing the text of an ftp directory listing.")
(defun ange-ftp-ls (file lsargs parse &optional no-error wildcard)
- "Return the output of an `DIR' or `ls' command done over ftp.
+ "Return the output of a `DIR' or `ls' command done over ftp.
FILE is the full name of the remote file, LSARGS is any args to pass to the
`ls' command, and PARSE specifies that the output should be parsed and stored
away in the internal cache."
; meaningless but harmless.
ange-ftp-ls-cache-res (buffer-string))
;; (kill-buffer (current-buffer))
- ange-ftp-ls-cache-res)
+ (if (equal ange-ftp-ls-cache-res "total 0\n")
+ ;; wu-ftpd seems to return a successful result
+ ;; with an empty file-listing when doing a
+ ;; `DIR /some/file/.' which leads ange-ftp to
+ ;; believe that /some/file is a directory ;-(
+ nil
+ ange-ftp-ls-cache-res))
(if no-error
nil
(ange-ftp-error host user
(setq ange-ftp-hash-mark-unit
(ash ange-ftp-ascii-hash-mark-size -4)))))))
\f
-(defun ange-ftp-cd (host user dir)
+(defun ange-ftp-cd (host user dir &optional noerror)
(let ((result (ange-ftp-send-cmd host user (list 'cd dir) "Doing CD")))
- (or (car result)
- (ange-ftp-error host user (concat "CD failed: " (cdr result))))))
+ (if noerror result
+ (or (car result)
+ (ange-ftp-error host user (concat "CD failed: " (cdr result)))))))
(defun ange-ftp-get-pwd (host user)
"Attempts to get the current working directory for the given HOST/USER pair.
;; of the transfer is irrelevant, i.e. we can use binary mode
;; regardless. Maybe a system-type to host-type lookup?
(binary (or (ange-ftp-binary-file filename)
- (memq (ange-ftp-host-type host user)
- '(unix dumb-unix))))
+ (and (not (memq system-type
+ '(ms-dos windows-nt macos vax-vms)))
+ (memq (ange-ftp-host-type host user)
+ '(unix dumb-unix)))))
(cmd (if append 'append 'put))
(abbr (ange-ftp-abbreviate-filename filename))
;; we need to reset `last-coding-system-used' to its
;; res)
;; (set-process-sentinel proc (function ange-ftp-copy-file-locally-sentinel))
;; (process-kill-without-query proc)
-;; (save-excursion
-;; (set-buffer (process-buffer proc))
-;; (make-variable-buffer-local 'copy-cont)
-;; (setq copy-cont cont))))
+;; (with-current-buffer (process-buffer proc)
+;; (set (make-local-variable 'copy-cont) cont))))
;;
;; (defun ange-ftp-copy-file-locally-sentinel (proc status)
;; (save-excursion