diff options
| author | Stefan Monnier | 2001-10-13 18:40:46 +0000 |
|---|---|---|
| committer | Stefan Monnier | 2001-10-13 18:40:46 +0000 |
| commit | 67f300f81716193bc5ce50985f1ac3e7c8e3d04b (patch) | |
| tree | d6e0166de779df6f1aa33cf7d5b2659f7c687f16 | |
| parent | 62405f46499b40739fa247da5e3a0c2235404d1f (diff) | |
| download | emacs-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.el | 82 |
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. | |||
| 1804 | If NOWAIT is given then the routine will return immediately the command has | 1804 | If NOWAIT is given then the routine will return immediately the command has |
| 1805 | been queued with no result. CONT will still be called, however." | 1805 | been 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. |
| 2439 | FILE is the full name of the remote file, LSARGS is any args to pass to the | 2442 | FILE 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 |
| 2441 | away in the internal cache." | 2444 | away 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 |