Mercurial > emacs
comparison lisp/ange-ftp.el @ 14887:11a44a4c4bfe
(ange-ftp-wait-not-busy): New subroutine.
Kill ftp process if user quits.
(ange-ftp-raw-send-cmd): Use that.
(ange-ftp-fix-dir-name-for-cms): Fix error message.
| author | Richard M. Stallman <rms@gnu.org> |
|---|---|
| date | Wed, 27 Mar 1996 00:10:38 +0000 |
| parents | a9ba8d3ffd87 |
| children | 8e6b770317a5 |
comparison
equal
deleted
inserted
replaced
| 14886:96423e733197 | 14887:11a44a4c4bfe |
|---|---|
| 1709 If NOWAIT is given then the routine will return immediately the command has | 1709 If NOWAIT is given then the routine will return immediately the command has |
| 1710 been queued with no result. CONT will still be called, however." | 1710 been queued with no result. CONT will still be called, however." |
| 1711 (if (memq (process-status proc) '(run open)) | 1711 (if (memq (process-status proc) '(run open)) |
| 1712 (save-excursion | 1712 (save-excursion |
| 1713 (set-buffer (process-buffer proc)) | 1713 (set-buffer (process-buffer proc)) |
| 1714 (while ange-ftp-process-busy | 1714 (ange-ftp-wait-not-busy proc) |
| 1715 ;; This is a kludge to let user quit in case ftp gets hung. | |
| 1716 ;; It matters because this function can be called from the filter. | |
| 1717 ;; It is bad to allow quitting in a filter, but getting hung | |
| 1718 ;; is worse. By binding quit-flag to nil, we might avoid | |
| 1719 ;; most of the probability of getting screwed because the user | |
| 1720 ;; wants to quit some command. | |
| 1721 (let ((quit-flag nil) | |
| 1722 (inhibit-quit nil)) | |
| 1723 (accept-process-output))) | |
| 1724 (setq ange-ftp-process-string "" | 1715 (setq ange-ftp-process-string "" |
| 1725 ange-ftp-process-result-line "" | 1716 ange-ftp-process-result-line "" |
| 1726 ange-ftp-process-busy t | 1717 ange-ftp-process-busy t |
| 1727 ange-ftp-process-result nil | 1718 ange-ftp-process-result nil |
| 1728 ange-ftp-process-multi-skip nil | 1719 ange-ftp-process-multi-skip nil |
| 1742 (move-marker comint-last-input-end (point)) | 1733 (move-marker comint-last-input-end (point)) |
| 1743 (send-string proc cmd) | 1734 (send-string proc cmd) |
| 1744 (set-marker (process-mark proc) (point)) | 1735 (set-marker (process-mark proc) (point)) |
| 1745 (if nowait | 1736 (if nowait |
| 1746 nil | 1737 nil |
| 1747 ;; hang around for command to complete | 1738 (ange-ftp-wait-not-busy proc) |
| 1748 (while ange-ftp-process-busy | |
| 1749 ;; This is a kludge to let user quit in case ftp gets hung. | |
| 1750 ;; It matters because this function can be called from the filter. | |
| 1751 (let ((quit-flag nil) | |
| 1752 (inhibit-quit nil)) | |
| 1753 (accept-process-output proc))) | |
| 1754 (if cont | 1739 (if cont |
| 1755 nil ;cont has already been called | 1740 nil ;cont has already been called |
| 1756 (cons ange-ftp-process-result ange-ftp-process-result-line)))))) | 1741 (cons ange-ftp-process-result ange-ftp-process-result-line)))))) |
| 1742 | |
| 1743 ;; Wait for the ange-ftp process PROC not to be busy. | |
| 1744 (defun ange-ftp-wait-not-busy (proc) | |
| 1745 (save-excursion | |
| 1746 (set-buffer (process-buffer proc)) | |
| 1747 (condition-case nil | |
| 1748 ;; This is a kludge to let user quit in case ftp gets hung. | |
| 1749 ;; It matters because this function can be called from the filter. | |
| 1750 ;; It is bad to allow quitting in a filter, but getting hung | |
| 1751 ;; is worse. By binding quit-flag to nil, we might avoid | |
| 1752 ;; most of the probability of getting screwed because the user | |
| 1753 ;; wants to quit some command. | |
| 1754 (let ((quit-flag nil) | |
| 1755 (inhibit-quit nil)) | |
| 1756 (while ange-ftp-process-busy | |
| 1757 (accept-process-output proc))) | |
| 1758 (quit | |
| 1759 ;; If the user does quit out of this, | |
| 1760 ;; kill the process. That stops any transfer in progress. | |
| 1761 ;; The next operation will open a new ftp connection. | |
| 1762 (delete-process proc) | |
| 1763 (signal 'quit nil))))) | |
| 1757 | 1764 |
| 1758 (defun ange-ftp-nslookup-host (host) | 1765 (defun ange-ftp-nslookup-host (host) |
| 1759 "Attempt to resolve the given HOSTNAME using nslookup if possible." | 1766 "Attempt to resolve the given HOSTNAME using nslookup if possible." |
| 1760 (interactive "sHost: ") | 1767 (interactive "sHost: ") |
| 1761 (if ange-ftp-nslookup-program | 1768 (if ange-ftp-nslookup-program |
| 5279 (let ((result (ange-ftp-raw-send-cmd proc cmd))) | 5286 (let ((result (ange-ftp-raw-send-cmd proc cmd))) |
| 5280 (if (car result) | 5287 (if (car result) |
| 5281 file | 5288 file |
| 5282 ;; give up | 5289 ;; give up |
| 5283 (ange-ftp-error ange-ftp-this-host ange-ftp-this-user | 5290 (ange-ftp-error ange-ftp-this-host ange-ftp-this-user |
| 5284 (format "cd to minidisk %s failed: " | 5291 (format "cd to minidisk %s failed: %s" |
| 5285 minidisk (cdr result)))))))) | 5292 minidisk (cdr result)))))))) |
| 5286 (t (error "Invalid CMS file name")))) | 5293 (t (error "Invalid CMS file name")))) |
| 5287 | 5294 |
| 5288 (or (assq 'cms ange-ftp-fix-dir-name-func-alist) | 5295 (or (assq 'cms ange-ftp-fix-dir-name-func-alist) |
| 5289 (setq ange-ftp-fix-dir-name-func-alist | 5296 (setq ange-ftp-fix-dir-name-func-alist |