aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman1994-04-23 05:09:00 +0000
committerRichard M. Stallman1994-04-23 05:09:00 +0000
commit888b812e1c82fea13368db21ba78761885bfac7c (patch)
treea7382b7674aab13bcbf4a9f3bf31c00cdae6f9ab
parenta65970a0f88f6dd6dfd1863511f8816c22344e24 (diff)
downloademacs-888b812e1c82fea13368db21ba78761885bfac7c.tar.gz
emacs-888b812e1c82fea13368db21ba78761885bfac7c.zip
Many doc fixes.
(ange-ftp-run-real-handler): New function. (ange-ftp-real-...): Use that. (ange-ftp-gwp-start, ange-ftp-nslookup-host) (ange-ftp-start-process): Bind process-connection-type explicitly.
-rw-r--r--lisp/ange-ftp.el319
1 files changed, 158 insertions, 161 deletions
diff --git a/lisp/ange-ftp.el b/lisp/ange-ftp.el
index 5ea0623f8cf..1c20af3c647 100644
--- a/lisp/ange-ftp.el
+++ b/lisp/ange-ftp.el
@@ -631,13 +631,11 @@ parenthesized expressions in REGEXP for the components (in that order).")
631 631
632(defvar ange-ftp-multi-msgs 632(defvar ange-ftp-multi-msgs
633 "^220-\\|^230-\\|^226\\|^25.-\\|^221-\\|^200-\\|^331-\\|^4[25]1-\\|^530-" 633 "^220-\\|^230-\\|^226\\|^25.-\\|^221-\\|^200-\\|^331-\\|^4[25]1-\\|^530-"
634 "*Regular expression matching messages from the ftp process that start 634 "*Regular expression matching the start of a multiline ftp reply.")
635a multiline reply.")
636 635
637(defvar ange-ftp-good-msgs 636(defvar ange-ftp-good-msgs
638 "^220 \\|^230 \\|^226 \\|^25. \\|^221 \\|^200 \\|^[Hh]ash mark" 637 "^220 \\|^230 \\|^226 \\|^25. \\|^221 \\|^200 \\|^[Hh]ash mark"
639 "*Regular expression matching messages from the ftp process that indicate 638 "*Regular expression matching ftp \"success\" messages.")
640that the action that was initiated has completed successfully.")
641 639
642;; CMS and the odd VMS machine say 200 Port rather than 200 PORT. 640;; CMS and the odd VMS machine say 200 Port rather than 200 PORT.
643;; Also CMS machines use a multiline 550- reply to say that you 641;; Also CMS machines use a multiline 550- reply to say that you
@@ -649,20 +647,17 @@ that the action that was initiated has completed successfully.")
649 (concat "^200 \\(PORT\\|Port\\) \\|^331 \\|^150 \\|^350 \\|^[0-9]+ bytes \\|" 647 (concat "^200 \\(PORT\\|Port\\) \\|^331 \\|^150 \\|^350 \\|^[0-9]+ bytes \\|"
650 "^Connected \\|^$\\|^Remote system\\|^Using\\|^ \\|Password:\\|" 648 "^Connected \\|^$\\|^Remote system\\|^Using\\|^ \\|Password:\\|"
651 "^local:\\|^Trying\\|^125 \\|^550-\\|^221 .*oodbye") 649 "^local:\\|^Trying\\|^125 \\|^550-\\|^221 .*oodbye")
652 "*Regular expression matching messages from the ftp process that can be 650 "*Regular expression matching ftp messages that can be ignored.")
653ignored.")
654 651
655(defvar ange-ftp-fatal-msgs 652(defvar ange-ftp-fatal-msgs
656 (concat "^ftp: \\|^Not connected\\|^530 \\|^4[25]1 \\|rcmd: \\|" 653 (concat "^ftp: \\|^Not connected\\|^530 \\|^4[25]1 \\|rcmd: \\|"
657 "^No control connection\\|unknown host\\|^lost connection") 654 "^No control connection\\|unknown host\\|^lost connection")
658 "*Regular expression matching messages from the FTP process that indicate 655 "*Regular expression matching ftp messages that indicate serious errors.
659something has gone drastically wrong attempting the action that was 656These mean that the FTP process should (or already has) been killed.")
660initiated and that the FTP process should (or already has) been killed.")
661 657
662(defvar ange-ftp-gateway-fatal-msgs 658(defvar ange-ftp-gateway-fatal-msgs
663 "No route to host\\|Connection closed\\|No such host\\|Login incorrect" 659 "No route to host\\|Connection closed\\|No such host\\|Login incorrect"
664 "*Regular expression matching messages from the rlogin / telnet process that 660 "*Regular expression matching login failure messages from rlogin/telnet.")
665indicates that logging in to the gateway machine has gone wrong.")
666 661
667(defvar ange-ftp-xfer-size-msgs 662(defvar ange-ftp-xfer-size-msgs
668 "^150 .* connection for .* (\\([0-9]+\\) bytes)" 663 "^150 .* connection for .* (\\([0-9]+\\) bytes)"
@@ -701,8 +696,7 @@ If a string then use that as the password.
701If nil then prompt the user for a password.") 696If nil then prompt the user for a password.")
702 697
703(defvar ange-ftp-dumb-unix-host-regexp nil 698(defvar ange-ftp-dumb-unix-host-regexp nil
704 "*If non-nil, if the host being ftp'd to matches this regexp then the FTP 699 "*If non-nil, regexp matching hosts on which `dir' command lists directory.")
705process uses the \'dir\' command to get directory information.")
706 700
707(defvar ange-ftp-binary-file-name-regexp 701(defvar ange-ftp-binary-file-name-regexp
708 (concat "\\.[zZ]$\\|\\.lzh$\\|\\.arc$\\|\\.zip$\\|\\.zoo$\\|\\.tar$\\|" 702 (concat "\\.[zZ]$\\|\\.lzh$\\|\\.arc$\\|\\.zip$\\|\\.zoo$\\|\\.tar$\\|"
@@ -715,23 +709,22 @@ process uses the \'dir\' command to get directory information.")
715 "*Name of host to use as gateway machine when local FTP isn't possible.") 709 "*Name of host to use as gateway machine when local FTP isn't possible.")
716 710
717(defvar ange-ftp-local-host-regexp ".*" 711(defvar ange-ftp-local-host-regexp ".*"
718 "*If a host being FTP'd to matches this regexp then the ftp process is started 712 "*Regexp selecting hosts which can be reached directly with ftp.
719locally, otherwise the FTP process is started on \`ange-ftp-gateway-host\' 713For other hosts the FTP process is started on \`ange-ftp-gateway-host\'
720instead.") 714instead.")
721 715
722(defvar ange-ftp-gateway-program-interactive nil 716(defvar ange-ftp-gateway-program-interactive nil
723 "*If non-nil then the gateway program is expected to connect to the gateway 717 "*If non-nil then the gateway program should give a shell prompt.
724machine and eventually give a shell prompt. Both telnet and rlogin do something 718Both telnet and rlogin do something like this.")
725like this.")
726 719
727(defvar ange-ftp-gateway-program (if (eq system-type 'hpux) "remsh" "rsh") 720(defvar ange-ftp-gateway-program (if (eq system-type 'hpux) "remsh" "rsh")
728 "*Name of program to spawn a shell on the gateway machine. Valid candidates 721 "*Name of program to spawn a shell on the gateway machine.
729are rsh (remsh on hp-ux), telnet and rlogin. See also the gateway variable 722Valid candidates are rsh (remsh on hp-ux), telnet and rlogin. See
730above.") 723also the gateway variable above.")
731 724
732(defvar ange-ftp-gateway-prompt-pattern "^[^#$%>;\n]*[#$%>;] *" 725(defvar ange-ftp-gateway-prompt-pattern "^[^#$%>;\n]*[#$%>;] *"
733 "*Regexp used to detect that the logging-in sequence is completed on the 726 "*Regexp matching prompt after complete login sequence on gateway machine.
734gateway machine and that the shell is now awaiting input. Make this regexp as 727A match for this means the shell is now awaiting input. Make this regexp as
735strict as possible; it shouldn't match *anything* at all except the user's 728strict as possible; it shouldn't match *anything* at all except the user's
736initial prompt. The above string will fail under most SUN-3's since it 729initial prompt. The above string will fail under most SUN-3's since it
737matches the login banner.") 730matches the login banner.")
@@ -740,12 +733,13 @@ matches the login banner.")
740 (if (eq system-type 'hpux) 733 (if (eq system-type 'hpux)
741 "stty -onlcr -echo\n" 734 "stty -onlcr -echo\n"
742 "stty -echo nl\n") 735 "stty -echo nl\n")
743 "*Command to use after logging in to the gateway machine to stop the terminal 736 "*Set up terminal after logging in to the gateway machine.
744echoing each command and to strip out trailing ^M characters.") 737This command should stop the terminal from echoing each command, and
738arrange to strip out trailing ^M characters.")
745 739
746(defvar ange-ftp-smart-gateway nil 740(defvar ange-ftp-smart-gateway nil
747 "*If the gateway FTP is smart enough to use proxy server, then don't bother 741 "*Non-nil means the ftp gateway is smart.
748telnetting etc, just issue a user@host command instead.") 742Don't bother telnetting, etc., just issue a user@host command instead.")
749 743
750(defvar ange-ftp-smart-gateway-port "21" 744(defvar ange-ftp-smart-gateway-port "21"
751 "*Port on gateway machine to use when smart gateway is in operation.") 745 "*Port on gateway machine to use when smart gateway is in operation.")
@@ -784,8 +778,8 @@ Some AT&T folks claim to use something called `pftp' here.")
784 "*Non-nil means make backup files for \"magic\" remote files.") 778 "*Non-nil means make backup files for \"magic\" remote files.")
785 779
786(defvar ange-ftp-retry-time 5 780(defvar ange-ftp-retry-time 5
787 "*Number of seconds to wait before retrying if a file or listing 781 "*Number of seconds to wait before retry if file or listing doesn't arrive.
788doesn't arrive. This might need to be increased for very slow connections.") 782This might need to be increased for very slow connections.")
789 783
790(defvar ange-ftp-auto-save 0 784(defvar ange-ftp-auto-save 0
791 "If 1, allows ange-ftp files to be auto-saved. 785 "If 1, allows ange-ftp files to be auto-saved.
@@ -857,7 +851,7 @@ SIZE, if supplied, should be a prime number."
857;;;; Internal variables. 851;;;; Internal variables.
858;;;; ------------------------------------------------------------ 852;;;; ------------------------------------------------------------
859 853
860(defconst ange-ftp-version "$Revision: 1.44 $") 854(defconst ange-ftp-version "$Revision: 1.45 $")
861 855
862(defvar ange-ftp-data-buffer-name " *ftp data*" 856(defvar ange-ftp-data-buffer-name " *ftp data*"
863 "Buffer name to hold directory listing data received from ftp process.") 857 "Buffer name to hold directory listing data received from ftp process.")
@@ -1140,10 +1134,11 @@ Optional DEFAULT is password to start with."
1140 (concat (file-name-directory file) temp))))) 1134 (concat (file-name-directory file) temp)))))
1141 file) 1135 file)
1142 1136
1137;; Move along current line looking for the value of the TOKEN.
1138;; Valid separators between TOKEN and its value are commas and
1139;; whitespace. Second arg LIMIT is a limit for the search.
1140
1143(defun ange-ftp-parse-netrc-token (token limit) 1141(defun ange-ftp-parse-netrc-token (token limit)
1144 "Move along current line looking for the value of the TOKEN.
1145Valid separators between TOKEN and its value are commas and
1146whitespace. Second arg LIMIT is a limit for the search."
1147 (if (search-forward token limit t) 1142 (if (search-forward token limit t)
1148 (let (beg) 1143 (let (beg)
1149 (skip-chars-forward ", \t\r\n" limit) 1144 (skip-chars-forward ", \t\r\n" limit)
@@ -1157,10 +1152,11 @@ whitespace. Second arg LIMIT is a limit for the search."
1157 (skip-chars-forward "^, \t\r\n" limit) 1152 (skip-chars-forward "^, \t\r\n" limit)
1158 (buffer-substring beg (point)))))) 1153 (buffer-substring beg (point))))))
1159 1154
1155;; Extract the values for the tokens `machine', `login',
1156;; `password' and `account' in the current buffer. If successful,
1157;; record the information found.
1158
1160(defun ange-ftp-parse-netrc-group () 1159(defun ange-ftp-parse-netrc-group ()
1161 "Extract the values for the tokens \`machine\', \`login\', \`password\'
1162and \`account\' in the current buffer. If successful, record the information
1163found."
1164 (beginning-of-line) 1160 (beginning-of-line)
1165 (let ((start (point)) 1161 (let ((start (point))
1166 (end (progn (re-search-forward "machine\\|default" 1162 (end (progn (re-search-forward "machine\\|default"
@@ -1193,11 +1189,11 @@ found."
1193 (setq ange-ftp-default-account account))))) 1189 (setq ange-ftp-default-account account)))))
1194 (goto-char end))) 1190 (goto-char end)))
1195 1191
1196(defun ange-ftp-parse-netrc () 1192;; Read in ~/.netrc, if one exists. If ~/.netrc file exists and has
1197 "Read in ~/.netrc, if one exists. 1193;; the correct permissions then extract the \`machine\', \`login\',
1198If ~/.netrc file exists and has the correct permissions then extract the 1194;; \`password\' and \`account\' information from within.
1199\`machine\', \`login\', \`password\' and \`account\' information from within."
1200 1195
1196(defun ange-ftp-parse-netrc ()
1201 ;; We set this before actually doing it to avoid the possibility 1197 ;; We set this before actually doing it to avoid the possibility
1202 ;; of an infinite loop if ange-ftp-netrc-filename is an FTP file. 1198 ;; of an infinite loop if ange-ftp-netrc-filename is an FTP file.
1203 (interactive) 1199 (interactive)
@@ -1231,9 +1227,10 @@ If ~/.netrc file exists and has the correct permissions then extract the
1231 (sit-for 1)) 1227 (sit-for 1))
1232 (setq ange-ftp-netrc-modtime (nth 5 attr)))))) 1228 (setq ange-ftp-netrc-modtime (nth 5 attr))))))
1233 1229
1230;; Return a list of prefixes of the form 'user@host:' to be used when
1231;; completion is done in the root directory.
1232
1234(defun ange-ftp-generate-root-prefixes () 1233(defun ange-ftp-generate-root-prefixes ()
1235 "Return a list of prefixes of the form 'user@host:' to be used when
1236completion is done in the root directory."
1237 (ange-ftp-parse-netrc) 1234 (ange-ftp-parse-netrc)
1238 (ange-ftp-save-match-data 1235 (ange-ftp-save-match-data
1239 (let (res) 1236 (let (res)
@@ -1266,9 +1263,9 @@ completion is done in the root directory."
1266(defvar ange-ftp-ftp-name-arg "") 1263(defvar ange-ftp-ftp-name-arg "")
1267(defvar ange-ftp-ftp-name-res nil) 1264(defvar ange-ftp-ftp-name-res nil)
1268 1265
1266;; Parse NAME according to `ange-ftp-name-format' (which see).
1267;; Returns a list (HOST USER NAME), or nil if NAME does not match the format.
1269(defun ange-ftp-ftp-name (name) 1268(defun ange-ftp-ftp-name (name)
1270 "Parse NAME according to `ange-ftp-name-format' (which see).
1271Returns a list (HOST USER NAME), or nil if NAME does not match the format."
1272 (if (string-equal name ange-ftp-ftp-name-arg) 1269 (if (string-equal name ange-ftp-ftp-name-arg)
1273 ange-ftp-ftp-name-res 1270 ange-ftp-ftp-name-res
1274 (setq ange-ftp-ftp-name-arg name 1271 (setq ange-ftp-ftp-name-arg name
@@ -1284,9 +1281,9 @@ Returns a list (HOST USER NAME), or nil if NAME does not match the format."
1284 (list host user name)) 1281 (list host user name))
1285 nil))))) 1282 nil)))))
1286 1283
1284;; Take a FULLNAME that matches according to ange-ftp-name-format and
1285;; replace the name component with NAME.
1287(defun ange-ftp-replace-name-component (fullname name) 1286(defun ange-ftp-replace-name-component (fullname name)
1288 "Take a FULLNAME that matches according to ange-ftp-name-format and
1289replace the name component with NAME."
1290 (ange-ftp-save-match-data 1287 (ange-ftp-save-match-data
1291 (if (string-match (car ange-ftp-name-format) fullname) 1288 (if (string-match (car ange-ftp-name-format) fullname)
1292 (let* ((ns (cdr ange-ftp-name-format)) 1289 (let* ((ns (cdr ange-ftp-name-format))
@@ -1306,14 +1303,14 @@ replace the name component with NAME."
1306 "Clear any existing minibuffer message; let the minibuffer contents show." 1303 "Clear any existing minibuffer message; let the minibuffer contents show."
1307 (message nil)) 1304 (message nil))
1308 1305
1306;; Return the name of the buffer that collects output from the ftp process
1307;; connected to the given HOST and USER pair.
1309(defun ange-ftp-ftp-process-buffer (host user) 1308(defun ange-ftp-ftp-process-buffer (host user)
1310 "Return the name of the buffer that collects output from the ftp process
1311connected to the given HOST and USER pair."
1312 (concat "*ftp " user "@" host "*")) 1309 (concat "*ftp " user "@" host "*"))
1313 1310
1311;; Display the last chunk of output from the ftp process for the given HOST
1312;; USER pair, and signal an error including MSG in the text.
1314(defun ange-ftp-error (host user msg) 1313(defun ange-ftp-error (host user msg)
1315 "Display the last chunk of output from the ftp process for the given HOST
1316USER pair, and signal an error including MSG in the text."
1317 (let ((cur (selected-window)) 1314 (let ((cur (selected-window))
1318 (pop-up-windows t)) 1315 (pop-up-windows t))
1319 (pop-to-buffer 1316 (pop-to-buffer
@@ -1374,8 +1371,9 @@ then kill the related ftp process."
1374;;;; ------------------------------------------------------------ 1371;;;; ------------------------------------------------------------
1375 1372
1376(defun ange-ftp-process-handle-line (line proc) 1373(defun ange-ftp-process-handle-line (line proc)
1377 "Look at the given LINE from the ftp process PROC. Try to categorize it 1374 "Look at the given LINE from the ftp process PROC.
1378into one of four categories: good, skip, fatal, or unknown." 1375Try to categorize it into one of four categories:
1376good, skip, fatal, or unknown."
1379 (cond ((string-match ange-ftp-xfer-size-msgs line) 1377 (cond ((string-match ange-ftp-xfer-size-msgs line)
1380 (setq ange-ftp-xfer-size 1378 (setq ange-ftp-xfer-size
1381 (ash (string-to-int (substring line 1379 (ash (string-to-int (substring line
@@ -1435,20 +1433,22 @@ into one of four categories: good, skip, fatal, or unknown."
1435 (ange-ftp-message "%s...%d%%" ange-ftp-process-msg percent))))))) 1433 (ange-ftp-message "%s...%d%%" ange-ftp-process-msg percent)))))))
1436 str) 1434 str)
1437 1435
1436;; Call the function specified by CONT. CONT can be either a function
1437;; or a list of a function and some args. The first two parameters
1438;; passed to the function will be RESULT and LINE. The remaining args
1439;; will be taken from CONT if a list was passed.
1440
1438(defun ange-ftp-call-cont (cont result line) 1441(defun ange-ftp-call-cont (cont result line)
1439 "Call the function specified by CONT. CONT can be either a function or a
1440list of a function and some args. The first two parameters passed to the
1441function will be RESULT and LINE. The remaining args will be taken from CONT
1442if a list was passed."
1443 (if cont 1442 (if cont
1444 (if (and (listp cont) 1443 (if (and (listp cont)
1445 (not (eq (car cont) 'lambda))) 1444 (not (eq (car cont) 'lambda)))
1446 (apply (car cont) result line (cdr cont)) 1445 (apply (car cont) result line (cdr cont))
1447 (funcall cont result line)))) 1446 (funcall cont result line))))
1448 1447
1448;; Build up a complete line of output from the ftp PROCESS and pass it
1449;; on to ange-ftp-process-handle-line to deal with.
1450
1449(defun ange-ftp-process-filter (proc str) 1451(defun ange-ftp-process-filter (proc str)
1450 "Build up a complete line of output from the ftp PROCESS and pass it
1451on to ange-ftp-process-handle-line to deal with."
1452 (let ((buffer (process-buffer proc)) 1452 (let ((buffer (process-buffer proc))
1453 (old-buffer (current-buffer))) 1453 (old-buffer (current-buffer)))
1454 1454
@@ -1617,9 +1617,13 @@ on to ange-ftp-process-handle-line to deal with."
1617(defun ange-ftp-gwp-start (host user name args) 1617(defun ange-ftp-gwp-start (host user name args)
1618 "Login to the gateway machine and fire up an ftp process." 1618 "Login to the gateway machine and fire up an ftp process."
1619 (let* ((gw-user (ange-ftp-get-user ange-ftp-gateway-host)) 1619 (let* ((gw-user (ange-ftp-get-user ange-ftp-gateway-host))
1620 (proc (start-process name name 1620 ;; It would be nice to make process-connection-type nil,
1621 ange-ftp-gateway-program 1621 ;; but that doesn't work: ftp never responds.
1622 ange-ftp-gateway-host)) 1622 ;; Can anyone find a fix for that?
1623 (proc (let ((process-connection-type t))
1624 (start-process name name
1625 ange-ftp-gateway-program
1626 ange-ftp-gateway-host)))
1623 (ftp (mapconcat (function identity) args " "))) 1627 (ftp (mapconcat (function identity) args " ")))
1624 (process-kill-without-query proc) 1628 (process-kill-without-query proc)
1625 (set-process-sentinel proc (function ange-ftp-gwp-sentinel)) 1629 (set-process-sentinel proc (function ange-ftp-gwp-sentinel))
@@ -1714,8 +1718,12 @@ been queued with no result. CONT will still be called, however."
1714 (if (file-accessible-directory-p default-directory) 1718 (if (file-accessible-directory-p default-directory)
1715 default-directory 1719 default-directory
1716 exec-directory)) 1720 exec-directory))
1717 (proc (start-process " *nslookup*" " *nslookup*" 1721 ;; It would be nice to make process-connection-type nil,
1718 ange-ftp-nslookup-program host)) 1722 ;; but that doesn't work: ftp never responds.
1723 ;; Can anyone find a fix for that?
1724 (proc (let ((process-connection-type t))
1725 (start-process " *nslookup*" " *nslookup*"
1726 ange-ftp-nslookup-program host)))
1719 (res host)) 1727 (res host))
1720 (process-kill-without-query proc) 1728 (process-kill-without-query proc)
1721 (save-excursion 1729 (save-excursion
@@ -1744,14 +1752,18 @@ on the gateway machine to do the ftp instead."
1744 default-directory 1752 default-directory
1745 exec-directory)) 1753 exec-directory))
1746 proc) 1754 proc)
1747 (if use-gateway 1755 ;; It would be nice to make process-connection-type nil,
1748 (if ange-ftp-gateway-program-interactive 1756 ;; but that doesn't work: ftp never responds.
1749 (setq proc (ange-ftp-gwp-start host user name args)) 1757 ;; Can anyone find a fix for that?
1750 (setq proc (apply 'start-process name name 1758 (let ((process-connection-type t))
1751 (append (list ange-ftp-gateway-program 1759 (if use-gateway
1752 ange-ftp-gateway-host) 1760 (if ange-ftp-gateway-program-interactive
1753 args)))) 1761 (setq proc (ange-ftp-gwp-start host user name args))
1754 (setq proc (apply 'start-process name name args))) 1762 (setq proc (apply 'start-process name name
1763 (append (list ange-ftp-gateway-program
1764 ange-ftp-gateway-host)
1765 args))))
1766 (setq proc (apply 'start-process name name args))))
1755 (process-kill-without-query proc) 1767 (process-kill-without-query proc)
1756 (save-excursion 1768 (save-excursion
1757 (set-buffer (process-buffer proc)) 1769 (set-buffer (process-buffer proc))
@@ -1868,8 +1880,8 @@ PROC is the process to the FTP-client."
1868 (setq ange-ftp-binary-hash-mark-size size))))))))) 1880 (setq ange-ftp-binary-hash-mark-size size)))))))))
1869 1881
1870(defun ange-ftp-get-process (host user) 1882(defun ange-ftp-get-process (host user)
1871 "Return the process object for a FTP process connected to HOST and 1883 "Return an FTP subprocess connected to HOST and logged in as USER.
1872logged in as USER. Create a new process if needed." 1884Create a new process if needed."
1873 (let* ((name (ange-ftp-ftp-process-buffer host user)) 1885 (let* ((name (ange-ftp-ftp-process-buffer host user))
1874 (proc (get-process name))) 1886 (proc (get-process name)))
1875 (if (and proc (memq (process-status proc) '(run open))) 1887 (if (and proc (memq (process-status proc) '(run open)))
@@ -1945,12 +1957,14 @@ host-type by logging in as USER."
1945;; (for efficiency) if you log into a particular non-UNIX host frequently. 1957;; (for efficiency) if you log into a particular non-UNIX host frequently.
1946 1958
1947(defvar ange-ftp-fix-name-func-alist nil 1959(defvar ange-ftp-fix-name-func-alist nil
1948 "Association list of \( TYPE \. FUNC \) pairs, where FUNC is a routine 1960 "Alist saying how to convert file name to the host's syntax.
1961Association list of \( TYPE \. FUNC \) pairs, where FUNC is a routine
1949which can change a UNIX file name into a name more suitable for a host of type 1962which can change a UNIX file name into a name more suitable for a host of type
1950TYPE.") 1963TYPE.")
1951 1964
1952(defvar ange-ftp-fix-dir-name-func-alist nil 1965(defvar ange-ftp-fix-dir-name-func-alist nil
1953 "Association list of \( TYPE \. FUNC \) pairs, where FUNC is a routine 1966 "Alist saying how to convert directory name to the host's syntax.
1967Association list of \( TYPE \. FUNC \) pairs, where FUNC is a routine
1954which can change UNIX directory name into a directory name more suitable 1968which can change UNIX directory name into a directory name more suitable
1955for a host of type TYPE.") 1969for a host of type TYPE.")
1956 1970
@@ -2076,8 +2090,8 @@ and NOWAIT."
2076 "^[A-Z0-9._][A-Z0-9._][A-Z0-9._][A-Z0-9._]:$") 2090 "^[A-Z0-9._][A-Z0-9._][A-Z0-9._][A-Z0-9._]:$")
2077 2091
2078(defun ange-ftp-guess-host-type (host user) 2092(defun ange-ftp-guess-host-type (host user)
2079 "Guess at the the host type of HOST by doing a pwd, and examining 2093 "Guess at the the host type of HOST.
2080the directory syntax." 2094Works by doing a pwd and examining the directory syntax."
2081 (let ((host-type (ange-ftp-host-type host)) 2095 (let ((host-type (ange-ftp-host-type host))
2082 (key (concat host "/" user "/~"))) 2096 (key (concat host "/" user "/~")))
2083 (if (eq host-type 'unix) 2097 (if (eq host-type 'unix)
@@ -2154,9 +2168,9 @@ the directory syntax."
2154;;;; Remote file and directory listing support. 2168;;;; Remote file and directory listing support.
2155;;;; ------------------------------------------------------------ 2169;;;; ------------------------------------------------------------
2156 2170
2171;; Returns whether HOST's FTP server doesn't like \'ls\' or \'dir\' commands
2172;; to take switch arguments.
2157(defun ange-ftp-dumb-unix-host (host) 2173(defun ange-ftp-dumb-unix-host (host)
2158 "Returns whether HOST's FTP server doesn't like \'ls\' or \'dir\' commands
2159to take switch arguments."
2160 (and ange-ftp-dumb-unix-host-regexp 2174 (and ange-ftp-dumb-unix-host-regexp
2161 (ange-ftp-save-match-data 2175 (ange-ftp-save-match-data
2162 (string-match ange-ftp-dumb-unix-host-regexp host)))) 2176 (string-match ange-ftp-dumb-unix-host-regexp host))))
@@ -2175,7 +2189,8 @@ to take switch arguments."
2175 ange-ftp-host-cache nil))) 2189 ange-ftp-host-cache nil)))
2176 2190
2177(defvar ange-ftp-parse-list-func-alist nil 2191(defvar ange-ftp-parse-list-func-alist nil
2178 "Association list of \( TYPE \. FUNC \) pairs. The FUNC is a routine 2192 "Alist saying how to parse directory listings for certain OS types.
2193Association list of \( TYPE \. FUNC \) pairs. The FUNC is a routine
2179which can parse the output from a DIR listing for a host of type TYPE.") 2194which can parse the output from a DIR listing for a host of type TYPE.")
2180 2195
2181;; With no-error nil, this function returns: 2196;; With no-error nil, this function returns:
@@ -2289,15 +2304,16 @@ away in the internal cache."
2289 "\\|Nov\\|Dec\\) +[0-3]?[0-9] ")) 2304 "\\|Nov\\|Dec\\) +[0-3]?[0-9] "))
2290 2305
2291(defvar ange-ftp-add-file-entry-alist nil 2306(defvar ange-ftp-add-file-entry-alist nil
2292 "Association list of pairs \( TYPE \. FUNC \), where FUNC 2307 ""Alist saying how to add file entries on certain OS types.
2308Association list of pairs \( TYPE \. FUNC \), where FUNC
2293is a function to be used to add a file entry for the OS TYPE. The 2309is a function to be used to add a file entry for the OS TYPE. The
2294main reason for this alist is to deal with file versions in VMS.") 2310main reason for this alist is to deal with file versions in VMS.")
2295 2311
2296(defvar ange-ftp-delete-file-entry-alist nil 2312(defvar ange-ftp-delete-file-entry-alist nil
2297 "Association list of pairs \( TYPE \. FUNC \), where FUNC 2313 "Alist saying how to delete files on certain OS types.
2314Association list of pairs \( TYPE \. FUNC \), where FUNC
2298is a function to be used to delete a file entry for the OS TYPE. 2315is a function to be used to delete a file entry for the OS TYPE.
2299The main reason for this alist is to deal with file versions in 2316The main reason for this alist is to deal with file versions in VMS.")
2300VMS.")
2301 2317
2302(defun ange-ftp-add-file-entry (name &optional dir-p) 2318(defun ange-ftp-add-file-entry (name &optional dir-p)
2303 "Add a file entry for file NAME, if its directory info exists." 2319 "Add a file entry for file NAME, if its directory info exists."
@@ -2388,9 +2404,9 @@ VMS.")
2388;;; The dl stuff for descriptive listings 2404;;; The dl stuff for descriptive listings
2389 2405
2390(defvar ange-ftp-dl-dir-regexp nil 2406(defvar ange-ftp-dl-dir-regexp nil
2391 "Regexp matching directories which are listed in dl format. This regexp 2407 "Regexp matching directories which are listed in dl format.
2392shouldn't be anchored with a trailing $ so that it will match subdirectories 2408This regexp should not be anchored with a trailing `$', because it should
2393as well.") 2409match subdirectories as well.")
2394 2410
2395(defun ange-ftp-add-dl-dir (dir) 2411(defun ange-ftp-add-dl-dir (dir)
2396 "Interactively adds a DIR to ange-ftp-dl-dir-regexp." 2412 "Interactively adds a DIR to ange-ftp-dl-dir-regexp."
@@ -2423,10 +2439,11 @@ as well.")
2423 (ange-ftp-put-hash-entry ".." t tbl) 2439 (ange-ftp-put-hash-entry ".." t tbl)
2424 tbl))) 2440 tbl)))
2425 2441
2442;; Parse the current buffer which is assumed to be in a dired-like listing
2443;; format, and return a hashtable as the result. If the listing is not really
2444;; a listing, then return nil.
2445
2426(defun ange-ftp-parse-dired-listing (&optional switches) 2446(defun ange-ftp-parse-dired-listing (&optional switches)
2427 "Parse the current buffer which is assumed to be in a dired-like listing
2428format, and return a hashtable as the result. If the listing is not really
2429a listing, then return nil."
2430 (ange-ftp-save-match-data 2447 (ange-ftp-save-match-data
2431 (cond 2448 (cond
2432 ((looking-at "^total [0-9]+$") 2449 ((looking-at "^total [0-9]+$")
@@ -2500,22 +2517,23 @@ NO-ERROR, if a listing for DIRECTORY cannot be obtained."
2500 (ange-ftp-get-hash-entry 2517 (ange-ftp-get-hash-entry
2501 directory ange-ftp-files-hashtable))))) 2518 directory ange-ftp-files-hashtable)))))
2502 2519
2520;; Given NAME, return the file part that can be used for looking up the
2521;; file's entry in a hashtable.
2503(defmacro ange-ftp-get-file-part (name) 2522(defmacro ange-ftp-get-file-part (name)
2504 "Given NAME, return the file part that can be used for looking up the
2505file's entry in a hashtable."
2506 (` (let ((file (file-name-nondirectory (, name)))) 2523 (` (let ((file (file-name-nondirectory (, name))))
2507 (if (string-equal file "") 2524 (if (string-equal file "")
2508 "." 2525 "."
2509 file)))) 2526 file))))
2510 2527
2528;; Return whether ange-ftp-file-entry-p and ange-ftp-get-file-entry are
2529;; allowed to determine if NAME is a sub-directory by listing it directly,
2530;; rather than listing its parent directory. This is used for efficiency so
2531;; that a wasted listing is not done:
2532;; 1. When looking for a .dired file in dired-x.el.
2533;; 2. The syntax of FILE and DIR make it impossible that FILE could be a valid
2534;; subdirectory. This is of course an OS dependent judgement.
2535
2511(defmacro ange-ftp-allow-child-lookup (dir file) 2536(defmacro ange-ftp-allow-child-lookup (dir file)
2512 "Return whether ange-ftp-file-entry-p and ange-ftp-get-file-entry are
2513allowed to determine if NAME is a sub-directory by listing it directly,
2514rather than listing its parent directory. This is used for efficiency so
2515that a wasted listing is not done:
25161. When looking for a .dired file in dired-x.el.
25172. The syntax of FILE and DIR make it impossible that FILE could be a valid
2518 subdirectory. This is of course an OS dependent judgement."
2519 (` (not 2537 (` (not
2520 (let* ((efile (, file)) ; expand once. 2538 (let* ((efile (, file)) ; expand once.
2521 (edir (, dir)) 2539 (edir (, dir))
@@ -2605,8 +2623,7 @@ this also returns nil."
2605 files)))) 2623 files))))
2606 2624
2607(defun ange-ftp-wipe-file-entries (host user) 2625(defun ange-ftp-wipe-file-entries (host user)
2608 "Replace the file entry information hashtable with one that doesn't have any 2626 "Get rid of entry for HOST, USER pair from file entry information hashtable."
2609entries for the given HOST, USER pair."
2610 (let ((new-tbl (ange-ftp-make-hashtable (length ange-ftp-files-hashtable)))) 2627 (let ((new-tbl (ange-ftp-make-hashtable (length ange-ftp-files-hashtable))))
2611 (ange-ftp-map-hashtable 2628 (ange-ftp-map-hashtable
2612 (function 2629 (function
@@ -2668,7 +2685,8 @@ and LINE is the relevant success or fail line from the FTP-client."
2668;;; ------------------------------------------------------------ 2685;;; ------------------------------------------------------------
2669 2686
2670(defun ange-ftp-expand-dir (host user dir) 2687(defun ange-ftp-expand-dir (host user dir)
2671 "Return the result of doing a PWD in the current FTP session to machine HOST 2688 "Return the result of doing a PWD in the current FTP session.
2689Use the connection to machine HOST
2672logged in as user USER and cd'd to directory DIR." 2690logged in as user USER and cd'd to directory DIR."
2673 (let* ((host-type (ange-ftp-host-type host user)) 2691 (let* ((host-type (ange-ftp-host-type host user))
2674 ;; It is more efficient to call ange-ftp-host-type 2692 ;; It is more efficient to call ange-ftp-host-type
@@ -2788,7 +2806,7 @@ logged in as user USER and cd'd to directory DIR."
2788;;; These are problems--they are currently not enabled. 2806;;; These are problems--they are currently not enabled.
2789 2807
2790(defvar ange-ftp-file-name-as-directory-alist nil 2808(defvar ange-ftp-file-name-as-directory-alist nil
2791 "Association list of \( TYPE \. FUNC \) pairs, where 2809 "Association list of \( TYPE \. FUNC \) pairs.
2792FUNC converts a filename to a directory name for the operating 2810FUNC converts a filename to a directory name for the operating
2793system TYPE.") 2811system TYPE.")
2794 2812
@@ -3836,93 +3854,72 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
3836;;; Define ways of getting at unmodified Emacs primitives, 3854;;; Define ways of getting at unmodified Emacs primitives,
3837;;; turning off our handler. 3855;;; turning off our handler.
3838 3856
3857(defun ange-ftp-run-real-handler (operation args)
3858 (let ((inhibit-file-name-handlers
3859 (cons 'ange-ftp-hook-function
3860 (and (eq inhibit-file-name-operation operation)
3861 inhibit-file-name-handlers)))
3862 (inhibit-file-name-operation operation))
3863 (apply operation args)))
3864
3839(defun ange-ftp-real-file-name-directory (&rest args) 3865(defun ange-ftp-real-file-name-directory (&rest args)
3840 (let (file-name-handler-alist) 3866 (ange-ftp-run-real-handler 'file-name-directory args))
3841 (apply 'file-name-directory args)))
3842(defun ange-ftp-real-file-name-nondirectory (&rest args) 3867(defun ange-ftp-real-file-name-nondirectory (&rest args)
3843 (let (file-name-handler-alist) 3868 (ange-ftp-run-real-handler 'file-name-nondirectory args))
3844 (apply 'file-name-nondirectory args)))
3845(defun ange-ftp-real-file-name-as-directory (&rest args) 3869(defun ange-ftp-real-file-name-as-directory (&rest args)
3846 (let (file-name-handler-alist) 3870 (ange-ftp-run-real-handler 'file-name-as-directory args))
3847 (apply 'file-name-as-directory args)))
3848(defun ange-ftp-real-directory-file-name (&rest args) 3871(defun ange-ftp-real-directory-file-name (&rest args)
3849 (let (file-name-handler-alist) 3872 (ange-ftp-run-real-handler 'directory-file-name args))
3850 (apply 'directory-file-name args)))
3851(defun ange-ftp-real-expand-file-name (&rest args) 3873(defun ange-ftp-real-expand-file-name (&rest args)
3852 (let (file-name-handler-alist) 3874 (ange-ftp-run-real-handler 'expand-file-name args))
3853 (apply 'expand-file-name args)))
3854(defun ange-ftp-real-make-directory (&rest args) 3875(defun ange-ftp-real-make-directory (&rest args)
3855 (let (file-name-handler-alist) 3876 (ange-ftp-run-real-handler 'make-directory args))
3856 (apply 'make-directory args)))
3857(defun ange-ftp-real-delete-directory (&rest args) 3877(defun ange-ftp-real-delete-directory (&rest args)
3858 (let (file-name-handler-alist) 3878 (ange-ftp-run-real-handler 'delete-directory args))
3859 (apply 'delete-directory args)))
3860(defun ange-ftp-real-insert-file-contents (&rest args) 3879(defun ange-ftp-real-insert-file-contents (&rest args)
3861 (let (file-name-handler-alist) 3880 (ange-ftp-run-real-handler 'insert-file-contents args))
3862 (apply 'insert-file-contents args)))
3863(defun ange-ftp-real-directory-files (&rest args) 3881(defun ange-ftp-real-directory-files (&rest args)
3864 (let (file-name-handler-alist) 3882 (ange-ftp-run-real-handler 'directory-files args))
3865 (apply 'directory-files args)))
3866(defun ange-ftp-real-file-directory-p (&rest args) 3883(defun ange-ftp-real-file-directory-p (&rest args)
3867 (let (file-name-handler-alist) 3884 (ange-ftp-run-real-handler 'file-directory-p args))
3868 (apply 'file-directory-p args)))
3869(defun ange-ftp-real-file-writable-p (&rest args) 3885(defun ange-ftp-real-file-writable-p (&rest args)
3870 (let (file-name-handler-alist) 3886 (ange-ftp-run-real-handler 'file-writable-p args))
3871 (apply 'file-writable-p args)))
3872(defun ange-ftp-real-file-readable-p (&rest args) 3887(defun ange-ftp-real-file-readable-p (&rest args)
3873 (let (file-name-handler-alist) 3888 (ange-ftp-run-real-handler 'file-readable-p args))
3874 (apply 'file-readable-p args)))
3875(defun ange-ftp-real-file-executable-p (&rest args) 3889(defun ange-ftp-real-file-executable-p (&rest args)
3876 (let (file-name-handler-alist) 3890 (ange-ftp-run-real-handler 'file-executable-p args))
3877 (apply 'file-executable-p args)))
3878(defun ange-ftp-real-file-symlink-p (&rest args) 3891(defun ange-ftp-real-file-symlink-p (&rest args)
3879 (let (file-name-handler-alist) 3892 (ange-ftp-run-real-handler 'file-symlink-p args))
3880 (apply 'file-symlink-p args)))
3881(defun ange-ftp-real-delete-file (&rest args) 3893(defun ange-ftp-real-delete-file (&rest args)
3882 (let (file-name-handler-alist) 3894 (ange-ftp-run-real-handler 'delete-file args))
3883 (apply 'delete-file args)))
3884(defun ange-ftp-real-read-file-name-internal (&rest args) 3895(defun ange-ftp-real-read-file-name-internal (&rest args)
3885 (let (file-name-handler-alist) 3896 (ange-ftp-run-real-handler 'read-file-name-internal args))
3886 (apply 'read-file-name-internal args)))
3887(defun ange-ftp-real-verify-visited-file-modtime (&rest args) 3897(defun ange-ftp-real-verify-visited-file-modtime (&rest args)
3888 (let (file-name-handler-alist) 3898 (ange-ftp-run-real-handler 'verify-visited-file-modtime args))
3889 (apply 'verify-visited-file-modtime args)))
3890(defun ange-ftp-real-file-exists-p (&rest args) 3899(defun ange-ftp-real-file-exists-p (&rest args)
3891 (let (file-name-handler-alist) 3900 (ange-ftp-run-real-handler 'file-exists-p args))
3892 (apply 'file-exists-p args)))
3893(defun ange-ftp-real-write-region (&rest args) 3901(defun ange-ftp-real-write-region (&rest args)
3894 (let (file-name-handler-alist) 3902 (ange-ftp-run-real-handler 'write-region args))
3895 (apply 'write-region args)))
3896(defun ange-ftp-real-backup-buffer (&rest args) 3903(defun ange-ftp-real-backup-buffer (&rest args)
3897 (let (file-name-handler-alist) 3904 (ange-ftp-run-real-handler 'backup-buffer args))
3898 (apply 'backup-buffer args)))
3899(defun ange-ftp-real-copy-file (&rest args) 3905(defun ange-ftp-real-copy-file (&rest args)
3900 (let (file-name-handler-alist) 3906 (ange-ftp-run-real-handler 'copy-file args))
3901 (apply 'copy-file args)))
3902(defun ange-ftp-real-rename-file (&rest args) 3907(defun ange-ftp-real-rename-file (&rest args)
3903 (let (file-name-handler-alist) 3908 (ange-ftp-run-real-handler 'rename-file args))
3904 (apply 'rename-file args)))
3905(defun ange-ftp-real-file-attributes (&rest args) 3909(defun ange-ftp-real-file-attributes (&rest args)
3906 (let (file-name-handler-alist) 3910 (ange-ftp-run-real-handler 'file-attributes args))
3907 (apply 'file-attributes args)))
3908(defun ange-ftp-real-file-name-all-completions (&rest args) 3911(defun ange-ftp-real-file-name-all-completions (&rest args)
3909 (let (file-name-handler-alist) 3912 (ange-ftp-run-real-handler 'file-name-all-completions args))
3910 (apply 'file-name-all-completions args)))
3911(defun ange-ftp-real-file-name-completion (&rest args) 3913(defun ange-ftp-real-file-name-completion (&rest args)
3912 (let (file-name-handler-alist) 3914 (ange-ftp-run-real-handler 'file-name-completion args))
3913 (apply 'file-name-completion args)))
3914(defun ange-ftp-real-insert-directory (&rest args) 3915(defun ange-ftp-real-insert-directory (&rest args)
3915 (let (file-name-handler-alist) 3916 (ange-ftp-run-real-handler 'insert-directory args))
3916 (apply 'insert-directory args)))
3917(defun ange-ftp-real-file-name-sans-versions (&rest args) 3917(defun ange-ftp-real-file-name-sans-versions (&rest args)
3918 (let (file-name-handler-alist) 3918 (ange-ftp-run-real-handler 'file-name-sans-versions args))
3919 (apply 'file-name-sans-versions args)))
3920(defun ange-ftp-real-shell-command (&rest args) 3919(defun ange-ftp-real-shell-command (&rest args)
3921 (let (file-name-handler-alist) 3920 (ange-ftp-run-real-handler 'shell-command args))
3922 (apply 'shell-command args)))
3923(defun ange-ftp-real-load (&rest args) 3921(defun ange-ftp-real-load (&rest args)
3924 (let (file-name-handler-alist) 3922 (ange-ftp-run-real-handler 'load args))
3925 (apply 'load args)))
3926 3923
3927;; Here we support using dired on remote hosts. 3924;; Here we support using dired on remote hosts.
3928;; I have turned off the support for using dired on foreign directory formats. 3925;; I have turned off the support for using dired on foreign directory formats.