aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2001-10-13 18:40:46 +0000
committerStefan Monnier2001-10-13 18:40:46 +0000
commit67f300f81716193bc5ce50985f1ac3e7c8e3d04b (patch)
treed6e0166de779df6f1aa33cf7d5b2659f7c687f16
parent62405f46499b40739fa247da5e3a0c2235404d1f (diff)
downloademacs-67f300f81716193bc5ce50985f1ac3e7c8e3d04b.tar.gz
emacs-67f300f81716193bc5ce50985f1ac3e7c8e3d04b.zip
(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.
-rw-r--r--lisp/net/ange-ftp.el82
1 files changed, 46 insertions, 36 deletions
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index 1afc11306fa..ec3ba4471db 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -1804,8 +1804,7 @@ process that caused the command to complete.
1804If NOWAIT is given then the routine will return immediately the command has 1804If NOWAIT is given then the routine will return immediately the command has
1805been queued with no result. CONT will still be called, however." 1805been queued with no result. CONT will still be called, however."
1806 (if (memq (process-status proc) '(run open)) 1806 (if (memq (process-status proc) '(run open))
1807 (save-excursion 1807 (with-current-buffer (process-buffer proc)
1808 (set-buffer (process-buffer proc))
1809 (ange-ftp-wait-not-busy proc) 1808 (ange-ftp-wait-not-busy proc)
1810 (setq ange-ftp-process-string "" 1809 (setq ange-ftp-process-string ""
1811 ange-ftp-process-result-line "" 1810 ange-ftp-process-result-line ""
@@ -1837,8 +1836,7 @@ been queued with no result. CONT will still be called, however."
1837 1836
1838;; Wait for the ange-ftp process PROC not to be busy. 1837;; Wait for the ange-ftp process PROC not to be busy.
1839(defun ange-ftp-wait-not-busy (proc) 1838(defun ange-ftp-wait-not-busy (proc)
1840 (save-excursion 1839 (with-current-buffer (process-buffer proc)
1841 (set-buffer (process-buffer proc))
1842 (condition-case nil 1840 (condition-case nil
1843 ;; This is a kludge to let user quit in case ftp gets hung. 1841 ;; This is a kludge to let user quit in case ftp gets hung.
1844 ;; It matters because this function can be called from the filter. 1842 ;; It matters because this function can be called from the filter.
@@ -2198,7 +2196,7 @@ and NOWAIT."
2198 (ange-ftp-this-user user) 2196 (ange-ftp-this-user user)
2199 (ange-ftp-this-host host) 2197 (ange-ftp-this-host host)
2200 (ange-ftp-this-msg msg) 2198 (ange-ftp-this-msg msg)
2201 cmd2 cmd3 host-type fix-name-func) 2199 cmd2 cmd3 host-type fix-name-func result)
2202 2200
2203 (cond 2201 (cond
2204 2202
@@ -2228,7 +2226,9 @@ and NOWAIT."
2228 ;; refuse to list it. We instead change directory to the 2226 ;; refuse to list it. We instead change directory to the
2229 ;; directory in question and ls ".". 2227 ;; directory in question and ls ".".
2230 (when (string-match " " cmd1) 2228 (when (string-match " " cmd1)
2231 (ange-ftp-cd host user (nth 1 cmd)) 2229 ;; Keep the result. In case of failure, we will (see below)
2230 ;; short-circuit CMD and return this result directly.
2231 (setq result (ange-ftp-cd host user (nth 1 cmd) 'noerror))
2232 (setq cmd1 ".")) 2232 (setq cmd1 "."))
2233 2233
2234 ;; If the remote ls can take switches, put them in 2234 ;; If the remote ls can take switches, put them in
@@ -2260,16 +2260,19 @@ and NOWAIT."
2260 (and cmd2 (concat " " cmd2)))) 2260 (and cmd2 (concat " " cmd2))))
2261 2261
2262 ;; Actually send the resulting command. 2262 ;; Actually send the resulting command.
2263 (let (afsc-result 2263 (if (and (consp result) (null (car result)))
2264 afsc-line) 2264 ;; `ange-ftp-cd' has failed, so there's no point sending `cmd'.
2265 (ange-ftp-raw-send-cmd 2265 result
2266 (ange-ftp-get-process host user) 2266 (let (afsc-result
2267 cmd 2267 afsc-line)
2268 msg 2268 (ange-ftp-raw-send-cmd
2269 (list (lambda (result line host user cmd msg cont nowait) 2269 (ange-ftp-get-process host user)
2270 (or cont (setq afsc-result result 2270 cmd
2271 afsc-line line)) 2271 msg
2272 (if result (ange-ftp-call-cont cont result line) 2272 (list (lambda (result line host user cmd msg cont nowait)
2273 (or cont (setq afsc-result result
2274 afsc-line line))
2275 (if result (ange-ftp-call-cont cont result line)
2273 (ange-ftp-raw-send-cmd 2276 (ange-ftp-raw-send-cmd
2274 (ange-ftp-get-process host user) 2277 (ange-ftp-get-process host user)
2275 cmd 2278 cmd
@@ -2278,16 +2281,16 @@ and NOWAIT."
2278 (or cont (setq afsc-result result 2281 (or cont (setq afsc-result result
2279 afsc-line line)) 2282 afsc-line line))
2280 (ange-ftp-call-cont cont result line)) 2283 (ange-ftp-call-cont cont result line))
2281 cont)) 2284 cont)
2282 nowait)) 2285 nowait)))
2283 host user cmd msg cont nowait) 2286 host user cmd msg cont nowait)
2284 nowait) 2287 nowait)
2285 2288
2286 (if nowait 2289 (if nowait
2287 nil
2288 (if cont
2289 nil 2290 nil
2290 (cons afsc-result afsc-line)))))) 2291 (if cont
2292 nil
2293 (cons afsc-result afsc-line)))))))
2291 2294
2292;; It might be nice to message users about the host type identified, 2295;; It might be nice to message users about the host type identified,
2293;; but there is so much other messaging going on, it would not be 2296;; but there is so much other messaging going on, it would not be
@@ -2435,7 +2438,7 @@ which can parse the output from a DIR listing for a host of type TYPE.")
2435 "Normal hook run after parsing the text of an ftp directory listing.") 2438 "Normal hook run after parsing the text of an ftp directory listing.")
2436 2439
2437(defun ange-ftp-ls (file lsargs parse &optional no-error wildcard) 2440(defun ange-ftp-ls (file lsargs parse &optional no-error wildcard)
2438 "Return the output of an `DIR' or `ls' command done over ftp. 2441 "Return the output of a `DIR' or `ls' command done over ftp.
2439FILE is the full name of the remote file, LSARGS is any args to pass to the 2442FILE is the full name of the remote file, LSARGS is any args to pass to the
2440`ls' command, and PARSE specifies that the output should be parsed and stored 2443`ls' command, and PARSE specifies that the output should be parsed and stored
2441away in the internal cache." 2444away in the internal cache."
@@ -2516,7 +2519,13 @@ away in the internal cache."
2516 ; meaningless but harmless. 2519 ; meaningless but harmless.
2517 ange-ftp-ls-cache-res (buffer-string)) 2520 ange-ftp-ls-cache-res (buffer-string))
2518 ;; (kill-buffer (current-buffer)) 2521 ;; (kill-buffer (current-buffer))
2519 ange-ftp-ls-cache-res) 2522 (if (equal ange-ftp-ls-cache-res "total 0\n")
2523 ;; wu-ftpd seems to return a successful result
2524 ;; with an empty file-listing when doing a
2525 ;; `DIR /some/file/.' which leads ange-ftp to
2526 ;; believe that /some/file is a directory ;-(
2527 nil
2528 ange-ftp-ls-cache-res))
2520 (if no-error 2529 (if no-error
2521 nil 2530 nil
2522 (ange-ftp-error host user 2531 (ange-ftp-error host user
@@ -2908,10 +2917,11 @@ this also returns nil."
2908 (setq ange-ftp-hash-mark-unit 2917 (setq ange-ftp-hash-mark-unit
2909 (ash ange-ftp-ascii-hash-mark-size -4))))))) 2918 (ash ange-ftp-ascii-hash-mark-size -4)))))))
2910 2919
2911(defun ange-ftp-cd (host user dir) 2920(defun ange-ftp-cd (host user dir &optional noerror)
2912 (let ((result (ange-ftp-send-cmd host user (list 'cd dir) "Doing CD"))) 2921 (let ((result (ange-ftp-send-cmd host user (list 'cd dir) "Doing CD")))
2913 (or (car result) 2922 (if noerror result
2914 (ange-ftp-error host user (concat "CD failed: " (cdr result)))))) 2923 (or (car result)
2924 (ange-ftp-error host user (concat "CD failed: " (cdr result)))))))
2915 2925
2916(defun ange-ftp-get-pwd (host user) 2926(defun ange-ftp-get-pwd (host user)
2917 "Attempts to get the current working directory for the given HOST/USER pair. 2927 "Attempts to get the current working directory for the given HOST/USER pair.
@@ -3135,8 +3145,10 @@ system TYPE.")
3135 ;; of the transfer is irrelevant, i.e. we can use binary mode 3145 ;; of the transfer is irrelevant, i.e. we can use binary mode
3136 ;; regardless. Maybe a system-type to host-type lookup? 3146 ;; regardless. Maybe a system-type to host-type lookup?
3137 (binary (or (ange-ftp-binary-file filename) 3147 (binary (or (ange-ftp-binary-file filename)
3138 (memq (ange-ftp-host-type host user) 3148 (and (not (memq system-type
3139 '(unix dumb-unix)))) 3149 '(ms-dos windows-nt macos vax-vms)))
3150 (memq (ange-ftp-host-type host user)
3151 '(unix dumb-unix)))))
3140 (cmd (if append 'append 'put)) 3152 (cmd (if append 'append 'put))
3141 (abbr (ange-ftp-abbreviate-filename filename)) 3153 (abbr (ange-ftp-abbreviate-filename filename))
3142 ;; we need to reset `last-coding-system-used' to its 3154 ;; we need to reset `last-coding-system-used' to its
@@ -3495,10 +3507,8 @@ Value is (0 0) if the modification time cannot be determined."
3495;; res) 3507;; res)
3496;; (set-process-sentinel proc (function ange-ftp-copy-file-locally-sentinel)) 3508;; (set-process-sentinel proc (function ange-ftp-copy-file-locally-sentinel))
3497;; (process-kill-without-query proc) 3509;; (process-kill-without-query proc)
3498;; (save-excursion 3510;; (with-current-buffer (process-buffer proc)
3499;; (set-buffer (process-buffer proc)) 3511;; (set (make-local-variable 'copy-cont) cont))))
3500;; (make-variable-buffer-local 'copy-cont)
3501;; (setq copy-cont cont))))
3502;; 3512;;
3503;; (defun ange-ftp-copy-file-locally-sentinel (proc status) 3513;; (defun ange-ftp-copy-file-locally-sentinel (proc status)
3504;; (save-excursion 3514;; (save-excursion