# HG changeset patch # User Stefan Monnier # Date 1002998446 0 # Node ID b429be6f52acaa65e917cf1d6cac7c29cd15dbef # Parent 93bf2259d04a063f8f9587f7efdf3a451fb73dc0 (ange-ftp-raw-send-cmd, ange-ftp-wait-not-busy): Use with-current-buffer. (ange-ftp-cd): New arg `noerror' to prevent signalling an error. (ange-ftp-send-cmd): If a `cd' is used (because of a space in the filename), catch any error that occurs in `ange-ftp-cd'. If an error happened, don't bother sending `cmd' at all. Fix a parenthesis typo. (ange-ftp-write-region): Don't blindly use binary if the remote host is unix-like. diff -r 93bf2259d04a -r b429be6f52ac lisp/net/ange-ftp.el --- a/lisp/net/ange-ftp.el Sat Oct 13 18:28:55 2001 +0000 +++ b/lisp/net/ange-ftp.el Sat Oct 13 18:40:46 2001 +0000 @@ -1804,8 +1804,7 @@ 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 "" @@ -1837,8 +1836,7 @@ ;; 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. @@ -2198,7 +2196,7 @@ (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 @@ -2228,7 +2226,9 @@ ;; 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 @@ -2260,16 +2260,19 @@ (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 @@ -2278,16 +2281,16 @@ (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 @@ -2435,7 +2438,7 @@ "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." @@ -2516,7 +2519,13 @@ ; 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 @@ -2908,10 +2917,11 @@ (setq ange-ftp-hash-mark-unit (ash ange-ftp-ascii-hash-mark-size -4))))))) -(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. @@ -3135,8 +3145,10 @@ ;; 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 @@ -3495,10 +3507,8 @@ ;; 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